Thursday, July 13, 2006

How to create a non-rectangular form

And how to do this? Here you will find a simple example that just gives some text and sets the region like it. Expand it by your mind!

unit uMainForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus;

type
TfrmMainForm = class(TForm)
btnDoAction: TButton;
pmnPopup: TPopupMenu;
miDrawText: TMenuItem;
miExit: TMenuItem;
procedure btnDoActionClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure miExitClick(Sender: TObject);
private
{ Private declarations }
HRgn: THandle;
public
{ Public declarations }
end;

var
frmMainForm: TfrmMainForm;

implementation

{$R *.DFM}

procedure TfrmMainForm.btnDoActionClick(Sender: TObject);
var
s: String;
begin
DeleteObject(HRgn);
s := InputBox('Region Text', 'Please enter some text to set to the region', 'CoolRgn');

BeginPath(Canvas.Handle);
with Canvas do
begin
Font.Name := 'Comic Sans MS'; Font.Size := 64; Font.Style := [fsBold];
TextOut(0, 0, s);
end;

EndPath(Canvas.Handle);
HRgn := PathToRegion(Canvas.Handle);
SetWindowRgn(Handle, HRgn, True);

btnDoAction.Visible := False;
Color := clRed;
end;

procedure TfrmMainForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
DeleteObject(HRgn);
end;

procedure TfrmMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
end;

procedure TfrmMainForm.miExitClick(Sender: TObject);
begin
Application.MainForm.Close;
end;

end.