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

fixed locking TCanvas

Browse Source 
git-svn-id: trunk@6600 -
This commit is contained in:
mattias 2005-01-15 11:56:13 +00:00
parent 186fe2ef4d
commit b1cb0e902c
2 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/graphics.pp
View File

@ -415,7 +415,9 @@ type
// but then with the advanced features of the existing package
{$ENDIF}
{ TGraphicsObject }
{ TGraphicsObject
In Delphi VCL this is the ancestor of TFon, TPen and TBrush.
With FPC 2.0 the LCL uses TFPCanvasHelper. }
TGraphicsObject = class(TPersistent)
private
@ -1946,6 +1948,9 @@ end.
{ =============================================================================
$Log$
Revision 1.172 2005/01/15 11:56:13 mattias
fixed locking TCanvas
Revision 1.171 2005/01/10 18:44:44 mattias
implemented the fpCanvas support for the LCL - Compile with -dUseFPCanvas

21
lcl/include/canvas.inc
View File

@ -1500,8 +1500,10 @@ begin
{$IFDEF UseFPCanvas}
LockCanvas;
{$ELSE}
if FLock=0 then InitializeCriticalSection(FLock);
EnterCriticalSection(FLock);
if FLockCount=0 then begin
if FLock=0 then InitializeCriticalSection(FLock);
EnterCriticalSection(FLock);
end;
Inc(FLockCount);
{$ENDIF}
end;
@ -1512,12 +1514,22 @@ end;
Returns: nothing
------------------------------------------------------------------------------}
procedure TCanvas.Unlock;
procedure RaiseTooManyUnlock;
begin
raise Exception.Create(
'TCanvas.Unlock '+DbgSName(Self)+': too many unlocks');
end;
begin
{$IFDEF UseFPCanvas}
UnlockCanvas;
{$ELSE}
LeaveCriticalSection(FLock);
Dec(FLockCount);
if FLockCount=0 then begin
LeaveCriticalSection(FLock);
end else if FLockCount<0 then
RaiseTooManyUnlock;
{$ENDIF}
end;
@ -1532,6 +1544,9 @@ end;
{ =============================================================================
$Log$
Revision 1.89 2005/01/15 11:56:13 mattias
fixed locking TCanvas
Revision 1.88 2005/01/10 18:44:44 mattias
implemented the fpCanvas support for the LCL - Compile with -dUseFPCanvas