Solved

TForm with different shapes.

Posted on 1998-06-25
6
417 Views
Last Modified: 2010-04-04
Is there a way to have a TForm with a different shape other than a rectangle, let's say a circle, triangle, etc?
0
Comment
Question by:acerola
6 Comments
 
LVL 2

Expert Comment

by:kjteng
ID: 1355918
Would you still call that a "Form"?
0
 
LVL 4

Accepted Solution

by:
BoRiS earned 100 total points
ID: 1355919
acerola

Yes there is a way to do this, infact there is various ways to do this...by using windowregions etc.

here is code I got to show how to create a round form...(just cut and paste)

first pass this in your private section

  private
    { Private declarations }
    rTitleBar : THandle;
    Center    : TPoint;
    CapY   : Integer;
    Circum    : Double;
    SB1       : TSpeedButton;
    RL, RR    : Double;
    procedure TitleBar(Act : Boolean);
    procedure WMNCHITTEST(var Msg: TWMNCHitTest);
      message WM_NCHITTEST;
    procedure WMNCACTIVATE(var Msg: TWMNCACTIVATE);
      message WM_NCACTIVATE;
    procedure WMSetText(var Msg: TWMSetText);
      message WM_SETTEXT;

then create these const's...

CONST
  TitlColors : ARRAY[Boolean] OF TColor =
    (clInactiveCaption, clActiveCaption);
  TxtColors : ARRAY[Boolean] OF TColor =
    (clInactiveCaptionText, clCaptionText);

then pass this on the onform create...

VAR
  rTemp, rTemp2    : THandle;
  Vertices : ARRAY[0..2] OF TPoint;
  X, Y     : INteger;
begin
  Caption := 'OOOH! Doughnuts!';
  BorderStyle := bsNone; {required}
  IF Width > Height THEN Width := Height
  ELSE Height := Width;  {harder to calc if width <> height}
  Center  := Point(Width DIV 2, Height DIV 2);
  CapY := GetSystemMetrics(SM_CYCAPTION)+8;
  rTemp := CreateEllipticRgn(0, 0, Width, Height);
  rTemp2 := CreateEllipticRgn((Width DIV 4), (Height DIV 4),
    3*(Width DIV 4), 3*(Height DIV 4));
  CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF);
  SetWindowRgn(Handle, rTemp, True);
  DeleteObject(rTemp2);
  rTitleBar  := CreateEllipticRgn(4, 4, Width-4, Height-4);
  rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY);
  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF);
  Vertices[0] := Point(0,0);
  Vertices[1] := Point(Width, 0);
  Vertices[2] := Point(Width DIV 2, Height DIV 2);
  rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE);
  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND);
  DeleteObject(rTemp);
  RL := ArcTan(Width / Height);
  RR := -RL + (22 / Center.X);
  X := Center.X-Round((Center.X-1-(CapY DIV 2))*Sin(RR));
  Y := Center.Y-Round((Center.Y-1-(CapY DIV 2))*Cos(RR));
  SB1 := TSpeedButton.Create(Self);
  WITH SB1 DO
    BEGIN
      Parent     := Self;
      Left       := X;
      Top        := Y;
      Width      := 14;
      Height     := 14;
      OnClick    := Button1Click;
      Caption    := 'X';
      Font.Style := [fsBold];
    END;
end;

then pass the following procedures...

procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest);
begin
  Inherited;
  WITH Msg DO
    WITH ScreenToClient(Point(XPos,YPos)) DO
      IF PtInRegion(rTitleBar, X, Y) AND
       (NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THEN
        Result := htCaption;
end;

procedure TForm1.WMNCActivate(var Msg: TWMncActivate);
begin
  Inherited;
  TitleBar(Msg.Active);
end;

procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
  Inherited;
  TitleBar(Active);
end;

procedure TForm1.TitleBar(Act: Boolean);
VAR
  TF      : TLogFont;
  R       : Double;
  N, X, Y : Integer;
begin
  IF Center.X = 0 THEN Exit;
  WITH Canvas DO
    begin
      Brush.Style := bsSolid;
      Brush.Color := TitlColors[Act];
      PaintRgn(Handle, rTitleBar);
      R  := RL;
      Brush.Color := TitlColors[Act];
      Font.Name := 'Arial';
      Font.Size := 12;
      Font.Color := TxtColors[Act];
      Font.Style := [fsBold];
      GetObject(Font.Handle, SizeOf(TLogFont), @TF);
      FOR N := 1 TO Length(Caption) DO
        BEGIN
          X := Center.X-Round((Center.X-6)*Sin(R));
          Y := Center.Y-Round((Center.Y-6)*Cos(R));
          TF.lfEscapement := Round(R * 1800 / pi);
          Font.Handle := CreateFontIndirect(TF);
          TextOut(X, Y, Caption[N]);
          R := R - (((TextWidth(Caption[N]))+2) / Center.X);
          IF R < RR THEN Break;
        END;
      Font.Name := 'MS Sans Serif';
      Font.Size := 8;
      Font.Color := clWindowText;
      Font.Style := [];
    end;
end;

then finally pass this on the onformpaint....

begin
  WITH Canvas DO
    BEGIN
      Pen.Color := clBlack;
      Brush.Style := bsClear;
      Pen.Width := 1;
      Pen.Color := clWhite;
      Arc(1, 1, Width-1, Height-1, Width, 0, 0, Height);
      Arc((Width DIV 4)-1, (Height DIV 4)-1,
        3*(Width DIV 4)+1, 3*(Height DIV 4)+1, 0, Height, Width, 0);
      Pen.Color := clBlack;
      Arc(1, 1, Width-1, Height-1, 0, Height, Width, 0);
      Arc((Width DIV 4)-1, (Height DIV 4)-1,
        3*(Width DIV 4)+1, 3*(Height DIV 4)+1, Width, 0, 0, Height);
      TitleBar(Active);
    END;
end;

and that should be it...there are also prewritten components on torry's page for this...
www.torry.ru

anyway enjoy I know I did when I got this...

Later
BoRiS
0
 
LVL 1

Author Comment

by:acerola
ID: 1355920
I just used 2 lines of your code. On the FormCreate event I put the CreateRgn and SetWinRgn and it works just fine for simple regions (polygons and ellipses), but how about complex regions? For example, I have a drawing of a xmas tree, and I want to define the region around the tree. Do you have any suggestion?
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Expert Comment

by:phv
ID: 1355921
Hi here's a unit I use for creating different Formshapes.

unit startup;

interface

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

type
  TForm19 = class(TForm)
    Label1: TLabel;
    Image1: TImage;
    Gauge1: TGauge;
    procedure DrawRndRectRegion(wnd : HWND; rect : TRect);
    procedure DrawEllipticRegion(wnd : HWND; rect : TRect);
    procedure DrawPolygonRegion(wnd : HWND; rect : TRect; NumPoints : Integer; DoStarShape : Boolean);
    procedure FormShow(Sender: TObject);

  private
    { Private declarations }
    rgn : HRGN;
    rect : TRect;
  public
    { Public declarations }
  end;

var
  Form19: TForm19;

implementation

{$R *.DFM}

procedure TForm19.DrawRndRectRegion(wnd : HWND; rect : TRect);
begin
  rgn := CreateRoundRectRgn(rect.left, rect.top, rect.right, rect.bottom, 30, 30);
  SetWindowRgn(wnd, rgn, TRUE);
end;

procedure TForm19.DrawEllipticRegion(wnd : HWND; rect : TRect);
begin
  rgn := CreateEllipticRgn(rect.left, rect.top, rect.right, rect.bottom);
  SetWindowRgn(wnd, rgn, TRUE);
end;

procedure TForm19.DrawPolygonRegion(wnd : HWND; rect : TRect; NumPoints : Integer; DoStarShape : Boolean);
const
  RadConvert = PI/180;
  Degrees    = 360;
  MaxLines   = 100;
var
  x, y,
  xCenter,
  yCenter,
  radius,
  pts,
  I       : Integer;
  angle,
  rotation: Extended;
  arPts   : Array[0..MaxLines] of TPoint;
begin

  xCenter := (rect.Right - rect.Left) div 2;
  yCenter := (rect.Bottom - rect.Top) div 2;
  if DoStarShape then
    begin
      rotation := Degrees/(2*NumPoints);
      pts := 2 * NumPoints;
    end
  else
    begin
      rotation := Degrees/NumPoints;             //get number of degrees to turn per point
      pts := NumPoints
    end;
  radius := yCenter;

  for I := 0 to pts - 1 do begin
    if DoStarShape then
      if (I mod 2) = 0 then //which means that
        radius := Round(radius/2)
      else
        radius := yCenter;

    angle := ((I * rotation) + 90) * RadConvert;
    x := xCenter + Round(cos(angle) * radius);
    y := yCenter - Round(sin(angle) * radius);
    arPts[I].X := x;
    arPts[I].Y := y;
  end;

  rgn := CreatePolygonRgn(arPts, pts, WINDING);
  SetWindowRgn(wnd, rgn, TRUE);
end;

{
procedure TForm1.Button1Click(Sender: TObject);
begin
  DrawEllipticRegion(Form1.Handle, Form1.ClientRect);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DrawPolygonRegion(Panel1.Handle, Panel1.BoundsRect, SpinEdit1.Value, False);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  DrawRndRectRegion(Form1.Handle, Form1.ClientRect);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  DrawPolygonRegion(Panel1.Handle, Panel1.BoundsRect, SpinEdit1.Value, True);
end;
}
procedure TForm19.FormShow(Sender: TObject);
begin
{  DrawEllipticRegion(Form19.Handle, Form19.ClientRect);}
  DrawRndRectRegion(Form19.Handle, Form19.ClientRect);
end;

end.

0
 
LVL 1

Author Comment

by:acerola
ID: 1355922
phv, your suggestion is just like boris's. It's very easy (now) to make elliptical, rectangular and round-rectangular regions, but when the region is more complex, as I described, things are different. Before grading boris's question, I would like suggestions on how to define these complex regions.
0
 
LVL 4

Expert Comment

by:BoRiS
ID: 1355923
acerola

Please grade this answer...

Hope it helped

Later
BoRiS
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
This Micro Tutorial will teach you how to censor certain areas of your screen. The example in this video will show a little boy's face being blurred. This will be demonstrated using Adobe Premiere Pro CS6.
This is used to tweak the memory usage for your computer, it is used for servers more so than workstations but just be careful editing registry settings as it may cause irreversible results. I hold no responsibility for anything you do to the regist…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now