Mega Code Archive
A form like everything you can imagine
<![CDATA[
Title: A form like everything you can imagine
Question: How to create a non-rectangular form?
Answer:
When youu need a form like a tree or something else what do you do? Windows just has the 'CreateRoundRectRegion()' function that just cuts the edges of your nice form. If you want to do something else, you need to completely draw your region in a HDC (TCanvas) while Windows looks on your hand to learn it. After this, you can set the new region to your form using the 'SetWindowRgn()' function.
----------------------------------------------------------------------------------------------------
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.
]]>