| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Рисование
S46E © (2006-07-28 15:34:00)Покажется банально но...я не знаю как нарисовать Rectangle на Form1.Canvas что-бы он не стерся!:) подскажите?
Gydvin (2006-07-29 12:37:00) [1]
> начал клонировать TShape:
Ну и зря
S46E (2006-07-28 18:48:00) [2]ого..
:испугался и начал клонировать TShape:
)))
Gydvin (2006-07-28 18:15:00) [3]
procedure TForm1.Timer1Timer(Sender: TObject);
function skanIP(IP: string): boolean;
begin
result := false;
///////Сканируем один IP если да, то result:=true;
end;
var
x: integer;
begin
for x := 0 to countIP - 1 do begin
if skanIP(IP[x]) then buffer.Canvas.Brush.Color := cllime else
buffer.Canvas.Brush.Color := clred;
buffer.Canvas.Rectangle(koord[x, 0], koord[x, 1], koord[x, 2], koord[x, 3]);
end;
paint;
end;
Gydvin (2006-07-28 18:12:00) [4]чет не понятно
Вот общий вариант
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure paint;
procedure FormPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
buffer: tbitmap;
koord: array of array of integer;
IP: array of string;
countIP: integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
type
Tmyclass = record
IP: string;
x, y, x1, y1: integer
end;
function razbor(text: string): Tmyclass;
var
s: string;
i: integer;
begin
i := pos('/', text);
result.IP := copy(text, 1, i - 1);
delete(text, 1, i);
i := pos('/', text);
result.x := strtoint(copy(text, 1, i - 1));
delete(text, 1, i);
i := pos('/', text);
result.y := strtoint(copy(text, 1, i - 1));
delete(text, 1, i);
i := pos('/', text);
result.x1 := strtoint(copy(text, 1, i - 1));
delete(text, 1, i);
i := pos('/', text);
result.y1 := strtoint(copy(text, 1, i - 1));
delete(text, 1, i);
end;
var
list: tstringlist;
x, y: integer;
t: Tmyclass;
begin
setlength(koord, 0);
setlength(IP, 0);
list := tstringlist.Create;
buffer := tbitmap.Create;
buffer.LoadFromFile('map.bmp'); //Грузим карту дома
list.LoadFromFile('Log.txt'); //грузим весь список IP в доме c координатами через разделитель
///например: 192.168.0.1/0/0/25/25/
y := list.Count;
setlength(koord, y, 4);
setlength(IP, y);
countIP := y;
for x := 0 to y - 1 do
begin
t := razbor(list.Strings[x]);
IP[x] := t.IP;
koord[x, 0] := t.x;
koord[x, 1] := t.y;
koord[x, 2] := t.x1;
koord[x, 3] := t.y1;
end;
list.Free;
end;
procedure TForm1.paint;
begin
canvas.Draw(0, 0, buffer);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
function skanIP(IP: string): boolean;
begin
result := false;
///////Сканируем один IP если да, то result:=true;
end;
var
x: integer;
begin
for x := 0 to countIP - 1 do begin
if skanIP(IP[x]) then buffer.Canvas.Brush.Color := cllime else
buffer.Canvas.Brush.Color := clred;
buffer.Canvas.Rectangle(koord[x, 0], koord[x, 1], koord[x, 2], koord[x, 3]);
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
paint;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
buffer.Free;
end;
end.
Джо (2006-07-28 17:44:00) [5]> [11] S46E © (28.07.06 17:43)
> так они стераются?
Начинай перечитывать тему с начала, пожалуй...
S46E (2006-07-28 17:43:00) [6]так они стераются?
Ega23 (2006-07-28 17:38:00) [7]
> Поэтому я и ищу способ рисования квадратов помимо варианта
> с 30-ю TShape))))
>
Элементарно. TCanvas.Rectangle
S46E (2006-07-28 17:37:00) [8]хм..это было сделано все года два назад, сейчас я просто добавляю возможность пингования:) Страшно, да...и разбираться в том коде старом тоже неохота... Поэтому я и ищу способ рисования квадратов помимо варианта с 30-ю TShape))))
Ega23 (2006-07-28 17:32:00) [9]Ужас какой-то...
Неужели нельзя всё на одном битмапе изобразить, а потом просто проверять обдасть, в которую кликнул?
S46E (2006-07-28 17:24:00) [10]Процедура обновления
procedure TForm1.Vis();
var
i: integer;
n: integer;
log2: TStrings;
log3: TStrings;
begin
log2:= TStringList.Create();
log3:= TStringList.Create();
log2.LoadFromFile('log.txt');
//рисуем красные квадраты[все h**]
//Canvas.Brush.Color:=clRed;
//Canvas.Pen.Color:=clRed;
//Canvas.Rectangle(z01.left,z01.top, z01.left+4, z01.top+4);
{*}
log3:=LoadHouse(h01);
for i:=0 to log3.Count-1 do
for n:=0 to log2.Count-1 do
if copy(log3[i], 1, length(log2[n]))=log2[n] then
if copy(log3[i], length(log2[n])+2, 3)='RTT' then
//рисуем зеленый квадрат(h01)
{/*}
end;
LoadHouse(номер дрома) - функция которая возвращает TStrings с IP's в Доме.
log.txt - лог пингования всех IP. Т.е. по пингованию вопросов нету(Спасибо Пусику), только по рисованию..
p.s. всего z01...z30, h01...h30. z - Tlabel для нажатия на область картинки(дом на карте), h - строка с номером дома.
кусок кода отмеченый * придется копировать 30 раз для каждого H и Z..:)
Вот такая система...
Ega23 (2006-07-28 16:42:00) [11]prcedure TForm1.PaintAll;
begin
// Здесь всё рисуешь. Если что-то обновилось - можешь напрямую вызвать.
end;
procedure TForm1.OnPaint(Sender:TObject);
begin
PaintAll; // А это - чтобы форма при своей собственной перерисовке рисовала автоматом что надо.
end;
Gydvin (2006-07-28 16:37:00) [12]По таймеру делать пинг и от туда в зависимости от результата отрисовывать на промежуточном буфере (tbitmap) а уж с него срисовывать на канву формы по FormPaint
Gydvin (2006-07-28 16:34:00) [13]
> S46E © (28.07.06 16:21) [3]
И за чем проблема стала?
S46E (2006-07-28 16:21:00) [14]Рисовать нужно динамически. Программа пингует все компы и рисует на карте возле домов красный или зеленый квадрат, взависимости есть кто живой в доме или нет. Я подумал использовать таймер для перерисовки..но слегка накорежил физиономию посчитав что квадратиков до 30 штук и всегда они могут быть разного цвета.
Джо (2006-07-28 15:40:00) [15]> что-бы он не стерся!:)
Никак. Чтобы он не стерся, его нужно постоянно перерисовывать. Что и продемонстрировано в [1] Пусик © :)
Пусик (2006-07-28 15:37:00) [16]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormPaint(Sender: TObject);
begin
Form1.Canvas.Rectangle(10,10,100,100);
end;
end.
| |
