home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Help / Examples / Scrollba / SCROLDEM.PAS < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  8KB  |  313 lines
  1. //
  2. // this example demonstrates the use of TScrollBar, including how to
  3. // properly set scrolling ranges and how to respond to the scroll bar
  4. // notification events.  in addition, an interface is provided to the
  5. // user to adjust the values to see how the different parameters affect
  6. // the scrolling behavior.  no attempt is made to verify that the parameters
  7. // supplied by the user make any sense.
  8. //
  9. unit scroldem;
  10.  
  11. interface
  12.  
  13. uses
  14.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  15.   Menus, StdCtrls, ComCtrls, ExtCtrls;
  16.  
  17. type
  18.   TScrollForm1 = class(TForm)
  19.     Bevel1: TBevel;
  20.     Label3: TLabel;
  21.     Label4: TLabel;
  22.     Label5: TLabel;
  23.     Label1: TLabel;
  24.     Vertical: TLabel;
  25.     ImgPanel: TPanel;
  26.     Image: TImage;
  27.     HScrollb: TScrollBar;
  28.     VScrollb: TScrollBar;
  29.     HUnits: TEdit;
  30.     HPage: TEdit;
  31.     HMax: TEdit;
  32.     VUnits: TEdit;
  33.     VPage: TEdit;
  34.     VMax: TEdit;
  35.     HUnitsUpDown: TUpDown;
  36.     HPageUpDown: TUpDown;
  37.     HMaxUpDown: TUpDown;
  38.     VUnitsUpDown: TUpDown;
  39.     VMaxUpDown: TUpDown;
  40.     VPageUpDown: TUpDown;
  41.     DefaultBtn: TButton;
  42.     ApplyBtn: TButton;
  43.     MainMenu1: TMainMenu;
  44.     File1: TMenuItem;
  45.     Open1: TMenuItem;
  46.     N1: TMenuItem;
  47.     Exit1: TMenuItem;
  48.     View1: TMenuItem;
  49.     VScrollMenu: TMenuItem;
  50.     HScrollMenu: TMenuItem;
  51.     Help1: TMenuItem;
  52.     About1: TMenuItem;
  53.     OpenDialog: TOpenDialog;
  54.     procedure FormCreate(Sender: TObject);
  55.     procedure Exit1Click(Sender: TObject);
  56.     procedure View1Click(Sender: TObject);
  57.     procedure VScrollMenuClick(Sender: TObject);
  58.     procedure HScrollMenuClick(Sender: TObject);
  59.     procedure Open1Click(Sender: TObject);
  60.     procedure VScrollbChange(Sender: TObject);
  61.     procedure HScrollbScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
  62.     procedure ImgPanelResize(Sender: TObject);
  63.     procedure About1Click(Sender: TObject);
  64.     procedure ApplyBtnClick(Sender: TObject);
  65.     procedure DefaultBtnClick(Sender: TObject);
  66.     procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
  67.  
  68.   private
  69.     { Private declarations }
  70.     Units: TPoint;
  71.     FDirty: Boolean;
  72.  
  73.     procedure SetDirty(d: Boolean);
  74.     procedure ImageLoad(filename: string);
  75.     procedure ScrollAdjust(update: Boolean);
  76.     procedure ScrollReset;
  77.     procedure UpdateDisplay;
  78.     property Dirty: Boolean read FDirty write SetDirty;
  79.  
  80.   public
  81.     //constructor Create(Owner: TComponent); override;
  82.     { Public declarations }
  83.   end;
  84.  
  85. var
  86.   ScrollForm1: TScrollForm1;
  87.  
  88. implementation
  89.  
  90. uses about;
  91.  
  92.  
  93. {$R *.DFM}
  94.  
  95. const
  96.   DEF_SCROLL_UNITS = 8;
  97.  
  98. procedure TScrollForm1.FormCreate(Sender: TObject);
  99. begin
  100.   ScrollReset;
  101. end;
  102.  
  103. procedure TScrollForm1.Exit1Click(Sender: TObject);
  104. begin
  105.   Close;
  106. end;
  107.  
  108. procedure TScrollForm1.View1Click(Sender: TObject);
  109. begin
  110.   HScrollMenu.Checked := HScrollb.Visible;
  111.   VScrollMenu.Checked := VScrollb.Visible;
  112. end;
  113.   
  114. procedure TScrollForm1.VScrollMenuClick(Sender: TObject);
  115. begin
  116.   VScrollb.Visible := not VScrollb.Visible;
  117. end;
  118.  
  119. procedure TScrollForm1.HScrollMenuClick(Sender: TObject);
  120. begin
  121.   HScrollb.Visible := not HScrollb.Visible;
  122. end;
  123.  
  124. procedure TScrollForm1.Open1Click(Sender: TObject);
  125. begin
  126.   if OpenDialog.Execute then
  127.     ImageLoad(OpenDialog.FileName);
  128. end;
  129.  
  130. //
  131. // Hooking the OnChange event is the simplest way to handle the
  132. // scrollbar notification.  Note the check to ensure that the 
  133. // that the sender is the vertical scrollbar.  While irrelevant for
  134. // this example, some forms may need to distinguish between various
  135. // scrollbars.
  136. //
  137. procedure TScrollForm1.VScrollbChange(Sender: TObject);
  138. begin
  139.   if Sender as TScrollBar = VScrollb then
  140.     Image.Top := -Units.y * VScrollb.Position;
  141. end;
  142.  
  143. //
  144. // Hooking the OnScroll event is another option for handling the
  145. // scrollbar notification.  This is needed for a few reasons:
  146. //   1) you want to do something special with particular scroll
  147. //      events
  148. //   2) the range of your scrollbar is larger than [0, 65535].  in
  149. //      this case, the ScrollPos element is invalid and much of the
  150. //      scrolling has to be done manually.
  151. //
  152. procedure TScrollForm1.HScrollbScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
  153. begin
  154.   if HScrollb.Max <= 65535 then
  155.     Image.Left := -Units.x * ScrollPos
  156.   else
  157.     ShowMessage('Scrollbar ranges > 65535 not supported');
  158. end;
  159.  
  160. //
  161. // The panel's size doesn't change in this example, so
  162. // this event will only happen once.  In general, the range
  163. // of the scrollbars will need to be changed when the size of
  164. // the visible window is changed.
  165. //
  166. procedure TScrollForm1.ImgPanelResize(Sender: TObject);
  167. begin
  168.   ScrollAdjust(True);
  169. end;
  170.  
  171. function scale(n, u: Integer): Integer;
  172. begin
  173.   Result := (n + u - 1) div u;
  174. end;
  175.  
  176. function maxval(a, b: Integer): Integer;
  177. begin
  178.   if a >= b then
  179.     Result := a
  180.   else
  181.     Result := b;
  182. end;
  183.  
  184. //
  185. // Readjust the range of the scrollbars to match the new size
  186. // of the visible window.  (Also called by ScrollReset to avoid
  187. // duplicating the code).
  188. //
  189. procedure TScrollForm1.ScrollAdjust(update: Boolean);
  190. begin
  191.   // set the maximum scrolling to be large enough to scroll the whole
  192.   // image, but not so much that it can scroll off the window.  we
  193.   // divide by the number of Units (>1) because scrolling one pixel at
  194.   // a time is way too slow for most images of any size.
  195.  
  196.   if Image.Picture <> nil then
  197.   begin
  198.     HScrollb.Max := maxval(0, scale(Image.Width - ImgPanel.Width, Units.x));
  199.     VScrollb.Max := maxval(0, scale(Image.Height - ImgPanel.Height, Units.y));
  200.   end;
  201.  
  202.   if update then
  203.     UpdateDisplay;
  204. end;
  205.  
  206. //
  207. // ScrollReset() is used to put the scrollbars into a sane "initial"
  208. // state.  this needs to be done each time the image is changed,
  209. // since the amount we scroll depends upon the image size.  for
  210. // simplicity, the special case of "new image size" == "old image size"
  211. // is ignored.
  212. //
  213. procedure TScrollForm1.ScrollReset;
  214. begin
  215.   // this fixed size works nice, although in some cases basing
  216.   // the scroll units upon the size of the image works well, too.
  217.   Units.x := DEF_SCROLL_UNITS;
  218.   Units.y := DEF_SCROLL_UNITS;
  219.  
  220.   if Image.Picture <> nil then
  221.   begin
  222.     // move the image and the scrollbars to their "home" location
  223.     Image.Top := 0;
  224.     Image.Left := 0;
  225.     HScrollb.Position := 0;
  226.     VScrollb.Position := 0;
  227.  
  228.     // negative scrolling ranges aren't worth the trouble, so set
  229.     // the range to go from [0, M].  See 'ScrollAdjust' to see how M
  230.     // is calculated.
  231.     HScrollb.Min := 0;
  232.     VScrollb.Min := 0;
  233.     ScrollAdjust(False);
  234.  
  235.     HScrollb.LargeChange := scale(HScrollb.Max, Units.x);
  236.     VScrollb.LargeChange := scale(VScrollb.Max, Units.y);
  237.  
  238.     HScrollb.Visible := True;
  239.     VScrollb.Visible := True;
  240.   end;
  241.  
  242.   UpdateDisplay;
  243. end;
  244.  
  245.  
  246. procedure TScrollForm1.SetDirty(d: Boolean);
  247. begin
  248.   if d <> FDirty then
  249.   begin
  250.     FDirty := d;
  251.     ApplyBtn.Enabled := FDirty;
  252.   end;
  253. end;
  254.  
  255.  
  256. procedure TScrollForm1.ImageLoad(filename: string);
  257. begin
  258.   Image.Picture.LoadFromFile(filename);
  259.   ScrollReset;
  260. end;
  261.  
  262. procedure TScrollForm1.About1Click(Sender: TObject);
  263. var
  264.   about: TAboutBox;
  265. begin
  266.   about := TAboutBox.Create(Self);
  267.   try
  268.     about.ShowModal;
  269.   finally
  270.     about.Free;
  271.   end;
  272. end;
  273.  
  274.  
  275. procedure TScrollForm1.ApplyBtnClick(Sender: TObject);
  276. begin
  277.   Units.x := HUnitsUpDown.Position;
  278.   HScrollb.LargeChange := HPageUpDown.Position;
  279.   HScrollb.Max := HMaxUpDown.Position;
  280.  
  281.   Units.y := VUnitsUpDown.Position;
  282.   VScrollb.LargeChange := VPageUpDown.Position;
  283.   VScrollb.Max := VMaxUpDown.Position;
  284.  
  285.   Dirty := False;
  286. end;
  287.  
  288. procedure TScrollForm1.DefaultBtnClick(Sender: TObject);
  289. begin
  290.   ScrollReset;
  291.   Dirty := False;
  292. end;
  293.  
  294. procedure TScrollForm1.UpDownClick(Sender: TObject; Button: TUDBtnType);
  295. begin
  296.   Dirty := True;
  297. end;
  298.  
  299. procedure TScrollForm1.UpdateDisplay;
  300. begin
  301.   HUnitsUpDown.Position := Units.x;
  302.   HPageUpDown.Position := HScrollb.LargeChange;
  303.   HMaxUpDown.Position := HScrollb.Max;
  304.  
  305.   VUnitsUpDown.Position := Units.y;
  306.   VPageUpDown.Position := VScrollb.LargeChange;
  307.   VMaxUpDown.Position := VScrollb.Max;
  308.  
  309.   Dirty := False;
  310. end;
  311.  
  312. end.
  313.