mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-27 08:33:49 +02:00
128 lines
4.0 KiB
PHP
128 lines
4.0 KiB
PHP
{%MainUnit ../graphics.pp}
|
|
|
|
{******************************************************************************
|
|
TBitmapCanvas
|
|
******************************************************************************
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.LCL, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
{------------------------------------------------------------------------------
|
|
Method: TBitmapCanvas.Create
|
|
Params: ABitMap: the owner of the class
|
|
Returns: Nothing
|
|
|
|
Constructor for the class.
|
|
------------------------------------------------------------------------------}
|
|
constructor TBitmapCanvas.Create(ABitmap : TBitMap);
|
|
begin
|
|
inherited Create;
|
|
FBitmap := ABitmap;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TBitmapCanvas.CreateHandle
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Creates the handle.
|
|
------------------------------------------------------------------------------}
|
|
procedure TBitmapCanvas.CreateHandle;
|
|
var
|
|
DC: HDC;
|
|
begin
|
|
if HandleAllocated then exit;
|
|
if FBitmap = nil then exit;
|
|
FBitmap.HandleNeeded;
|
|
FBitmap.PaletteNeeded;
|
|
if FBitmap.FImage.BitmapCanvas <> nil then
|
|
TBitmapCanvas(FBitmap.FImage.BitmapCanvas).FreeDC;
|
|
FBitmap.FImage.BitmapCanvas := Self;
|
|
DC := CreateCompatibleDC(0);
|
|
|
|
FOldBitmap := 0;
|
|
FOldBitmapValid:=false;
|
|
if FBitmap.HandleAllocated then begin
|
|
FOldBitmap := SelectObject(DC, FBitmap.Handle);
|
|
FOldBitmapValid:=true;
|
|
end;
|
|
|
|
FOldPalette:=0;
|
|
FOldPaletteValid:=false;
|
|
if FBitmap.PaletteAllocated then begin
|
|
FOldPalette := SelectPalette(DC, FBitmap.FPalette, True);
|
|
FOldPaletteValid:=true;
|
|
RealizePalette(DC);
|
|
end;
|
|
|
|
Handle := DC;
|
|
//DebugLn('TBitmapCanvas.CreateHandle END Self=',DbgS(Self),' DC=',DbgS(DC),
|
|
// ' Handle=',DbgS(GetUpdatedHandle([csHandleValid])));
|
|
end;
|
|
|
|
procedure TBitmapCanvas.DeselectHandles;
|
|
begin
|
|
if HandleAllocated then begin
|
|
if FOldBitmapValid then begin
|
|
SelectObject(FHandle, FOldBitmap);
|
|
FOldBitmap:=0;
|
|
FOldBitmapValid:=false;
|
|
end;
|
|
if FOldPaletteValid then begin
|
|
SelectPalette(FHandle, FOldPalette, True);
|
|
FOldPalette:=0;
|
|
FOldPaletteValid:=false;
|
|
end;
|
|
end;
|
|
inherited DeselectHandles;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TBitmapCanvas.Destroy
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Destructor for the class.
|
|
------------------------------------------------------------------------------}
|
|
destructor TBitmapCanvas.Destroy;
|
|
begin
|
|
FreeDC;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TControlCanvas.FreeDC
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Frees the device context
|
|
------------------------------------------------------------------------------}
|
|
procedure TBitmapCanvas.FreeDC;
|
|
var
|
|
OldHandle: HBITMAP;
|
|
begin
|
|
if not HandleAllocated then exit;
|
|
//DebugLn('TBitmapCanvas.FreeDC START Self=',DbgS(Self),' FBitmap=',DbgS(FBitmap));
|
|
if FBitmap<>nil then begin
|
|
OldHandle := FHandle;
|
|
Handle := 0;
|
|
DeleteDC(OldHandle);
|
|
end else begin
|
|
Handle:=0;
|
|
end;
|
|
end;
|
|
|
|
// included by graphics.pp
|
|
|
|
|