PageRenderTime 21ms CodeModel.GetById 11ms app.highlight 4ms RepoModel.GetById 1ms app.codeStats 0ms

/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 ***************************************************************************
 20Author: Salvatore Coppola
 21}
 22unit Unit1;
 23
 24{$mode objfpc}{$H+}
 25
 26interface
 27
 28uses
 29  Classes, Forms, Dialogs, Grids, SemaphorGrids, StdCtrls;
 30
 31type
 32
 33  { TForm1 }
 34
 35  TForm1 = class(TForm)
 36    Button1: TButton;
 37    Button10: TButton;
 38    Button11: TButton;
 39    Button12: TButton;
 40    Button13: TButton;
 41    Button14: TButton;
 42    Button15: TButton;
 43    Button2: TButton;
 44    Button3: TButton;
 45    Button4: TButton;
 46    Button5: TButton;
 47    Button6: TButton;
 48    Button7: TButton;
 49    Button8: TButton;
 50    Button9: TButton;
 51    CheckBox1: TCheckBox;
 52    CheckBox2: TCheckBox;
 53    OpenDialog1: TOpenDialog;
 54    RadioButton1: TRadioButton;
 55    RadioButton2: TRadioButton;
 56    SaveDialog1: TSaveDialog;
 57    SemaphorGrid1: TSemaphorGrid;
 58    SemaphorGrid2: TSemaphorGrid;
 59    SemaphorGrid3: TSemaphorGrid;
 60    ToggleBox1: TToggleBox;
 61    procedure Button10Click(Sender: TObject);
 62    procedure Button11Click(Sender: TObject);
 63    procedure Button12Click(Sender: TObject);
 64    procedure Button13Click(Sender: TObject);
 65    procedure Button14Click(Sender: TObject);
 66    procedure Button15Click(Sender: TObject);
 67    procedure Button1Click(Sender: TObject);
 68    procedure Button2Click(Sender: TObject);
 69    procedure Button3Click(Sender: TObject);
 70    procedure Button4Click(Sender: TObject);
 71    procedure Button5Click(Sender: TObject);
 72    procedure Button6Click(Sender: TObject);
 73    procedure Button7Click(Sender: TObject);
 74    procedure Button8Click(Sender: TObject);
 75    procedure Button9Click(Sender: TObject);
 76    procedure CheckBox2Click(Sender: TObject);
 77    procedure Form1Create(Sender: TObject);
 78    procedure ToggleBox1Click(Sender: TObject);
 79  private
 80    { private declarations }
 81  public
 82    { public declarations }
 83  end; 
 84
 85var
 86  Form1: TForm1; 
 87
 88implementation
 89
 90{$R *.lfm}
 91
 92{ TForm1 }
 93
 94procedure TForm1.Button1Click(Sender: TObject);
 95begin
 96  SemaphorGrid1.Semaphor:=not SemaphorGrid1.Semaphor;
 97end;
 98
 99procedure TForm1.Button10Click(Sender: TObject);
100begin
101  if SemaphorGrid1.ColCount>1 then
102    if SemaphorGrid1.ColWidths[1]=SemaphorGrid1.GridLineWidth then
103      SemaphorGrid1.ShowCol(1)
104    else
105      SemaphorGrid1.HideCol(1);
106end;
107
108procedure TForm1.Button11Click(Sender: TObject);
109begin
110  SemaphorGrid1.Clear(CheckBox1.Checked);
111end;
112
113procedure TForm1.Button12Click(Sender: TObject);
114var TD:TDirection;
115begin
116  if SemaphorGrid1.ColCount>1 then begin
117    TD:=TDirection(RadioButton1.Checked);
118    SemaphorGrid1.SortFromColumn(1,tsAutomatic,TD,false);
119  end;
120end;
121
122procedure TForm1.Button13Click(Sender: TObject);
123begin
124  SemaphorGrid1.AutoFit;
125end;
126
127procedure TForm1.Button14Click(Sender: TObject);
128begin
129  SemaphorGrid1.AssignToG(SemaphorGrid2,false);
130  SemaphorGrid3.AssignG(SemaphorGrid2,true);
131end;
132
133procedure TForm1.Button15Click(Sender: TObject);
134var strtmp:string;
135    oldCHSEP:char;
136begin
137  oldCHSEP:=SemaphorGrid1.CHSEP;
138  SemaphorGrid1.CHSEP:=#32;
139  SemaphorGrid1.SaveToString(strtmp,false);
140  ShowMessage(strtmp);
141  SemaphorGrid1.CHSEP:=oldCHSEP;
142end;
143
144procedure TForm1.Button2Click(Sender: TObject);
145begin
146  with SemaphorGrid1 do begin
147    if SemaphorShape<>ssDisk then
148      SemaphorShape:=succ(SemaphorShape)
149    else
150      SemaphorShape:=ssTopBar;
151  end;
152end;
153
154procedure TForm1.Button3Click(Sender: TObject);
155begin
156  if SemaphorGrid1.Alignment=taCenter then
157    SemaphorGrid1.Alignment:=taLeftJustify
158  else
159    SemaphorGrid1.Alignment:=succ(SemaphorGrid1.Alignment);
160end;
161
162procedure TForm1.Button4Click(Sender: TObject);
163begin
164  Close;
165end;
166
167procedure TForm1.Button5Click(Sender: TObject);
168begin
169  SaveDialog1.Filter:='Semaphor Table (*.stb)|*.stb';
170  SaveDialog1.DefaultExt:='.stb';
171  if SaveDialog1.Execute then
172    SemaphorGrid1.SaveToFileG(SaveDialog1.FileName,true);
173end;
174
175procedure TForm1.Button6Click(Sender: TObject);
176begin
177  OpenDialog1.Filter:='Semaphor Table (*.stb)|*.stb';
178  if OpenDialog1.Execute then begin
179    SemaphorGrid1.LoadFromFileG(OpenDialog1.FileName,false);
180    SemaphorGrid1.AutoWidth;
181    SemaphorGrid1.AutoHeight;
182  end;
183end;
184
185procedure TForm1.Button7Click(Sender: TObject);
186begin
187  SemaphorGrid1.AutoWidth;
188end;
189
190procedure TForm1.Button8Click(Sender: TObject);
191begin
192  SemaphorGrid1.AutoHeight;
193end;
194
195procedure TForm1.Button9Click(Sender: TObject);
196var TD:TDirection;
197begin
198  if SemaphorGrid1.ColCount>4 then begin
199    TD:=TDirection(RadioButton1.Checked);
200    SemaphorGrid1.SortFromColumn(4,tsAutomatic,TD,false);
201  end;
202end;
203
204procedure TForm1.CheckBox2Click(Sender: TObject);
205begin
206  SemaphorGrid1.SemaphorOnlyFloat:=CheckBox2.Checked;
207end;
208
209procedure TForm1.Form1Create(Sender: TObject);
210begin
211  RadioButton1.Checked:=true;
212end;
213
214procedure TForm1.ToggleBox1Click(Sender: TObject);
215begin
216  if ToggleBox1.State=cbUnchecked then begin
217    ToggleBox1.Caption:='UnEditable';
218    SemaphorGrid1.Options:=SemaphorGrid1.Options-[goEditing]
219  end else begin
220    ToggleBox1.Caption:='Editable';
221    SemaphorGrid1.Options:=SemaphorGrid1.Options+[goEditing]
222  end;
223
224end;
225
226end.
227