paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 18:20:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

try: gdi memory leak fix for pen

Browse Source 
git-svn-id: trunk@4875 -
This commit is contained in:
micha 2003-12-02 12:25:17 +00:00
parent b1a556bf98
commit eb5c0a7d5b
4 changed files with 72 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/graphics.pp
View File

@ -281,13 +281,16 @@ type
TGraphicsObject = class(TPersistent)
private
FOnChanging: TNotifyEvent;
FOnChange: TNotifyEvent;
Procedure DoChange(var msg); message LM_CHANGED;
protected
procedure Changing; dynamic;
procedure Changed; dynamic;
Procedure Lock;
Procedure UnLock;
public
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
@ -665,6 +668,8 @@ type
FLockCount: Integer;
procedure BrushChanged(ABrush: TObject);
procedure FontChanged(AFont: TObject);
procedure PenChanging(APen: TObject);
procedure PenChanged(APen: TObject);
procedure RegionChanged(ARegion: TObject);
procedure DeselectHandles;
function GetCanvasClipRect: TRect;
@ -672,7 +677,6 @@ type
function GetHandle : HDC;
Function GetPenPos: TPoint;
Function GetPixel(X,Y : Integer) : TColor;
procedure PenChanged(APen: TObject);
Procedure SetAutoReDraw(Value : Boolean);
Procedure SetColor(c: TColor);
Procedure SetBrush(value : TBrush);
@ -1253,6 +1257,9 @@ end.
{ =============================================================================
$Log$
Revision 1.100 2003/12/02 12:25:17 micha
try: gdi memory leak fix for pen
Revision 1.99 2003/11/26 21:30:19 mattias
reduced unit circles, fixed fpImage streaming

65
lcl/include/canvas.inc
View File

@ -273,7 +273,7 @@ end;
The angles angle1 and angle2 are 1/16th of a degree. For example, a full
circle equals 5760 (16*360). Positive values of Angle and AngleLength mean
counter-clockwise while negative values mean clockwise direction.
Zero degrees is at the 3'o clock position.
Zero degrees is at the 3'o clock position.
------------------------------------------------------------------------------}
procedure TCanvas.Arc(x,y,width,height,angle1,angle2 : Integer);
@ -286,11 +286,11 @@ end;
{------------------------------------------------------------------------------
Method: TCanvas.Arc
Params: DC,x,y,width,height,sx,sy,ex,ey
Params: DC,x,y,width,height,sx,sy,ex,ey
Returns: Nothing
Use Arc to draw an elliptically curved line with the current Pen. The
values sx,sy, and ex,ey represent the starting and ending radial-points
Use Arc to draw an elliptically curved line with the current Pen. The
values sx,sy, and ex,ey represent the starting and ending radial-points
between which the Arc is drawn.
------------------------------------------------------------------------------}
@ -311,7 +311,7 @@ end;
The angles angle1 and angle2 are 1/16th of a degree. For example, a full
circle equals 5760 (16*360). Positive values of Angle and AngleLength mean
counter-clockwise while negative values mean clockwise direction.
Zero degrees is at the 3'o clock position.
Zero degrees is at the 3'o clock position.
------------------------------------------------------------------------------}
procedure TCanvas.RadialPie(x,y,width,height,angle1,angle2 : Integer);
@ -423,22 +423,22 @@ end;
Params: Points: array of TPoint; Winding: Boolean = False;
StartIndex: Integer = 0; NumPts: Integer = -1
Returns: Nothing
Use Polygon to draw a closed, many-sided shape on the canvas, using the value
of Pen. After drawing the complete shape, Polygon fills the shape using the
Use Polygon to draw a closed, many-sided shape on the canvas, using the value
of Pen. After drawing the complete shape, Polygon fills the shape using the
value of Brush.
The Points parameter is an array of points that give the vertices of the
polygon.
Winding determines how the polygon is filled. When Winding is True, Polygon
fills the shape using the Winding fill algorithm. When Winding is False,
Winding determines how the polygon is filled. When Winding is True, Polygon
fills the shape using the Winding fill algorithm. When Winding is False,
Polygon uses the even-odd (alternative) fill algorithm.
StartIndex gives the index of the first point in the array to use. All points
StartIndex gives the index of the first point in the array to use. All points
before this are ignored.
NumPts indicates the number of points to use, starting at StartIndex.
If NumPts is -1 (the default), Polygon uses all points from StartIndex to the
If NumPts is -1 (the default), Polygon uses all points from StartIndex to the
end of the array.
The first point is always connected to the last point.
To draw a polygon on the canvas, without filling it, use the Polyline method,
The first point is always connected to the last point.
To draw a polygon on the canvas, without filling it, use the Polyline method,
specifying the first point a second time at the end.
}
procedure TCanvas.Polygon(const Points: array of TPoint; Winding: Boolean;
@ -477,19 +477,19 @@ end;
{------------------------------------------------------------------------------
Method: TCanvas.Polyline
Params: Points: array of TPoint;
Params: Points: array of TPoint;
StartIndex: Integer = 0; NumPts: Integer = -1
Returns: Nothing
Use Polyline to connect a set of points on the canvas. If you specify only two
Use Polyline to connect a set of points on the canvas. If you specify only two
points, Polyline draws a single line.
The Points parameter is an array of points to be connected.
StartIndex identifies the first point in the array to use.
NumPts indicates the number of points to use. If NumPts is -1 (the default),
NumPts indicates the number of points to use. If NumPts is -1 (the default),
PolyLine uses all the points from StartIndex to the end of the array.
Calling the MoveTo function with the value of the first point, and then
repeatedly calling LineTo with all subsequent points will draw the same image
on the canvas. However, unlike LineTo, Polyline does not change the value of
Calling the MoveTo function with the value of the first point, and then
repeatedly calling LineTo with all subsequent points will draw the same image
on the canvas. However, unlike LineTo, Polyline does not change the value of
PenPos.
}
procedure TCanvas.Polyline(const Points: array of TPoint; StartIndex: Integer;
@ -630,7 +630,7 @@ end;
{------------------------------------------------------------------------------
procedure TCanvas.FrameRect(const ARect: TRect);
Drawing the border of a rectangle with the current brush
------------------------------------------------------------------------------}
procedure TCanvas.FrameRect(const ARect: TRect);
@ -910,6 +910,23 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: TCanvas.PenChanging
Params: APen: The changing pen
Returns: Nothing
Notify proc for a pen change
------------------------------------------------------------------------------}
procedure TCanvas.PenChanging(APen: TObject);
begin
if [csPenValid, csHandleValid] * FState = [csPenValid, csHandleValid] then
begin
Exclude(FState, csPenValid);
SelectObject(FHandle, FSavedPenHandle);
FSavedPenHandle := 0;
end;
end;
{------------------------------------------------------------------------------
Method: TCanvas.PenChanged
Params: APen: The changed pen
@ -955,6 +972,7 @@ begin
FFont.OnChange := @FontChanged;
FSavedFontHandle := 0;
FPen := TPen.Create;
FPen.OnChanging := @PenChanging;
FPen.OnChange := @PenChanged;
FSavedPenHandle := 0;
FBrush := TBrush.Create;
@ -1086,7 +1104,7 @@ end;
------------------------------------------------------------------------------}
procedure TCanvas.DeselectHandles;
begin
if (FHandle<>0)
if (FHandle<>0)
and (FState * [csPenValid, csBrushValid, csFontValid] <> []) then begin
// select default sub handles in the device context without deleting owns
if FSavedBrushHandle<>0 then begin
@ -1236,6 +1254,9 @@ end;
{ =============================================================================
$Log$
Revision 1.56 2003/12/02 12:25:17 micha
try: gdi memory leak fix for pen
Revision 1.55 2003/11/22 17:22:15 mattias
moved TBevelCut to controls.pp

9
lcl/include/graphicsobject.inc
View File

@ -21,6 +21,12 @@ begin
Changed;
end;
procedure TGraphicsObject.Changing;
begin
Assert(False, Format('Trace:[TgraphicsObject.Changed] %s', [ClassName]));
if Assigned(FOnChanging) then FOnChanging(Self);
end;
procedure TGraphicsObject.Changed;
begin
Assert(False, Format('Trace:[TgraphicsObject.Changed] %s', [ClassName]));
@ -40,6 +46,9 @@ end;
{ =============================================================================
$Log$
Revision 1.4 2003/12/02 12:25:17 micha
try: gdi memory leak fix for pen
Revision 1.3 2002/09/30 14:01:06 lazarus
MG: undid the TBinaryObjectWriter Buffersize

20
lcl/include/pen.inc
View File

@ -24,7 +24,7 @@
------------------------------------------------------------------------------}
Procedure TPen.SetColor(Value : TColor);
begin
if FPenData.Color <> value
if FPenData.Color <> value
then begin
FreeHandle;
FPenData.Color := value;
@ -74,7 +74,7 @@ end;
------------------------------------------------------------------------------}
Procedure TPen.SetWidth(Value : Integer);
begin
if FPenData.Width <> Value
if FPenData.Width <> Value
then begin
FreeHandle;
FPenData.Width := Value;
@ -99,7 +99,7 @@ begin
Style := psSolid;
Color := clBlack;
end;
FMode := pmCopy;
FMode := pmCopy;
end;
{------------------------------------------------------------------------------
@ -139,11 +139,11 @@ end;
Params: a pen handle
Returns: nothing
sets the pen to an external created pen
sets the pen to an external created pen
------------------------------------------------------------------------------}
procedure TPen.SetHandle(const Value: HPEN);
begin
if FPenData.Handle <> Value
if FPenData.Handle <> Value
then begin
FreeHandle;
FPenData.Handle := Value;
@ -176,7 +176,7 @@ begin
end;
FPenData.Handle := CreatePenIndirect(LogPen);
end;
Result := FPenData.Handle;
end;
@ -189,9 +189,10 @@ end;
------------------------------------------------------------------------------}
procedure TPen.FreeHandle;
begin
if FPenData.Handle <> 0
if FPenData.Handle <> 0
then begin
//TODO: what if a pen is currently selected
// Changing triggers deselecting the current handle
Changing;
DeleteObject(FPenData.Handle);
FPenData.Handle := 0;
end;
@ -200,6 +201,9 @@ end;
{ =============================================================================
$Log$
Revision 1.6 2003/12/02 12:25:17 micha
try: gdi memory leak fix for pen
Revision 1.5 2002/08/18 04:57:01 mattias
fixed csDashDot