/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
- {
- ***************************************************************************
- * *
- * This source is free software; you can redistribute it and/or modify *
- * it under the terms of the GNU General Public License as published by *
- * the Free Software Foundation; either version 2 of the License, or *
- * (at your option) any later version. *
- * *
- * This code is distributed in the hope that it will be useful, but *
- * WITHOUT ANY WARRANTY; without even the implied warranty of *
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
- * General Public License for more details. *
- * *
- * A copy of the GNU General Public License is available on the World *
- * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
- * obtain it by writing to the Free Software Foundation, *
- * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
- * *
- ***************************************************************************
- Author: Salvatore Coppola
- }
- unit Unit1;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, Forms, Dialogs, Grids, SemaphorGrids, StdCtrls;
- type
- { TForm1 }
- TForm1 = class(TForm)
- Button1: TButton;
- Button10: TButton;
- Button11: TButton;
- Button12: TButton;
- Button13: TButton;
- Button14: TButton;
- Button15: TButton;
- Button2: TButton;
- Button3: TButton;
- Button4: TButton;
- Button5: TButton;
- Button6: TButton;
- Button7: TButton;
- Button8: TButton;
- Button9: TButton;
- CheckBox1: TCheckBox;
- CheckBox2: TCheckBox;
- OpenDialog1: TOpenDialog;
- RadioButton1: TRadioButton;
- RadioButton2: TRadioButton;
- SaveDialog1: TSaveDialog;
- SemaphorGrid1: TSemaphorGrid;
- SemaphorGrid2: TSemaphorGrid;
- SemaphorGrid3: TSemaphorGrid;
- ToggleBox1: TToggleBox;
- procedure Button10Click(Sender: TObject);
- procedure Button11Click(Sender: TObject);
- procedure Button12Click(Sender: TObject);
- procedure Button13Click(Sender: TObject);
- procedure Button14Click(Sender: TObject);
- procedure Button15Click(Sender: TObject);
- procedure Button1Click(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure Button3Click(Sender: TObject);
- procedure Button4Click(Sender: TObject);
- procedure Button5Click(Sender: TObject);
- procedure Button6Click(Sender: TObject);
- procedure Button7Click(Sender: TObject);
- procedure Button8Click(Sender: TObject);
- procedure Button9Click(Sender: TObject);
- procedure CheckBox2Click(Sender: TObject);
- procedure Form1Create(Sender: TObject);
- procedure ToggleBox1Click(Sender: TObject);
- private
- { private declarations }
- public
- { public declarations }
- end;
- var
- Form1: TForm1;
- implementation
- {$R *.lfm}
- { TForm1 }
- procedure TForm1.Button1Click(Sender: TObject);
- begin
- SemaphorGrid1.Semaphor:=not SemaphorGrid1.Semaphor;
- end;
- procedure TForm1.Button10Click(Sender: TObject);
- begin
- if SemaphorGrid1.ColCount>1 then
- if SemaphorGrid1.ColWidths[1]=SemaphorGrid1.GridLineWidth then
- SemaphorGrid1.ShowCol(1)
- else
- SemaphorGrid1.HideCol(1);
- end;
- procedure TForm1.Button11Click(Sender: TObject);
- begin
- SemaphorGrid1.Clear(CheckBox1.Checked);
- end;
- procedure TForm1.Button12Click(Sender: TObject);
- var TD:TDirection;
- begin
- if SemaphorGrid1.ColCount>1 then begin
- TD:=TDirection(RadioButton1.Checked);
- SemaphorGrid1.SortFromColumn(1,tsAutomatic,TD,false);
- end;
- end;
- procedure TForm1.Button13Click(Sender: TObject);
- begin
- SemaphorGrid1.AutoFit;
- end;
- procedure TForm1.Button14Click(Sender: TObject);
- begin
- SemaphorGrid1.AssignToG(SemaphorGrid2,false);
- SemaphorGrid3.AssignG(SemaphorGrid2,true);
- end;
- procedure TForm1.Button15Click(Sender: TObject);
- var strtmp:string;
- oldCHSEP:char;
- begin
- oldCHSEP:=SemaphorGrid1.CHSEP;
- SemaphorGrid1.CHSEP:=#32;
- SemaphorGrid1.SaveToString(strtmp,false);
- ShowMessage(strtmp);
- SemaphorGrid1.CHSEP:=oldCHSEP;
- end;
- procedure TForm1.Button2Click(Sender: TObject);
- begin
- with SemaphorGrid1 do begin
- if SemaphorShape<>ssDisk then
- SemaphorShape:=succ(SemaphorShape)
- else
- SemaphorShape:=ssTopBar;
- end;
- end;
- procedure TForm1.Button3Click(Sender: TObject);
- begin
- if SemaphorGrid1.Alignment=taCenter then
- SemaphorGrid1.Alignment:=taLeftJustify
- else
- SemaphorGrid1.Alignment:=succ(SemaphorGrid1.Alignment);
- end;
- procedure TForm1.Button4Click(Sender: TObject);
- begin
- Close;
- end;
- procedure TForm1.Button5Click(Sender: TObject);
- begin
- SaveDialog1.Filter:='Semaphor Table (*.stb)|*.stb';
- SaveDialog1.DefaultExt:='.stb';
- if SaveDialog1.Execute then
- SemaphorGrid1.SaveToFileG(SaveDialog1.FileName,true);
- end;
- procedure TForm1.Button6Click(Sender: TObject);
- begin
- OpenDialog1.Filter:='Semaphor Table (*.stb)|*.stb';
- if OpenDialog1.Execute then begin
- SemaphorGrid1.LoadFromFileG(OpenDialog1.FileName,false);
- SemaphorGrid1.AutoWidth;
- SemaphorGrid1.AutoHeight;
- end;
- end;
- procedure TForm1.Button7Click(Sender: TObject);
- begin
- SemaphorGrid1.AutoWidth;
- end;
- procedure TForm1.Button8Click(Sender: TObject);
- begin
- SemaphorGrid1.AutoHeight;
- end;
- procedure TForm1.Button9Click(Sender: TObject);
- var TD:TDirection;
- begin
- if SemaphorGrid1.ColCount>4 then begin
- TD:=TDirection(RadioButton1.Checked);
- SemaphorGrid1.SortFromColumn(4,tsAutomatic,TD,false);
- end;
- end;
- procedure TForm1.CheckBox2Click(Sender: TObject);
- begin
- SemaphorGrid1.SemaphorOnlyFloat:=CheckBox2.Checked;
- end;
- procedure TForm1.Form1Create(Sender: TObject);
- begin
- RadioButton1.Checked:=true;
- end;
- procedure TForm1.ToggleBox1Click(Sender: TObject);
- begin
- if ToggleBox1.State=cbUnchecked then begin
- ToggleBox1.Caption:='UnEditable';
- SemaphorGrid1.Options:=SemaphorGrid1.Options-[goEditing]
- end else begin
- ToggleBox1.Caption:='Editable';
- SemaphorGrid1.Options:=SemaphorGrid1.Options+[goEditing]
- end;
- end;
- end.