Mega Code Archive
Form Roll Up and Down 2010
<![CDATA[
Title: Form Roll Up and Down 2010
Question: How to make your form roll itself up and down by clicking on the titlebar without the use of third part components
Answer:
Form roll up and down
This form, when clicked on the titlebar rolls itself up and when clicked again rolls itself down. Just example code on how to create this yourself, do not rely on third party components if you dont have to!
This shows how easy it can be, to add neat effects to your forms, without having to buy any code from anyone! This form, when clicked on the titlebar unfolds and clicking again makes it unfold.
------------------------------------------------------------------
Project1.dpr
------------------------------------------------------------------
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.Title := 'FRollUpDown';
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
------------------------------------------------------------------
------------------------------------------------------------------
Unit1.dfm
------------------------------------------------------------------
object Form1: TForm1
Left = 200
Top = 196
BorderIcons = []
BorderStyle = bsDialog
Caption = 'Form1'
ClientHeight = 243
ClientWidth = 623
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClick = FormClick
PixelsPerInch = 96
TextHeight = 13
object lbl1: TLabel
Left = 200
Top = 88
Width = 249
Height = 26
Caption =
'Click anywhere on the form to close'#13#10'Right click on the titlebar' +
' to fold and unfold'
Font.Charset = DEFAULT_CHARSET
Font.Color = clMaroon
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
end
------------------------------------------------------------------
------------------------------------------------------------------
Unit1.pas
------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
lbl1: TLabel;
procedure FormClick(Sender: TObject);
private
fOldClientHeight: Integer;
procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown) ; message WM_NCRBUTTONDOWN;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMNCRButtonDown(var Msg: TWMNCRButtonDown) ;
var
h : integer;
begin
if (Msg.HitTest = HTCAPTION) then
begin
if (ClientHeight = 0) then
begin
for h := 0 to fOldClientHeight do ClientHeight := h;
Application.ProcessMessages;
end
else
begin
fOldClientHeight := ClientHeight;
for h := fOldClientHeight downto 0 do ClientHeight := h;
Application.ProcessMessages;
end;
end;
end;
procedure TForm1.FormClick(Sender: TObject);
begin
Close;
end;
end.
------------------------------------------------------------------
]]>