home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1997 May
/
Pcwk0597.iso
/
delphi
/
rollup.lzh
/
ROLLFORM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-08-03
|
5KB
|
173 lines
{ Modified Roll Up Form
==================
by Curtis White
President, TechnoSoft
7/4/95
This is my modification of the rollup form created by Casey Charlton.
It acts and looks almost exactly like the rollup forms in Photoshop.
---------------------------------------------------------------------------------------------------------------
Original text.
Form to use as 'Roll Up', similar to Corel, Photoshop, etc.
by Casey Charlton - 29/6/95 (casey@larouss.demon.co.uk)
based on code by Anders Ohlsson (ao@sto.fao.se)
This form is Freeware, please use it as you want. If you find
it useful, send me an message - casey@larouss.demon.co.uk
To use it - Enlarge the 'FormArea' panel to the size that you want
the roll up to cover, and place your controls within it. Edit the
FormCreate code to change colors, caption, etc.
---------------------------------------------------------------------------------------------------------------
This form is also Freeware. Enjoy!
}
unit Rollform;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus;
type
TRollUp = class(TForm)
FormArea: TPanel;
CaptionPanel: TPanel;
CloseButton: TSpeedButton;
CaptionLabel: TLabel;
RollButton: TSpeedButton;
CloseMenu: TPopupMenu;
CloseMenuItem: TMenuItem;
procedure CaptionPanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure CaptionPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure CaptionPanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure RollButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CloseButtonClick(Sender: TObject);
procedure CloseMenuItemClick(Sender: TObject);
private
{ Private declarations }
OldX,
OldY,
OldLeft,
OldTop,
RolledDownHeight : Integer;
ScreenDC : HDC;
MoveRect : TRect;
Moving : Boolean;
public
{ Public declarations }
end;
var
RollUp: TRollUp;
implementation
{$R *.DFM}
{ Code for dragging the form }
procedure TRollUp.CaptionPanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
SetCapture(CaptionPanel.Handle);
ScreenDC := GetDC(0);
OldX := X;
OldY := Y;
OldLeft := X;
OldTop := Y;
MoveRect := BoundsRect;
DrawFocusRect(ScreenDC,MoveRect);
Moving := True;
end;
end;
{ Code for dragging the form }
procedure TRollUp.CaptionPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Moving then begin
DrawFocusRect(ScreenDC,MoveRect);
OldX := X;
OldY := Y;
MoveRect := Rect(Left+OldX-OldLeft,Top+OldY-OldTop,
Left+Width+OldX-OldLeft,Top+Height+OldY-OldTop);
DrawFocusRect(ScreenDC,MoveRect);
end;
end;
{ Code for dragging the form }
procedure TRollUp.CaptionPanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
ReleaseCapture;
DrawFocusRect(ScreenDC,MoveRect);
Left := Left+X-OldLeft;
Top := Top+Y-OldTop;
ReleaseDC(0,ScreenDC);
Moving := False;
end;
end;
procedure TRollUp.RollButtonClick(Sender: TObject);
begin
if ClientHeight = RolledDownHeight then { it's currently down }
begin
ClientHeight := CaptionPanel.Height + 5; { set it to the caption bar's height }
end
else
begin { it's rolled up }
ClientHeight := RolledDownHeight; { set it to full size }
end;
end;
procedure TRollUp.FormCreate(Sender: TObject);
begin
{ Position buttons - correct for panel as default,
adjust if necessary }
CloseButton.Left := 0;
CloseButton.Top := 0;
RollButton.Left := CaptionPanel.ClientWidth - RollButton.Width;
RollButton.Top :=0;
{ Preserve height of form }
RolledDownHeight := ClientHeight;
end;
procedure TRollUp.CloseButtonClick(Sender: TObject);
begin
{Close clicked - close down form. Use .Show to bring
it back again}
if ClientHeight = RolledDownHeight then { it's currently down }
begin
CloseMenu.AutoPopup := False;
CloseMenu.Popup(Left + CloseButton.Left + 5, Top + CloseButton.Height + 4);
end
else
begin { it's rolled up }
Close;
end;
end;
procedure TRollUp.CloseMenuItemClick(Sender: TObject);
begin
Close;
end;
end.