Рисование сетки как в дизайнере

[7bit]

Приветствую, форумчане. Кто-нибудь знает как в дизайнере форм реализовано рисование сетки (точки на форме)? Куда смотреть в исходниках?

[Alex2013]

Приветствую, форумчане. Кто-нибудь знает как в дизайнере форм реализовано рисование сетки (точки на форме)? Куда смотреть в исходниках?

Не понял в чем проблема?

Код: Выделить всё

// Прорисовка  рабочего поля MagSize - размерность сетки .

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
   I,J:LongInt;

begin
//...
  I:=0;J:=0;

While I< ScrollBar1.Position+panel2.Height do begin
    Inc(i,MagSize);
    While J< ScrollBar2.Position+panel2.Width do begin
    Inc(J,MagSize);
    PaintBox1.Canvas.Pixels[j,i]:=clGray;
   end;
     j:=0;
  end;
//...
end;
 

[7bit]

Медленно. Brush.Bitmap работает быстрее, но clDefault - черный. Думаю на этом варианте остановиться, но может есть вариант лучше. Вот как это в Lazarus реализовано?..

[Alex2013]

Медленно. Brush.Bitmap работает быстрее, но clDefault - черный. Думаю на этом варианте остановиться, но может есть вариант лучше. Вот как это в Lazarus реализовано?..

Разумеется Canvas.Pixels[j,i] очень медленный метод но там обычно несколько десятков точек отрисовать нужно .
Нужно быстрее ? Тогда например так.

Код: Выделить всё

// Только 24 Бита !
Procedure Set_Pixel(Var BB:TBitmap;X,Y,C:Integer);
Type
TA=Array[0..1] of byte;
var
 PA:^TA;
 n:integer;
begin
if bb = NIL then exit;
// if not InR(x,0,bb.Width-1) then exit;
// if not InR(y,0,bb.Height-1) then exit;

Bb.BeginUpdate; ;
 pa:=Pointer(BB.RawImage.Data);
 N:=Y*(BB.Width*3)+X*3;
pa^[n]  :=Blue(C);
pa^[n+1]:=Green(C);
pa^[n+2]:=red(C);
Bb.EndUpdate;
end;

А в Lazarus реализовано скорее всего через буферизацию ( просто не видно как прорисовывается )

[xchgeaxeax]

Или создайте Bitmap размером в шаг сетки по вертикали и горизонтали, потом в координатах 0, 0 поставьте точку на этом Bitmap и после по этой Bitmap создайте PatternBrush

Код: Выделить всё

procedure TDisplayForm.FormPaint(Sender: TObject);
var
  brs: TBrush;
begin
  brs := TBrush.Create;
  brs.Bitmap := TBitmap.Create;
  with brs.Bitmap do begin
    Width := 10;
    Height := 10;
    Canvas.Pixels[0, 0] := clWhite;
  end;
  Canvas.Brush := brs;
  Canvas.FillRect(ClientRect);
end;

[7bit]

Или создайте Bitmap размером в шаг сетки по вертикали и горизонтали, потом в координатах 0, 0 поставьте точку на этом Bitmap и после по этой Bitmap создайте PatternBrush

Но в этом случае clDefault черный.

[xchgeaxeax]

Вам надо рассказать как установить цвет кисти для фона Bitmap?

ADD: Вы не смогли повторить последнюю строчку внутри блока with .. do, предварительно установив там же Canvas.Brush.Color...

Screenshot_20230706_234752.png

P.S. Если опять не догадаетесь, тогда вы можете скопировать цвет Canvas.Brush.Color из Form1.Color, тогда цвет фона не поменяется, а только появятся точки.
P.S.S. Если Form1.Color = clDefault, тогда можно считать цвет фона из того же Canvas.Pixels[0, 0] вне блока with .. do. Если опять не догадаетесь...

[7bit]

P.S.S. Если Form1.Color = clDefault, тогда можно считать цвет фона из того же Canvas.Pixels[0, 0] вне блока with .. do. Если опять не догадаетесь...

Спасибо, не догадался