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

clean up for TBitmapImage sharing

Browse Source 
git-svn-id: trunk@5252 -
This commit is contained in:
mattias 2004-03-02 22:37:36 +00:00
parent b499a159f4
commit 94d066eea6
4 changed files with 42 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/graphics.pp
View File

@ -775,7 +775,6 @@ type
Procedure SetColor(c: TColor);
Procedure SetBrush(value : TBrush);
Procedure SetFont(value : TFont);
procedure SetHandle(NewHandle: HDC);
Procedure SetPen(value : TPen);
Procedure SetPenPos(Value : TPoint);
Procedure SetPixel(X,Y : Integer; Value : TColor);
@ -789,6 +788,7 @@ type
procedure RequiredState(ReqState: TCanvasState);
procedure Changed; virtual;
procedure Changing; virtual;
procedure SetHandle(NewHandle: HDC); virtual;
public
constructor Create;
destructor Destroy; override;
@ -1231,7 +1231,6 @@ type
public
constructor Create(ABitmap : TBitmap);
destructor Destroy; override;
// TODO: replace this by property BitmapHandle;
end;
@ -1599,6 +1598,9 @@ end.
{ =============================================================================
$Log$
Revision 1.125 2004/03/02 22:37:36 mattias
clean up for TBitmapImage sharing
Revision 1.124 2004/03/01 18:02:00 mattias
fixed IsFileExtensionSupported

18
lcl/include/bitmapcanvas.inc
View File

@ -41,15 +41,12 @@ procedure TBitMapCanvas.CreateHandle;
var
DC: HDC;
begin
if FBitmap <> nil then
begin
FBitmap.HandleNeeded;
FreeDC;
if FBitmap = nil then exit;
FBitmap.HandleNeeded;
FBitmap.PaletteNeeded;
DC := CreateCompatibleDC(0);
Assert(False, Format('trace:[TBitmapCanvas.CreateHandle] Got Handle 0x%x', [FBitmap.Handle]));
if not FBitmap.HandleAllocated then
FOldBitmap := 0
else
@ -64,7 +61,6 @@ begin
Handle := DC;
end;
end;
{------------------------------------------------------------------------------
Method: TBitMapCanvas.Destroy
@ -79,7 +75,6 @@ begin
inherited Destroy;
end;
{------------------------------------------------------------------------------
Method: TControlCanvas.FreeDC
Params: None
@ -91,8 +86,8 @@ procedure TBitmapCanvas.FreeDC;
var
OldHandle: HBITMAP;
begin
if FHandle <> 0 then
begin
if not HandleAllocated then exit;
if FBitmap<>nil then begin
if FOldBitmap <> 0 then begin
SelectObject(FHandle, FOldBitmap);
FOldBitmap:=0;
@ -104,6 +99,8 @@ begin
OldHandle := FHandle;
Handle := 0;
DeleteDC(OldHandle);
end else begin
Handle:=0;
end;
end;
@ -112,6 +109,9 @@ end;
{ =============================================================================
$Log$
Revision 1.9 2004/03/02 22:37:36 mattias
clean up for TBitmapImage sharing
Revision 1.8 2004/02/05 16:28:38 mattias
fixed unsharing TBitmap

18
lcl/include/bitmapimage.inc
View File

@ -22,14 +22,10 @@ begin
FSaveStreamType:=bnNone;
if FDIBHandle <> 0 then
begin
//TODO:write this function
//DeselectBitmap(FDIBHandle);
DeleteObject(FDIBHandle);
FDIBHandle := 0;
end;
FreeHandle;
//TODO Write CloseHandle
//if FDIB.dshSection <> 0 then CloseHandle(FDIB.dshSection);
inherited Destroy;
end;
@ -54,21 +50,15 @@ end;
procedure TBitmapImage.FreeHandle;
begin
if (FHandle <> 0) and (FHandle <> FDIBHandle) then
begin
//TODO: Once written, remove comment below
//DeselectBitmap(FHandle);
DeleteObject(FHandle);
end;
if FMaskHandle <> 0 then
begin
//TODO: Once written, remove comment below
//DeselectBitmap(FMaskHandle);
DeleteObject(FMaskHandle);
FMaskHandle := 0;
end;
//TODO: Once written, remove comment below
//InternalDeletePalette(FPalette);
if (FHandle <> 0) and (FHandle <> FDIBHandle) then
begin
DeleteObject(FHandle);
end;
FHandle := 0;
FPalette := 0;
end;

4
lcl/include/imglist.inc
View File

@ -469,6 +469,7 @@ end;
procedure TCustomImageList.GetBitmap(Index: Integer; Image: TBitmap);
begin
if (FCount = 0) or (Image = nil) then Exit;
//writeln('TCustomImageList.GetBitmap Index=',Index,' Image=',HexStr(Cardinal(Image),8),' Bitmap=',HexStr(Cardinal(FImageList.Items[Index]),8));
Image.Assign(TBitMap(FImageList.Items[Index]));
end;
@ -1165,6 +1166,9 @@ end;
{
$Log$
Revision 1.29 2004/03/02 22:37:36 mattias
clean up for TBitmapImage sharing
Revision 1.28 2004/03/01 23:45:33 marc
* Patch from olivier GUILBAUD and Colin Western
* fixed addcopy