Navigation

How to create a non-rectangular TPanel

unitShapedPanel;interfaceusesWindows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ExtCtrls;typeTShapedPanel=class(TCustomControl)privateFBorderColor:TColor;IsLoaded:Boolean;FBorderWidth:Integer;FRgn,FRgn2:HRGN;RgnBrush:TBrush;FFillColor:TColor;procedureSetFillColor(constValue:TColor);functionGetFillColor:TColor;procedureMakeRegion;procedureSetBorderColor(Value:TColor);procedureWMSize(varMsg:TMessage);messageWM_SIZE;protectedprocedurePaint;override;procedureCreateWnd;override;publicconstructorCreate(AOwner:TComponent);override;destructorDestroy;override;publishedpropertyBorderColor:TColorreadFBorderColorwriteSetBorderColordefaultclBlack;propertyBorderWidth:IntegerreadFBorderWidthwriteFBorderWidthdefault2;propertyFillColor:TColorreadGetFillColorwriteSetFillColor;propertyHeightdefault200;propertyWidthdefault200;propertyOnClick;propertyOnContextPopup;propertyOnDblClick;propertyOnEndDock;propertyOnEndDrag;propertyOnEnter;propertyOnExit;propertyOnMouseDown;propertyOnMouseMove;propertyOnMouseUp;propertyOnResize;propertyOnStartDrag;end;procedureRegister;implementationprocedureRegister;beginRegisterComponents('EXS',[TShapedPanel]);end;constructorTShapedPanel.Create(AOwner:TComponent);begininheritedCreate(AOwner);ControlStyle:=[csCaptureMouse,csClickEvents,csOpaque,csDoubleClicks];Width:=200;Height:=200;RgnBrush:=TBrush.Create;RgnBrush.Color:=clBlack;FFillColor:=clWhite;IsLoaded:=False;FBorderWidth:=2;FBorderColor:=clBlack;FRgn:=0;FRgn2:=0;end;destructorTShapedPanel.Destroy;beginDeleteObject(FRgn);DeleteObject(FRgn2);inherited;end;procedureTShapedPanel.CreateWnd;begininherited;MakeRegion;IsLoaded:=True;{IsLoaded is to make sure MakeRegion is not called before there is a Handle for this control, but it may not be nessary}end;procedureTShapedPanel.MakeRegion;varx4,y2:Integer;FPoints:array[0..5]ofTPoint;begin{I moved the Region creation to this procedure so it can be called for WM_SIZE}SetWindowRgn(Handle,0,False);{this clears the window region}ifFRgn<>0thenbegin{Make sure to Always DeleteObject for a Region}DeleteObject(FRgn);DeleteObject(FRgn2);FRgn:=0;FRgn2:=0;end;x4:=Widthdiv4;y2:=Heightdiv2;FPoints[0]:=Point(x4,0);FPoints[1]:=Point(Width-x4,0);FPoints[2]:=Point(Width,y2);FPoints[3]:=Point(Width-x4,Height);FPoints[4]:=Point(x4,Height);FPoints[5]:=Point(0,y2);FRgn:=CreatePolygonRgn(FPoints,6,WINDING);SetWindowRGN(Handle,FRgn,True);FRgn2:=CreatePolygonRgn(FPoints,6,WINDING);{FRgn2 is used for FrameRgn in Paint}end;procedureTShapedPanel.WMSize(varMsg:TMessage);varTmpClr:TColor;begininherited;ifIsLoadedthenbeginTmpClr:=Canvas.Brush.Color;Canvas.Brush.Color:=FFillColor;MakeRegion;FillRgn(Canvas.Handle,FRgn2,Canvas.Brush.Handle);Paint;Canvas.Brush.Color:=TmpClr;end;end;procedureTShapedPanel.Paint;varTmpClr:TColor;begininherited;ifIsLoadedthenbeginTmpClr:=Canvas.Brush.Color;Canvas.Brush.Color:=FFillColor;MakeRegion;FillRgn(Canvas.Handle,FRgn2,Canvas.Brush.Handle);FrameRgn(Canvas.Handle,FRgn2,RgnBrush.Handle,FBorderWidth,FBorderWidth);Canvas.Brush.Color:=TmpClr;end;end;procedureTShapedPanel.SetBorderColor(Value:TColor);beginifFBorderColor<>ValuethenbeginFBorderColor:=Value;RgnBrush.Color:=FBorderColor;Paint;end;end;procedureTShapedPanel.SetFillColor(constValue:TColor);beginifFFillColor<>ValuethenbeginFFillColor:=Value;Paint;endend;functionTShapedPanel.GetFillColor:TColor;beginResult:=FFillColor;end;end.

This component creates a hexagonal panel that does not display its caption.

In this demo we dynamically create a TShapedPanel on
a form and make it host a label and an edit control to show it is
a proper panel. Proceed as follows:

Start a new Delphi VCL application.

Create a copy of the ShapedPanel unit presented
above, save it as ShapedPanel.pas and add it to
the project.

Name the project's main form "Form1" and save the form
unit as Unit1.pas.

Add a TLabel and TEdit to the form.

Create an OnCreate event handler for
TForm1.

Code Unit1.pas as follows:

unitUnit1;interfaceusesForms,Controls,StdCtrls,Classes,ShapedPanel;typeTForm1=class(TForm)Label1:TLabel;Edit1:TEdit;procedureFormCreate(Sender:TObject);privatefPnl:TShapedPanel;end;varForm1:TForm1;implementationusesGraphics;{$R *.dfm}{ TForm1 }procedureTForm1.FormCreate(Sender:TObject);beginfPnl:=TShapedPanel.Create(Self);fPnl.Parent:=Self;fPnl.Left:=40;fPnl.Top:=40;fPnl.Width:=200;fPnl.Height:=200;// Add label & edit box to panelEdit1.Parent:=fPnl;Edit1.Top:=80;Edit1.Left:=(fPnl.ClientWidth-Edit1.Width)div2;Label1.Parent:=fPnl;Label1.Top:=Edit1.Top-Label1.Height-8;Label1.Left:=Edit1.Left;// The following properties can be changed to see the effect// on TShapedPanelfPnl.BorderColor:=clRed;fPnl.BorderWidth:=4;fPnl.FillColor:=clBtnFace;end;end.

You should change the values of the shaped panel's
BorderWidth, BorderColor and
FillColor properties to see the effect. These properties
are set in the form's FormCreate method.