/examples/scrollbar.pp

http://github.com/graemeg/lazarus · Puppet · 243 lines · 214 code · 29 blank · 0 comment · 2 complexity · a6c4466e8272c72c171ac776b63a8cf9 MD5 · raw file

  1. {
  2. /***************************************************************************
  3. Scrollbar - Example
  4. ------------------
  5. Initial Revision : Thursday Feb 01 2001
  6. by Shane Miller
  7. Second Revision : Saturday Jul 12 2014
  8. by Jack D Linke
  9. ***************************************************************************/
  10. ***************************************************************************
  11. * *
  12. * This source is free software; you can redistribute it and/or modify *
  13. * it under the terms of the GNU General Public License as published by *
  14. * the Free Software Foundation; either version 2 of the License, or *
  15. * (at your option) any later version. *
  16. * *
  17. * This code is distributed in the hope that it will be useful, but *
  18. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  19. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  20. * General Public License for more details. *
  21. * *
  22. * A copy of the GNU General Public License is available on the World *
  23. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  24. * obtain it by writing to the Free Software Foundation, *
  25. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  26. * *
  27. ***************************************************************************
  28. }
  29. program Scrollbar;
  30. {$mode objfpc}{$H+}
  31. uses
  32. Interfaces, Classes, StdCtrls, Forms, Buttons, Menus, ComCtrls,
  33. SysUtils, ExtCtrls, Controls, LazLogger;
  34. type
  35. TForm1 = class(TFORM)
  36. Scrollbar1 : TScrollbar;
  37. Button1 : TButton;
  38. Button2 : TButton;
  39. Button3 : TButton;
  40. Button4 : TButton;
  41. Label1 : TLabel;
  42. Label2 : TLabel;
  43. Label3 : TLabel;
  44. LabelMin : TLabel;
  45. LabelMax : TLabel;
  46. LabelPos : TLabel;
  47. Procedure Button1Clicked(Sender : TObject);
  48. Procedure Button2Clicked(Sender : TObject);
  49. Procedure Button3Clicked(Sender : TObject);
  50. Procedure Button4Clicked(Sender : TObject);
  51. Procedure Scrollbar1Changed(Sender : TObject);
  52. procedure Scrollbar1OnScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
  53. public
  54. constructor Create(AOwner: TComponent); override;
  55. protected
  56. end;
  57. var
  58. Form1 : TForm1;
  59. constructor TForm1.Create(AOwner: TComponent);
  60. begin
  61. inherited CreateNew(AOwner, 1);
  62. Caption := 'Scrollbar Demo v0.2';
  63. Height := 350;
  64. Width := 400;
  65. ScrollBar1 := TSCrollBar.Create(self);
  66. with Scrollbar1 do
  67. Begin
  68. Parent := Self;
  69. Kind := sbVertical;
  70. Left := 100;
  71. Top := 50;
  72. Width := 15;
  73. Height := 300;
  74. Visible := True;
  75. OnChange := @scrollbar1Changed;
  76. OnScroll := @ScrollBar1OnScroll;
  77. end;
  78. Button1 := TButton.create(self);
  79. with Button1 do
  80. begin
  81. Parent := self;
  82. Visible := True;
  83. Caption := 'Swap Orientation';
  84. Onclick := @button1clicked;
  85. Width := 100;
  86. end;
  87. Button2 := TButton.create(self);
  88. with Button2 do
  89. begin
  90. Parent := self;
  91. Left := 100;
  92. Visible := True;
  93. Caption := 'Min + 20';
  94. Onclick := @button2clicked;
  95. Width := 100;
  96. end;
  97. Button3 := TButton.create(self);
  98. with Button3 do
  99. begin
  100. Parent := self;
  101. Left := 200;
  102. Visible := True;
  103. Caption := 'Max + 25';
  104. Onclick := @button3clicked;
  105. Width := 100;
  106. end;
  107. Button4 := TButton.create(self);
  108. with Button4 do
  109. begin
  110. Parent := self;
  111. Left := 300;
  112. Visible := True;
  113. Caption := 'Position + 5';
  114. Onclick := @button4clicked;
  115. Width := 100;
  116. end;
  117. Label1 := TLabel.create(self);
  118. with Label1 do
  119. begin
  120. Parent := self;
  121. Left := 125;
  122. Top := 100;
  123. Visible := True;
  124. Caption := 'Scrollbar1.Min = ';
  125. Width := 100;
  126. end;
  127. Label2 := TLabel.create(self);
  128. with Label2 do
  129. begin
  130. Parent := self;
  131. Left := 125;
  132. Top := 130;
  133. Visible := True;
  134. Caption := 'Scrollbar1.Max = ';
  135. Width := 100;
  136. end;
  137. Label3 := TLabel.create(self);
  138. with Label3 do
  139. begin
  140. Parent := self;
  141. Left := 125;
  142. Top := 160;
  143. Visible := True;
  144. Caption := 'Scrollbar1.Position = ';
  145. Width := 100;
  146. end;
  147. LabelMin := TLabel.create(self);
  148. with LabelMin do
  149. begin
  150. Parent := self;
  151. Left := 250;
  152. Top := 100;
  153. Visible := True;
  154. Caption := IntToStr(Scrollbar1.Min);
  155. Width := 100;
  156. end;
  157. LabelMax := TLabel.create(self);
  158. with LabelMax do
  159. begin
  160. Parent := self;
  161. Left := 250;
  162. Top := 130;
  163. Visible := True;
  164. Caption := IntToStr(Scrollbar1.Max);
  165. Width := 100;
  166. end;
  167. LabelPos := TLabel.create(self);
  168. with LabelPos do
  169. begin
  170. Parent := self;
  171. Left := 250;
  172. Top := 160;
  173. Visible := True;
  174. Caption := IntToStr(Scrollbar1.Position);
  175. Width := 100;
  176. end;
  177. end;
  178. procedure TForm1.Button1Clicked(Sender : TObject);
  179. begin
  180. debugln('[Button1Clicked]');
  181. if ScrollBar1.Kind = sbHorizontal then
  182. Scrollbar1.Kind := sbVertical else
  183. Scrollbar1.kind := sbHorizontal;
  184. end;
  185. procedure TForm1.Button2Clicked(Sender : TObject);
  186. begin
  187. ScrollBar1.Min := ScrollBar1.Min + 20;
  188. LabelMin.Caption := IntToStr(ScrollBar1.Min);
  189. end;
  190. procedure TForm1.Button3Clicked(Sender : TObject);
  191. begin
  192. ScrollBar1.Max := ScrollBar1.Max + 25;
  193. LabelMax.Caption := IntToStr(ScrollBar1.Max);
  194. end;
  195. procedure TForm1.Button4Clicked(Sender : TObject);
  196. begin
  197. Scrollbar1.Position := ScrollBar1.Position + 5;
  198. LabelPos.Caption := IntToStr(ScrollBar1.Position);
  199. end;
  200. procedure TForm1.Scrollbar1Changed(Sender : TObject);
  201. begin
  202. LabelMin.Caption := IntToStr(Scrollbar1.Min);
  203. LabelMax.Caption := IntToStr(Scrollbar1.Max);
  204. LabelPos.Caption := IntToStr(Scrollbar1.Position);
  205. end;
  206. procedure TForm1.Scrollbar1OnScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
  207. begin
  208. DebugLn('.............Scrolled...............');
  209. end;
  210. begin
  211. Application.Initialize; { calls InitProcedure which starts up GTK }
  212. Application.CreateForm(TForm1, Form1);
  213. Application.Run;
  214. end.