mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-17 15:42:35 +02:00
149d3a219a
- fix screenshot example bug (use GetDC(0) instead of DC = 0) - fix image example - clear LazIntfImage before experiments (part of issue #0019123) - remove all .lrs, .rc files and use .lfm, .res instead git-svn-id: trunk@30244 -
56 lines
898 B
ObjectPascal
56 lines
898 B
ObjectPascal
unit shapedwindowtest;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, LCLIntf, LCLType;
|
|
|
|
type
|
|
|
|
{ TfrmShapedWindow }
|
|
|
|
TfrmShapedWindow = class(TForm)
|
|
btnClose: TButton;
|
|
procedure FormShow(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
frmShapedWindow: TfrmShapedWindow;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
{ TfrmShapedWindow }
|
|
|
|
procedure TfrmShapedWindow.FormShow(Sender: TObject);
|
|
{var
|
|
Rgn: HRGN;
|
|
begin
|
|
Rgn := LCLIntf.CreateEllipticRgn(0, 0, 200, 200);
|
|
LCLIntf.SetWindowRgn(Handle, Rgn, False);
|
|
LCLIntf.DeleteObject(Rgn);}
|
|
var
|
|
Shape: TBitmap;
|
|
begin
|
|
Shape := TBitmap.Create;
|
|
try
|
|
Shape.Width := 200;
|
|
Shape.Height := 200;
|
|
Shape.Canvas.Ellipse(0, 0, 200, 200);
|
|
SetShape(Shape);
|
|
finally
|
|
Shape.Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|