Solved

TForm with different shapes.

Posted on 1998-06-25
6
423 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an antispam), the admini…

726 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