/examples/gridexamples/grid_semaphor/example/unit1.pas

http://github.com/graemeg/lazarus · Pascal · 227 lines · 169 code · 31 blank · 27 comment · 10 complexity · 34fd67d6a3775c15fc3dd70af8ba9dcd MD5 · raw file

  1. {
  2. ***************************************************************************
  3. * *
  4. * This source is free software; you can redistribute it and/or modify *
  5. * it under the terms of the GNU General Public License as published by *
  6. * the Free Software Foundation; either version 2 of the License, or *
  7. * (at your option) any later version. *
  8. * *
  9. * This code is distributed in the hope that it will be useful, but *
  10. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  11. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  12. * General Public License for more details. *
  13. * *
  14. * A copy of the GNU General Public License is available on the World *
  15. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  16. * obtain it by writing to the Free Software Foundation, *
  17. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  18. * *
  19. ***************************************************************************
  20. Author: Salvatore Coppola
  21. }
  22. unit Unit1;
  23. {$mode objfpc}{$H+}
  24. interface
  25. uses
  26. Classes, Forms, Dialogs, Grids, SemaphorGrids, StdCtrls;
  27. type
  28. { TForm1 }
  29. TForm1 = class(TForm)
  30. Button1: TButton;
  31. Button10: TButton;
  32. Button11: TButton;
  33. Button12: TButton;
  34. Button13: TButton;
  35. Button14: TButton;
  36. Button15: TButton;
  37. Button2: TButton;
  38. Button3: TButton;
  39. Button4: TButton;
  40. Button5: TButton;
  41. Button6: TButton;
  42. Button7: TButton;
  43. Button8: TButton;
  44. Button9: TButton;
  45. CheckBox1: TCheckBox;
  46. CheckBox2: TCheckBox;
  47. OpenDialog1: TOpenDialog;
  48. RadioButton1: TRadioButton;
  49. RadioButton2: TRadioButton;
  50. SaveDialog1: TSaveDialog;
  51. SemaphorGrid1: TSemaphorGrid;
  52. SemaphorGrid2: TSemaphorGrid;
  53. SemaphorGrid3: TSemaphorGrid;
  54. ToggleBox1: TToggleBox;
  55. procedure Button10Click(Sender: TObject);
  56. procedure Button11Click(Sender: TObject);
  57. procedure Button12Click(Sender: TObject);
  58. procedure Button13Click(Sender: TObject);
  59. procedure Button14Click(Sender: TObject);
  60. procedure Button15Click(Sender: TObject);
  61. procedure Button1Click(Sender: TObject);
  62. procedure Button2Click(Sender: TObject);
  63. procedure Button3Click(Sender: TObject);
  64. procedure Button4Click(Sender: TObject);
  65. procedure Button5Click(Sender: TObject);
  66. procedure Button6Click(Sender: TObject);
  67. procedure Button7Click(Sender: TObject);
  68. procedure Button8Click(Sender: TObject);
  69. procedure Button9Click(Sender: TObject);
  70. procedure CheckBox2Click(Sender: TObject);
  71. procedure Form1Create(Sender: TObject);
  72. procedure ToggleBox1Click(Sender: TObject);
  73. private
  74. { private declarations }
  75. public
  76. { public declarations }
  77. end;
  78. var
  79. Form1: TForm1;
  80. implementation
  81. {$R *.lfm}
  82. { TForm1 }
  83. procedure TForm1.Button1Click(Sender: TObject);
  84. begin
  85. SemaphorGrid1.Semaphor:=not SemaphorGrid1.Semaphor;
  86. end;
  87. procedure TForm1.Button10Click(Sender: TObject);
  88. begin
  89. if SemaphorGrid1.ColCount>1 then
  90. if SemaphorGrid1.ColWidths[1]=SemaphorGrid1.GridLineWidth then
  91. SemaphorGrid1.ShowCol(1)
  92. else
  93. SemaphorGrid1.HideCol(1);
  94. end;
  95. procedure TForm1.Button11Click(Sender: TObject);
  96. begin
  97. SemaphorGrid1.Clear(CheckBox1.Checked);
  98. end;
  99. procedure TForm1.Button12Click(Sender: TObject);
  100. var TD:TDirection;
  101. begin
  102. if SemaphorGrid1.ColCount>1 then begin
  103. TD:=TDirection(RadioButton1.Checked);
  104. SemaphorGrid1.SortFromColumn(1,tsAutomatic,TD,false);
  105. end;
  106. end;
  107. procedure TForm1.Button13Click(Sender: TObject);
  108. begin
  109. SemaphorGrid1.AutoFit;
  110. end;
  111. procedure TForm1.Button14Click(Sender: TObject);
  112. begin
  113. SemaphorGrid1.AssignToG(SemaphorGrid2,false);
  114. SemaphorGrid3.AssignG(SemaphorGrid2,true);
  115. end;
  116. procedure TForm1.Button15Click(Sender: TObject);
  117. var strtmp:string;
  118. oldCHSEP:char;
  119. begin
  120. oldCHSEP:=SemaphorGrid1.CHSEP;
  121. SemaphorGrid1.CHSEP:=#32;
  122. SemaphorGrid1.SaveToString(strtmp,false);
  123. ShowMessage(strtmp);
  124. SemaphorGrid1.CHSEP:=oldCHSEP;
  125. end;
  126. procedure TForm1.Button2Click(Sender: TObject);
  127. begin
  128. with SemaphorGrid1 do begin
  129. if SemaphorShape<>ssDisk then
  130. SemaphorShape:=succ(SemaphorShape)
  131. else
  132. SemaphorShape:=ssTopBar;
  133. end;
  134. end;
  135. procedure TForm1.Button3Click(Sender: TObject);
  136. begin
  137. if SemaphorGrid1.Alignment=taCenter then
  138. SemaphorGrid1.Alignment:=taLeftJustify
  139. else
  140. SemaphorGrid1.Alignment:=succ(SemaphorGrid1.Alignment);
  141. end;
  142. procedure TForm1.Button4Click(Sender: TObject);
  143. begin
  144. Close;
  145. end;
  146. procedure TForm1.Button5Click(Sender: TObject);
  147. begin
  148. SaveDialog1.Filter:='Semaphor Table (*.stb)|*.stb';
  149. SaveDialog1.DefaultExt:='.stb';
  150. if SaveDialog1.Execute then
  151. SemaphorGrid1.SaveToFileG(SaveDialog1.FileName,true);
  152. end;
  153. procedure TForm1.Button6Click(Sender: TObject);
  154. begin
  155. OpenDialog1.Filter:='Semaphor Table (*.stb)|*.stb';
  156. if OpenDialog1.Execute then begin
  157. SemaphorGrid1.LoadFromFileG(OpenDialog1.FileName,false);
  158. SemaphorGrid1.AutoWidth;
  159. SemaphorGrid1.AutoHeight;
  160. end;
  161. end;
  162. procedure TForm1.Button7Click(Sender: TObject);
  163. begin
  164. SemaphorGrid1.AutoWidth;
  165. end;
  166. procedure TForm1.Button8Click(Sender: TObject);
  167. begin
  168. SemaphorGrid1.AutoHeight;
  169. end;
  170. procedure TForm1.Button9Click(Sender: TObject);
  171. var TD:TDirection;
  172. begin
  173. if SemaphorGrid1.ColCount>4 then begin
  174. TD:=TDirection(RadioButton1.Checked);
  175. SemaphorGrid1.SortFromColumn(4,tsAutomatic,TD,false);
  176. end;
  177. end;
  178. procedure TForm1.CheckBox2Click(Sender: TObject);
  179. begin
  180. SemaphorGrid1.SemaphorOnlyFloat:=CheckBox2.Checked;
  181. end;
  182. procedure TForm1.Form1Create(Sender: TObject);
  183. begin
  184. RadioButton1.Checked:=true;
  185. end;
  186. procedure TForm1.ToggleBox1Click(Sender: TObject);
  187. begin
  188. if ToggleBox1.State=cbUnchecked then begin
  189. ToggleBox1.Caption:='UnEditable';
  190. SemaphorGrid1.Options:=SemaphorGrid1.Options-[goEditing]
  191. end else begin
  192. ToggleBox1.Caption:='Editable';
  193. SemaphorGrid1.Options:=SemaphorGrid1.Options+[goEditing]
  194. end;
  195. end;
  196. end.