mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 18:20:00 +02:00
clean up for TBitmapImage sharing
git-svn-id: trunk@5252 -
This commit is contained in:
parent
b499a159f4
commit
94d066eea6
@ -744,7 +744,7 @@ type
|
||||
private
|
||||
FAutoReDraw : Boolean;
|
||||
FState: TCanvasState;
|
||||
FFont : TFont;
|
||||
FFont: TFont;
|
||||
FSavedFontHandle: HFont;
|
||||
FPen: TPen;
|
||||
FSavedPenHandle: HPen;
|
||||
@ -752,9 +752,9 @@ type
|
||||
FSavedBrushHandle: HBrush;
|
||||
FRegion: TRegion;
|
||||
FSavedRegionHandle: HRGN;
|
||||
FPenPos : TPoint;
|
||||
FCopyMode : TCopyMode;
|
||||
FHandle : HDC;
|
||||
FPenPos: TPoint;
|
||||
FCopyMode: TCopyMode;
|
||||
FHandle: HDC;
|
||||
FOnChange: TNotifyEvent;
|
||||
FOnChanging: TNotifyEvent;
|
||||
FTextStyle: TTextStyle;
|
||||
@ -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;
|
||||
@ -1222,16 +1222,15 @@ const
|
||||
type
|
||||
TBitmapCanvas = class(TCanvas)
|
||||
private
|
||||
FBitmap : TBitmap;
|
||||
FOldBitmap : HBitmap;
|
||||
FOldPalette : HPALETTE;
|
||||
FBitmap: TBitmap;
|
||||
FOldBitmap: HBitmap;
|
||||
FOldPalette: HPALETTE;
|
||||
procedure FreeDC;
|
||||
protected
|
||||
procedure CreateHandle; override;
|
||||
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
|
||||
|
||||
|
@ -41,29 +41,25 @@ procedure TBitMapCanvas.CreateHandle;
|
||||
var
|
||||
DC: HDC;
|
||||
begin
|
||||
if FBitmap <> nil then
|
||||
begin
|
||||
FBitmap.HandleNeeded;
|
||||
FreeDC;
|
||||
FBitmap.PaletteNeeded;
|
||||
DC := CreateCompatibleDC(0);
|
||||
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
|
||||
FOldBitmap := SelectObject(DC, FBitmap.Handle);
|
||||
|
||||
if not FBitmap.HandleAllocated then
|
||||
FOldBitmap := 0
|
||||
else
|
||||
FOldBitmap := SelectObject(DC, FBitmap.Handle);
|
||||
|
||||
if FBitmap.FPalette = 0 then
|
||||
FOldPalette := 0
|
||||
else begin
|
||||
FOldPalette := SelectPalette(DC, FBitmap.FPalette, True);
|
||||
RealizePalette(DC);
|
||||
end;
|
||||
|
||||
Handle := DC;
|
||||
if FBitmap.FPalette = 0 then
|
||||
FOldPalette := 0
|
||||
else begin
|
||||
FOldPalette := SelectPalette(DC, FBitmap.FPalette, True);
|
||||
RealizePalette(DC);
|
||||
end;
|
||||
|
||||
Handle := DC;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -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
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user