Всем привет. Имеется следующая процедура...она полностью рабочая, но хочется ее изменить...в данный момент процедура выводит квадратики...а хотелось бы чтобы она выводила другую фигуру..или вместо фигуры отображалась маленькая картинка..
procedure TForm02.OnDraw(var Mes: TMessage);
var rp, rn: TRect; begin with TProcess02(Mes.LParam) do begin with rp, PrevPoint do begin Left := Round(ScaleX * x); Right := Left + CellWidth; Top := Round(ScaleY * y); Bottom := Top + CellHeight; end; with rn, NextPoint do begin Left := Round(ScaleX * x); Right := Left + CellWidth; Top := Round(ScaleY * y); Bottom := Top + CellHeight; end; with PaintBox.Canvas do begin Brush.Color := color;// Теперь после потока появился шлейф if brush.Color = clwhite then brush.Color := clred; FillRect(rp); Brush.Color :=Color; // После умирания потока остается синяя точка if brush.Color = clwhite then brush.Color := clblue; FillRect(rn); end; end; end;
В принципе может лучше взять процедуру Execute с оригинала GALA.
Добавлено через 5 мин. взял с оригинала...не сработало вышла ошибка....
Добавлено через 4 мин. в общем процедуру Execute такой сделал--теперь PaintBox закрашивается вся область.
procedure TProcess02.Execute; var p: TPoint; d: TDirection02; const Border = 3; begin FFreeOnTerminate := True; Priority := -1; DivideTick := GetTickCount + 1000 + Cardinal(Random(2000)); Send(GM_PROCESS_START); while (not Terminated) and (GetTickCount < DeathTick) do begin with NextPoint do begin x := PrevPoint.x + Direction.x; y := PrevPoint.y + Direction.y; if (x <= Low(TX_02)) or (x >= High(TX_02)) then Direction.x := -Direction.x; if (y <= Low(TY_02)) or (y >= High(TY_02)) then Direction.y := -Direction.y; end; if (GetTickCount > DivideTick) then begin DivideTick := GetTickCount + 1000 + Cardinal(Random(2000)); if (PrevPoint.x >= (Low(TX_02) + Border)) and (PrevPoint.y >= (Low(TY_02) + Border)) and (PrevPoint.x <= (High(TX_02) - Border)) and (PrevPoint.y <= (High(TY_02) - Border)) and ((ParentForm as TForm02).CanCreate) then begin p := PrevPoint; d := Direction; d.x := -d.x; try TProcess02.Create(Group, ParentForm, p, d,pbmp); except on EGalaObjectCreationFail do Beep; end; end; end; try Send(GM_DRAW_02, Self, ParentForm, 200); PrevPoint := NextPoint; Pause(Speed); except on EGalaTimeout do Terminate; end; end; end;
Добавлено через 2 мин. Но двигаются щас они...как-то одинаково симметрично...и однообразно...что то не то((