mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 03:58:09 +02:00
126 lines
3.4 KiB
PHP
126 lines
3.4 KiB
PHP
{%MainUnit ../graphics.pp}
|
|
|
|
{******************************************************************************
|
|
TBitmapCanvas
|
|
******************************************************************************
|
|
|
|
*****************************************************************************
|
|
This file is part of the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
}
|
|
{------------------------------------------------------------------------------
|
|
Method: TBitmapCanvas.Create
|
|
Params: ABitMap: the owner of the class
|
|
Returns: Nothing
|
|
|
|
Constructor for the class.
|
|
------------------------------------------------------------------------------}
|
|
constructor TBitmapCanvas.Create(AImage: TRasterImage);
|
|
begin
|
|
inherited Create;
|
|
// set FImage after inherited create to make sure that the inherited Create
|
|
// won't trigger a call to FImage
|
|
FImage := AImage;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TBitmapCanvas.CreateHandle
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Creates the handle.
|
|
------------------------------------------------------------------------------}
|
|
procedure TBitmapCanvas.CreateHandle;
|
|
var
|
|
DC: HDC;
|
|
begin
|
|
if HandleAllocated then exit;
|
|
if FImage = nil then exit;
|
|
|
|
FImage.BitmapHandleNeeded;
|
|
FImage.PaletteNeeded;
|
|
if FImage.FSharedImage.BitmapCanvas <> nil then
|
|
(FImage.FSharedImage.BitmapCanvas as TBitmapCanvas).FreeDC;
|
|
FImage.FSharedImage.BitmapCanvas := Self;
|
|
DC := CreateCompatibleDC(0);
|
|
|
|
if FImage.BitmapHandleAllocated
|
|
then FOldBitmap := SelectObject(DC, FImage.BitmapHandle)
|
|
else FOldBitmap := 0;
|
|
|
|
if FImage.PaletteAllocated
|
|
then begin
|
|
FOldPalette := SelectPalette(DC, FImage.Palette, True);
|
|
RealizePalette(DC);
|
|
end
|
|
else begin
|
|
FOldPalette := 0;
|
|
end;
|
|
|
|
// since moveto doesn't force a unshare, it is possible that a moveto was
|
|
// done in the old DC.
|
|
with PenPos do
|
|
LCLIntf.MoveToEx(DC, X, Y, nil);
|
|
|
|
Handle := DC;
|
|
//DebugLn('TBitmapCanvas.CreateHandle END Self=',DbgS(Self),' DC=',DbgS(DC),
|
|
// ' Handle=',DbgS(GetUpdatedHandle([csHandleValid])));
|
|
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 FImage = nil
|
|
then begin
|
|
Handle := 0;
|
|
Exit;
|
|
end;
|
|
|
|
OldHandle := FHandle;
|
|
Handle := 0;
|
|
FImage.FSharedImage.BitmapCanvas := nil;
|
|
|
|
if FOldBitmap <> 0
|
|
then begin
|
|
SelectObject(OldHandle, FOldBitmap);
|
|
FOldBitmap := 0;
|
|
end;
|
|
|
|
if FOldPalette <> 0
|
|
then begin
|
|
SelectPalette(OldHandle, FOldPalette, True);
|
|
FOldPalette := 0;
|
|
end;
|
|
DeleteDC(OldHandle);
|
|
end;
|
|
|
|
// included by graphics.pp
|
|
|