mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-03 08:58:15 +02:00
52 lines
1.3 KiB
ObjectPascal
52 lines
1.3 KiB
ObjectPascal
unit customdrawnproc;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
// rtl+ftl
|
|
Types, Classes, SysUtils,
|
|
fpimage, fpcanvas,
|
|
// Custom Drawn Canvas
|
|
IntfGraphics, lazcanvas,
|
|
//
|
|
GraphType, Controls, LCLMessageGlue, WSControls, LCLType, LCLProc;
|
|
|
|
procedure UpdateControlLazImageAndCanvas(var AImage: TLazIntfImage; var ACanvas: TLazCanvas; AWidth, AHeight: Integer);
|
|
|
|
implementation
|
|
|
|
procedure UpdateControlLazImageAndCanvas(var AImage: TLazIntfImage;
|
|
var ACanvas: TLazCanvas; AWidth, AHeight: Integer);
|
|
var
|
|
lRawImage: TRawImage;
|
|
begin
|
|
{$IFDEF VerboseWinAPI}
|
|
DebugLn(Format(':>[UpdateControlLazImageAndCanvas] Input Image: %x Canvas: %x',
|
|
[PtrInt(AImage), PtrInt(ACanvas)]));
|
|
{$ENDIF}
|
|
// Check if the image needs update
|
|
if (AImage = nil) or (AWidth <> AImage.Width) or (AHeight <> AImage.Height) then
|
|
begin
|
|
if (AImage <> nil) then AImage.Free;
|
|
|
|
lRawImage.Init;
|
|
lRawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight);
|
|
lRawImage.CreateData(True);
|
|
|
|
AImage := TLazIntfImage.Create(AWidth, AHeight);
|
|
AImage.SetRawImage(lRawImage);
|
|
|
|
if (ACanvas <> nil) then ACanvas.Free;
|
|
ACanvas := TLazCanvas.Create(AImage);
|
|
end;
|
|
{$IFDEF VerboseWinAPI}
|
|
DebugLn(Format(':<[UpdateControlLazImageAndCanvas] Output Image: %x Canvas: %x',
|
|
[PtrInt(AImage), PtrInt(ACanvas)]));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
end.
|
|
|