Форум: "Начинающим";
Текущий архив: 2006.08.20;
Скачать: [xml.tar.bz2];

Вниз

Рисование   Найти похожие ветки 

← →
S46E ©   (2006-07-28 15:34) [0]

Покажется банально но...я не знаю как нарисовать Rectangle на Form1.Canvas что-бы он не стерся!:) подскажите?

---

← →
Пусик ©   (2006-07-28 15:37) [1]

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.


---

← →
Джо ©   (2006-07-28 15:40) [2]

> что-бы он не стерся!:)

Никак. Чтобы он не стерся, его нужно постоянно перерисовывать. Что и продемонстрировано в [1] Пусик © :)

---

← →
S46E ©   (2006-07-28 16:21) [3]

Рисовать нужно динамически. Программа пингует все компы и рисует на карте возле домов красный или зеленый квадрат, взависимости есть кто живой в доме или нет. Я подумал использовать таймер для перерисовки..но слегка накорежил физиономию посчитав что квадратиков до 30 штук и всегда они могут быть разного цвета.

---

← →
Gydvin ©   (2006-07-28 16:34) [4]

> S46E ©   (28.07.06 16:21) [3]

И за чем проблема стала?

---

← →
Gydvin ©   (2006-07-28 16:37) [5]

По таймеру делать пинг и от туда в зависимости от результата отрисовывать на промежуточном буфере (tbitmap) а уж с него срисовывать на канву формы по FormPaint

---

← →
Ega23 ©   (2006-07-28 16:42) [6]

prcedure TForm1.PaintAll;
begin
// Здесь всё рисуешь. Если что-то обновилось - можешь напрямую вызвать.
end;

procedure TForm1.OnPaint(Sender:TObject);
begin
 PaintAll; // А это - чтобы форма при своей собственной перерисовке рисовала автоматом что надо.
end;

---

← →
S46E ©   (2006-07-28 17:24) [7]

Процедура обновления
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 17:32) [8]

Ужас какой-то...
Неужели нельзя всё на одном битмапе изобразить, а потом просто проверять обдасть, в которую кликнул?

---

← →
S46E ©   (2006-07-28 17:37) [9]

хм..это было сделано все года два назад, сейчас я просто добавляю возможность пингования:) Страшно, да...и разбираться в том коде старом тоже неохота... Поэтому я и ищу способ рисования квадратов помимо варианта с 30-ю TShape))))

---

← →
Ega23 ©   (2006-07-28 17:38) [10]

> Поэтому я и ищу способ рисования квадратов помимо варианта
> с 30-ю TShape))))
>


Элементарно. TCanvas.Rectangle

---

← →
S46E ©   (2006-07-28 17:43) [11]

так они стераются?

---

← →
Джо ©   (2006-07-28 17:44) [12]

> [11] S46E ©   (28.07.06 17:43)
> так они стераются?

Начинай перечитывать тему с начала, пожалуй...

---

← →
Gydvin ©   (2006-07-28 18:12) [13]

чет не понятно
Вот общий вариант

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.


---

← →
Gydvin ©   (2006-07-28 18:15) [14]

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;

---

← →
S46E ©   (2006-07-28 18:48) [15]

ого..
:испугался и начал клонировать TShape:
)))

---

← →
Gydvin ©   (2006-07-29 12:37) [16]

>  начал клонировать TShape:

Ну и зря

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.08.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.04 c