paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 05:36:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: accelerated designer rubberband drawings

Browse Source 
git-svn-id: trunk@3365 -
This commit is contained in:
lazarus 2002-09-19 20:10:36 +00:00
parent 36aa55523f
commit e77897d318
1 changed files with 37 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
designer/controlselection.pp
View File

@ -1365,7 +1365,6 @@ var
begin begin
RestoreBrush:=false; RestoreBrush:=false;
writeln('TControlSelection.DrawMarkerAt A ');
FillRect(ALeft,ATop,ALeft+MarkerSize,ATop+MarkerSize); FillRect(ALeft,ATop,ALeft+MarkerSize,ATop+MarkerSize);
FillRect(ALeft,ATop+AHeight-MarkerSize,ALeft+MarkerSize,ATop+AHeight); FillRect(ALeft,ATop+AHeight-MarkerSize,ALeft+MarkerSize,ATop+AHeight);
FillRect(ALeft+AWidth-MarkerSize,ATop,ALeft+AWidth,ATop+MarkerSize); FillRect(ALeft+AWidth-MarkerSize,ATop,ALeft+AWidth,ATop+MarkerSize);
@ -1401,10 +1400,14 @@ begin
end; end;
procedure TControlSelection.DrawRubberband(DC: TDesignerDeviceContext); procedure TControlSelection.DrawRubberband(DC: TDesignerDeviceContext);
var Diff: TPoint; var
Diff: TPoint;
procedure DrawInvertFrameRect(x1,y1,x2,y2:integer); procedure DrawInvertFrameRect(x1,y1,x2,y2:integer);
var i:integer; var i:integer;
var
OldPenColor: TColor;
RestorePen: boolean;
procedure InvertPixel(x,y:integer); procedure InvertPixel(x,y:integer);
//var c:TColor; //var c:TColor;
@ -1415,35 +1418,47 @@ var Diff: TPoint;
DC.Canvas.MoveTo(x-Diff.X,y-Diff.Y); DC.Canvas.MoveTo(x-Diff.X,y-Diff.Y);
DC.Canvas.LineTo(x-Diff.X+1,y-Diff.Y); DC.Canvas.LineTo(x-Diff.X+1,y-Diff.Y);
end; end;
var OldPenColor: TColor; procedure DrawRubberLine(StartX, StartY, EndX, EndY: integer);
begin
if not DC.RectVisible(StartX, StartY, EndX, EndY) then exit;
if not RestorePen then begin
DC.Save;
with DC.Canvas do begin
OldPenColor:=Pen.Color;
Pen.Color:=clBlack;
end;
RestorePen:=true;
end;
if StartX<EndX then begin
while StartX<EndX do begin
InvertPixel(StartX,StartY);
inc(StartX,3);
end;
end else begin
while StartY<EndY do begin
InvertPixel(StartX,StartY);
inc(StartY,3);
end;
end;
end;
begin begin
RestorePen:=false;
if x1>x2 then begin i:=x1; x1:=x2; x2:=i; end; if x1>x2 then begin i:=x1; x1:=x2; x2:=i; end;
if y1>y2 then begin i:=y1; y1:=y2; y2:=i; end; if y1>y2 then begin i:=y1; y1:=y2; y2:=i; end;
with DC.Canvas do begin DrawRubberLine(x1,y1,x2,y1);
OldPenColor:=Brush.Color; DrawRubberLine(x1,y2,x2,y2);
Pen.Color:=clBlack; DrawRubberLine(x1,y1,x1,y2);
i:=x1+1; DrawRubberLine(x2,y1,x2,y2);
while i<x2-1 do begin if RestorePen then
InvertPixel(i,y1); DC.Canvas.Pen.Color:=OldPenColor;
InvertPixel(i,y2);
inc(i,2);
end;
i:=y1;
while i<y2 do begin
InvertPixel(x1,i);
InvertPixel(x2,i);
inc(i,2);
end;
Pen.Color:=OldPenColor;
end;
end; end;
// DrawRubberband // DrawRubberband
begin begin
if (FCustomForm=nil) then exit; if (FCustomForm=nil) then exit;
Diff:=DC.FormOrigin; Diff:=DC.FormOrigin;
DC.Save;
with FRubberBandBounds do with FRubberBandBounds do
DrawInvertFrameRect(Left,Top,Right,Bottom); DrawInvertFrameRect(Left,Top,Right,Bottom);
end; end;