Solved

Form Shapes

Posted on 1997-12-17
4
268 Views
Last Modified: 2010-04-04
Ages ago I saw some code which would allow a programmer to change the shape of their forms from the old square types to a circle or ellipse.  Does anyone know how to do this?  

Stu
0
Comment
Question by:SJohnson
4 Comments
 
LVL 7

Accepted Solution

by:
ahalya earned 50 total points
ID: 1354095
you do that using the Region functions.

Here are the relevant parts from an example i fetched from the net a while ago. sorry i don't have the authors name/info around.



procedure TForm1.DrawRndRectRegion(wnd : HWND; rect : TRect);

begin
rgn := CreateRoundRectRgn(rect.left, rect.top, rect.right, rect.bottom, SpinEdit3.Value*200,SpinEdit3.Value);
SetWindowRgn(wnd, rgn, TRUE);
end;

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



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

0
 
LVL 5

Expert Comment

by:ronit051397
ID: 1354096
There is an article about that on The Delphi Corner:
http://www.delumpa.com/
0
 
LVL 1

Author Comment

by:SJohnson
ID: 1354097
Thanks for that.  Did the trick.

Stu
0
 

Expert Comment

by:josephhalter
ID: 1354098
There are many solutions to do this. An exellent exemple of special form written by Neil Rubenking and now release in the Public Domain. This is a dont shaped form with a curved title bar. It works fine. Everyone should use it at less one time. The only thing you have to do is to create a new project, save the main form as rgnu.pas. Then, you should paste the following text in this file (replacing its contents) :

unit rgnu;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  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;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

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

procedure TForm1.FormCreate(Sender: TObject);
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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
End;

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;

procedure TForm1.FormPaint(Sender: TObject);
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;

end.
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
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…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

744 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

12 Experts available now in Live!

Get 1:1 Help Now