home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / delphi / rollup.lzh / ROLLFORM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-03  |  4.7 KB  |  173 lines
  1. { Modified Roll Up Form 
  2.   ==================
  3.  
  4.   by Curtis White
  5.        President, TechnoSoft
  6.  
  7.        7/4/95
  8.  
  9.   This is my modification of the rollup form created by Casey Charlton.
  10.   It acts and looks almost exactly like the rollup forms in Photoshop.
  11.  
  12.   ---------------------------------------------------------------------------------------------------------------
  13.  
  14.   Original text.
  15.  
  16.   Form to use as 'Roll Up', similar to Corel, Photoshop, etc.
  17.  
  18.   by Casey Charlton - 29/6/95  (casey@larouss.demon.co.uk)
  19.  
  20.   based on code by Anders Ohlsson (ao@sto.fao.se)
  21.  
  22.   This form is Freeware, please use it as you want. If you find
  23.   it useful, send me an message - casey@larouss.demon.co.uk
  24.  
  25.   To use it - Enlarge the 'FormArea' panel to the size that you want
  26.   the roll up to cover, and place your controls within it. Edit the
  27.   FormCreate code to change colors, caption, etc.   
  28.  
  29.   ---------------------------------------------------------------------------------------------------------------
  30.  
  31. This form is also Freeware.  Enjoy!
  32.  
  33. }
  34.  
  35. unit Rollform;
  36.  
  37. interface
  38.  
  39. uses
  40.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  41.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus;
  42.  
  43. type
  44.   TRollUp = class(TForm)
  45.     FormArea: TPanel;
  46.     CaptionPanel: TPanel;
  47.     CloseButton: TSpeedButton;
  48.     CaptionLabel: TLabel;
  49.     RollButton: TSpeedButton;
  50.     CloseMenu: TPopupMenu;
  51.     CloseMenuItem: TMenuItem;
  52.     procedure CaptionPanelMouseDown(Sender: TObject; Button: TMouseButton;
  53.       Shift: TShiftState; X, Y: Integer);
  54.     procedure CaptionPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  55.       Y: Integer);
  56.     procedure CaptionPanelMouseUp(Sender: TObject; Button: TMouseButton;
  57.       Shift: TShiftState; X, Y: Integer);
  58.     procedure RollButtonClick(Sender: TObject);
  59.     procedure FormCreate(Sender: TObject);
  60.     procedure CloseButtonClick(Sender: TObject);
  61.     procedure CloseMenuItemClick(Sender: TObject);
  62.   private
  63.     { Private declarations }
  64.     OldX,
  65.     OldY,
  66.     OldLeft,
  67.     OldTop,
  68.     RolledDownHeight   : Integer;
  69.     ScreenDC           : HDC;
  70.     MoveRect           : TRect;
  71.     Moving             : Boolean;
  72.   public
  73.     { Public declarations }
  74.   end;
  75.  
  76. var
  77.   RollUp: TRollUp;
  78.  
  79. implementation
  80.  
  81. {$R *.DFM}
  82.  
  83. { Code for dragging the form }
  84. procedure TRollUp.CaptionPanelMouseDown(Sender: TObject; Button: TMouseButton;
  85.   Shift: TShiftState; X, Y: Integer);
  86. begin
  87.   if Button = mbLeft then begin
  88.     SetCapture(CaptionPanel.Handle);
  89.     ScreenDC := GetDC(0);
  90.     OldX := X;
  91.     OldY := Y;
  92.     OldLeft := X;
  93.     OldTop := Y;
  94.     MoveRect := BoundsRect;
  95.     DrawFocusRect(ScreenDC,MoveRect);
  96.     Moving := True;
  97.   end;
  98. end;
  99.  
  100. { Code for dragging the form }
  101. procedure TRollUp.CaptionPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  102.   Y: Integer);
  103. begin
  104.   if Moving then begin
  105.     DrawFocusRect(ScreenDC,MoveRect);
  106.     OldX := X;
  107.     OldY := Y;
  108.     MoveRect := Rect(Left+OldX-OldLeft,Top+OldY-OldTop,
  109.                      Left+Width+OldX-OldLeft,Top+Height+OldY-OldTop);
  110.     DrawFocusRect(ScreenDC,MoveRect);
  111.   end;
  112. end;
  113.  
  114. { Code for dragging the form }
  115. procedure TRollUp.CaptionPanelMouseUp(Sender: TObject; Button: TMouseButton;
  116.   Shift: TShiftState; X, Y: Integer);
  117. begin
  118.   if Button = mbLeft then begin
  119.     ReleaseCapture;
  120.     DrawFocusRect(ScreenDC,MoveRect);
  121.     Left := Left+X-OldLeft;
  122.     Top := Top+Y-OldTop;
  123.     ReleaseDC(0,ScreenDC);
  124.     Moving := False;
  125.   end;
  126. end;
  127.  
  128. procedure TRollUp.RollButtonClick(Sender: TObject);
  129. begin
  130.   if ClientHeight = RolledDownHeight then   { it's currently down }
  131.   begin
  132.     ClientHeight := CaptionPanel.Height + 5;      { set it to the caption bar's height }
  133.   end
  134.   else
  135.   begin                                     { it's rolled up }
  136.     ClientHeight := RolledDownHeight;       { set it to full size }
  137.   end;
  138. end;
  139.  
  140. procedure TRollUp.FormCreate(Sender: TObject);
  141. begin
  142.   { Position buttons - correct for panel as default,
  143.     adjust if necessary }
  144.   CloseButton.Left := 0;
  145.   CloseButton.Top := 0;
  146.   RollButton.Left := CaptionPanel.ClientWidth - RollButton.Width;
  147.   RollButton.Top :=0;
  148.   { Preserve height of form }
  149.   RolledDownHeight := ClientHeight;
  150. end;
  151.  
  152. procedure TRollUp.CloseButtonClick(Sender: TObject);
  153. begin
  154. {Close clicked - close down form. Use .Show to bring
  155.  it back again}
  156.   if ClientHeight = RolledDownHeight then   { it's currently down }
  157.   begin
  158.     CloseMenu.AutoPopup := False;
  159.     CloseMenu.Popup(Left + CloseButton.Left + 5, Top + CloseButton.Height + 4);
  160.   end
  161.   else
  162.   begin                                     { it's rolled up }
  163.     Close;
  164.   end;
  165. end;
  166.  
  167. procedure TRollUp.CloseMenuItemClick(Sender: TObject);
  168. begin
  169.   Close;
  170. end;
  171.  
  172. end.
  173.