diff --git a/components/grid_semaphor/TSemaphorDBGrid.xpm b/components/grid_semaphor/TSemaphorDBGrid.xpm
new file mode 100644
index 000000000..1a8bb1f82
--- /dev/null
+++ b/components/grid_semaphor/TSemaphorDBGrid.xpm
@@ -0,0 +1,33 @@
+/* XPM */
+static char * TSemaphorDBGrid_xpm[] = {
+"21 21 9 1",
+" c None",
+". c #040404",
+"+ c #048404",
+"@ c #7A7A7A",
+"# c #BABABA",
+"$ c #FA0404",
+"% c #FA04FA",
+"& c #FAFA04",
+"* c #FAFAFA",
+"@@@@@@@@@@@@@@@ ",
+"@#@*####*#####@ ",
+"@@@@@@@@@@@@@@@ ",
+"@#@****#******@ $$ ",
+"@*@*$$*#*++++*@ $$$$ ",
+"@#@****#******@ $$$$ ",
+"@*@*&&*#*###**@ $$ ",
+"@#@****#******@ ",
+"@*@..............&&..",
+"@#@.#.*#####*###&&&&.",
+"@@@.............&&&&.",
+" .#.*****#*****&&*.",
+" .*.##############.",
+" .#.*****#*****++*.",
+" .*.##########++++.",
+" .#.*****#****++++.",
+" .*.###########++#.",
+" .#.*****#********.",
+" .*.##############.",
+" .#.*****#********.",
+" .................."};
diff --git a/components/grid_semaphor/example/project1.lpi b/components/grid_semaphor/example/project1.lpi
new file mode 100644
index 000000000..489730367
--- /dev/null
+++ b/components/grid_semaphor/example/project1.lpi
@@ -0,0 +1,62 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/grid_semaphor/example/project1.lpr b/components/grid_semaphor/example/project1.lpr
new file mode 100644
index 000000000..5168c1c66
--- /dev/null
+++ b/components/grid_semaphor/example/project1.lpr
@@ -0,0 +1,37 @@
+{
+ ***************************************************************************
+ * *
+ * 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 . 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
+}
+
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+ Interfaces, // this includes the LCL widgetset
+ Forms
+ { add your units here }, Unit1;
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/components/grid_semaphor/example/table01.stb b/components/grid_semaphor/example/table01.stb
new file mode 100644
index 000000000..9cec3a772
--- /dev/null
+++ b/components/grid_semaphor/example/table01.stb
@@ -0,0 +1,6 @@
+S_M_0_1ÿ1ÿ1
+ÿÿÿÿ
+ÿnoÿyesÿÿ
+ÿSemaphorÿGridÿnoÿ
+ÿifÿ0.9877ÿÿ
+ÿmaybeÿÿÿ
diff --git a/components/grid_semaphor/example/table02.stb b/components/grid_semaphor/example/table02.stb
new file mode 100644
index 000000000..7638babf8
--- /dev/null
+++ b/components/grid_semaphor/example/table02.stb
@@ -0,0 +1,6 @@
+S_M_0_1ÿ1ÿ1
+a\nÿ1ÿ2ÿ3ÿ4
+aÿnoÿyesÿÿ
+bÿLazarusÿProjectÿnoÿ
+cÿifÿ0.9877ÿÿ
+dÿmaybeÿÿÿ
diff --git a/components/grid_semaphor/example/table03hidden.stb b/components/grid_semaphor/example/table03hidden.stb
new file mode 100644
index 000000000..60161f90d
--- /dev/null
+++ b/components/grid_semaphor/example/table03hidden.stb
@@ -0,0 +1,6 @@
+S_M_0_1ÿ1ÿ1ÿj1ÿ64
+a\nÿ1ÿ2ÿ3ÿ4
+aÿnoÿyesÿÿ5
+bÿLazarusÿProjectÿnoÿ12
+cÿifÿ0.9877ÿÿ-1
+dÿmaybeÿÿÿ2
diff --git a/components/grid_semaphor/example/table04hidden.stb b/components/grid_semaphor/example/table04hidden.stb
new file mode 100644
index 000000000..12f3ae1e3
--- /dev/null
+++ b/components/grid_semaphor/example/table04hidden.stb
@@ -0,0 +1,6 @@
+S_M_0_1ÿ1ÿ1ÿj2ÿ64
+a\nÿ1ÿ2ÿ3ÿ4
+aÿnoÿyesÿÿ5
+bÿalphaÿLazarusÿnoÿ12
+cÿzedÿ0.9877ÿProjectÿ-1
+dÿmaybeÿyesÿmaybeÿ2
diff --git a/components/grid_semaphor/example/unit1.lfm b/components/grid_semaphor/example/unit1.lfm
new file mode 100644
index 000000000..10ebb1acb
--- /dev/null
+++ b/components/grid_semaphor/example/unit1.lfm
@@ -0,0 +1,342 @@
+object Form1: TForm1
+ Left = 183
+ Height = 423
+ Top = 115
+ Width = 590
+ HorzScrollBar.Page = 589
+ VertScrollBar.Page = 422
+ ActiveControl = SemaphorGrid1
+ Caption = 'Try SemaphorGrid'
+ ClientHeight = 423
+ ClientWidth = 590
+ OnCreate = Form1Create
+ LCLVersion = '1.9.0.0'
+ object Button1: TButton
+ Left = 8
+ Height = 25
+ Top = 232
+ Width = 144
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Toggle Semaphor'
+ OnClick = Button1Click
+ TabOrder = 1
+ end
+ object Button2: TButton
+ Left = 155
+ Height = 25
+ Top = 232
+ Width = 163
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Next Semafore Style'
+ OnClick = Button2Click
+ TabOrder = 2
+ end
+ object Button3: TButton
+ Left = 8
+ Height = 25
+ Top = 264
+ Width = 124
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Next Alignment'
+ OnClick = Button3Click
+ TabOrder = 3
+ end
+ object Button4: TButton
+ Left = 464
+ Height = 25
+ Top = 70
+ Width = 111
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Close'
+ OnClick = Button4Click
+ TabOrder = 4
+ end
+ object Button5: TButton
+ Left = 464
+ Height = 25
+ Top = 16
+ Width = 111
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Save to File'
+ OnClick = Button5Click
+ TabOrder = 5
+ end
+ object Button6: TButton
+ Left = 464
+ Height = 25
+ Top = 43
+ Width = 111
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Load from File'
+ OnClick = Button6Click
+ TabOrder = 6
+ end
+ object Button7: TButton
+ Left = 327
+ Height = 24
+ Top = 232
+ Width = 87
+ BorderSpacing.InnerBorder = 4
+ Caption = 'AutoWidth'
+ OnClick = Button7Click
+ TabOrder = 7
+ end
+ object Button8: TButton
+ Left = 417
+ Height = 24
+ Top = 232
+ Width = 90
+ BorderSpacing.InnerBorder = 4
+ Caption = 'AutoHeight'
+ OnClick = Button8Click
+ TabOrder = 8
+ end
+ object Button9: TButton
+ Left = 176
+ Height = 26
+ Top = 165
+ Width = 100
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Sort Cols[4]'
+ OnClick = Button9Click
+ TabOrder = 9
+ end
+ object RadioButton1: TRadioButton
+ Left = 286
+ Height = 21
+ Top = 165
+ Width = 86
+ Caption = 'Ascending'
+ Checked = True
+ TabOrder = 10
+ TabStop = True
+ end
+ object RadioButton2: TRadioButton
+ Left = 286
+ Height = 21
+ Top = 196
+ Width = 94
+ Caption = 'Descending'
+ TabOrder = 11
+ end
+ object Button10: TButton
+ Left = 8
+ Height = 26
+ Top = 165
+ Width = 144
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Hide/Show Cols[1]'
+ OnClick = Button10Click
+ TabOrder = 12
+ end
+ object Button11: TButton
+ Left = 8
+ Height = 25
+ Top = 196
+ Width = 47
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Clear'
+ OnClick = Button11Click
+ TabOrder = 13
+ end
+ object CheckBox1: TCheckBox
+ Left = 60
+ Height = 21
+ Top = 196
+ Width = 85
+ Caption = 'OnlyValue'
+ TabOrder = 14
+ end
+ object Button12: TButton
+ Left = 176
+ Height = 23
+ Top = 196
+ Width = 100
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Sort Cols[1]'
+ OnClick = Button12Click
+ TabOrder = 15
+ end
+ object ToggleBox1: TToggleBox
+ Left = 429
+ Height = 26
+ Top = 165
+ Width = 102
+ Caption = 'UnEditable'
+ OnClick = ToggleBox1Click
+ TabOrder = 16
+ end
+ object CheckBox2: TCheckBox
+ Left = 428
+ Height = 21
+ Top = 196
+ Width = 85
+ Caption = 'Only Float'
+ OnClick = CheckBox2Click
+ TabOrder = 17
+ end
+ object Button13: TButton
+ Left = 510
+ Height = 24
+ Top = 232
+ Width = 71
+ BorderSpacing.InnerBorder = 4
+ Caption = 'AutoFit'
+ OnClick = Button13Click
+ TabOrder = 18
+ end
+ object SemaphorGrid1: TSemaphorGrid
+ Left = 8
+ Height = 152
+ Top = 4
+ Width = 350
+ Color = clWhite
+ Constraints.MaxHeight = 160
+ Constraints.MaxWidth = 350
+ DefaultRowHeight = 24
+ TabOrder = 0
+ Alignment = taCenter
+ Semaphor = True
+ StringRed = 'no'
+ StringYellow = 'maybe'
+ StringGreen = 'yes'
+ SemaphorShape = ssDisk
+ SemaphorCaseSensitive = False
+ SemaphorOnlyFloat = False
+ Cells = (
+ 24
+ 0
+ 0
+ 'a\n'
+ 0
+ 1
+ 'a'
+ 0
+ 2
+ 'b'
+ 0
+ 3
+ 'c'
+ 0
+ 4
+ 'd'
+ 1
+ 0
+ '1'
+ 1
+ 1
+ 'no'
+ 1
+ 2
+ 'alpha'
+ 1
+ 3
+ 'zed'
+ 1
+ 4
+ 'maybe'
+ 2
+ 0
+ '2'
+ 2
+ 1
+ 'yes'
+ 2
+ 2
+ 'Semaphor'
+ 2
+ 3
+ '0.9877'
+ 2
+ 4
+ 'yes'
+ 3
+ 0
+ '3'
+ 3
+ 2
+ 'no'
+ 3
+ 3
+ 'Grid'
+ 3
+ 4
+ 'maybe'
+ 4
+ 0
+ '4'
+ 4
+ 1
+ '5'
+ 4
+ 2
+ '12'
+ 4
+ 3
+ '-1'
+ 4
+ 4
+ '2'
+ )
+ end
+ object SemaphorGrid2: TSemaphorGrid
+ Left = 0
+ Height = 111
+ Top = 305
+ Width = 288
+ TabOrder = 21
+ Alignment = taLeftJustify
+ Semaphor = False
+ StringRed = 'no'
+ StringYellow = 'maybe'
+ StringGreen = 'yes'
+ SemaphorShape = ssDisk
+ SemaphorCaseSensitive = False
+ SemaphorOnlyFloat = False
+ end
+ object SemaphorGrid3: TSemaphorGrid
+ Left = 296
+ Height = 112
+ Top = 304
+ Width = 279
+ TabOrder = 22
+ Alignment = taLeftJustify
+ Semaphor = True
+ StringRed = 'no'
+ StringYellow = 'maybe'
+ StringGreen = 'yes'
+ SemaphorShape = ssDisk
+ SemaphorCaseSensitive = False
+ SemaphorOnlyFloat = False
+ end
+ object Button14: TButton
+ Left = 327
+ Height = 25
+ Top = 264
+ Width = 87
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Assign'
+ OnClick = Button14Click
+ TabOrder = 19
+ end
+ object Button15: TButton
+ Left = 417
+ Height = 25
+ Top = 264
+ Width = 114
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Show Content'
+ OnClick = Button15Click
+ TabOrder = 20
+ end
+ object SaveDialog1: TSaveDialog
+ FilterIndex = 0
+ left = 40
+ top = 376
+ end
+ object OpenDialog1: TOpenDialog
+ FilterIndex = 0
+ left = 8
+ top = 376
+ end
+end
diff --git a/components/grid_semaphor/example/unit1.pas b/components/grid_semaphor/example/unit1.pas
new file mode 100644
index 000000000..6c4f1995c
--- /dev/null
+++ b/components/grid_semaphor/example/unit1.pas
@@ -0,0 +1,227 @@
+{
+ ***************************************************************************
+ * *
+ * 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 . You can also *
+ * obtain it by writing to the Free Software Foundation, *
+ * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, 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
+
+ public
+
+ 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.
+
diff --git a/components/grid_semaphor/readme.txt b/components/grid_semaphor/readme.txt
new file mode 100644
index 000000000..84d7ec0e5
--- /dev/null
+++ b/components/grid_semaphor/readme.txt
@@ -0,0 +1,35 @@
+Hi for all,
+
+I think TSemaphorGrid is quite original and it seems to work fine on both
+Windows and Linux OS except "HideCol" under Linux that sometimes show a bit
+of text contained in the hidden cells.
+
+All the Info you need for TSemaphorGrid are in the source code.
+I've commented the main methods in the abstract and other important steps in the code.
+I've registered it in the 'Additional' page of Lazarus IDE components because I use it
+instead of TStringGrid and if you want you can change this.
+
+TSemaphorGrid come in a Lazarus Package "SemaphorGridLPK.lpk", just install it in the
+Lazarus IDE by Components-->Open package file(.lpk)
+Compile and install it
+In the ".\example" direcory there is a Lazarus project (.lpi) that use TSemaphorGrid
+with the main properties and methods.
+
+ABSTRACT:
+SEMAFORO (Semaphor) in Italian Language means Traffic Lights. If Semaphor is
+set to true,when TSemaphorGrid detect in a non Fixed Cells a string like
+StringGreen or StringYellow or StringRed, it show a colored sign in the
+corrispondent cells (shape choosed in SemaphorShape). It can be Case Sensitive
+(SemaphorCaseSensitive). If Semaphor is false, nothing happen.
+
+SemaphorGrid is able to store and restore data by indipendent method
+LoadFromFileG and SaveToFileG wich manage also accented chars in data and
+similar. Data are separeted by CHSEP. LoadFromFileG has autoadjust wich allow
+SemaphorGrid to AutosizeColumns. SemaphorGrid, at the moment, is unable to store
+setting grid (only Column Hidden and in general ColWidth). With the method
+ExportToExcel, SemaphorGrid is able set CHSEP so that the file generated is
+MS Excel compatible.
+
+Thanks for the Lazarus Project
+
+Salvatore
diff --git a/components/grid_semaphor/semaphordbgridicon.res b/components/grid_semaphor/semaphordbgridicon.res
new file mode 100644
index 000000000..247765d9a
Binary files /dev/null and b/components/grid_semaphor/semaphordbgridicon.res differ
diff --git a/components/grid_semaphor/semaphordbgrids.pas b/components/grid_semaphor/semaphordbgrids.pas
new file mode 100644
index 000000000..925eb3bf2
--- /dev/null
+++ b/components/grid_semaphor/semaphordbgrids.pas
@@ -0,0 +1,168 @@
+{*****************************************************************************
+ SemaphorDBGrid.pas
+ -------------------
+ Lazarus LCL Component
+ First Release: January 2005
+
+ Author: Salvatore Coppola - Calabria (Italy)
+ *****************************************************************************
+ See the file COPYING.modifiedLGPL.txt, included in this distribution,
+ for details about the license.
+ *****************************************************************************
+ }
+
+{ABSTRACT
+SEMAFORO (Semaphor) in Italian Language means Traffic Lights. If Semaphor is
+set to true,when TSemaphorDBGrid detect in a non Fixed Cells a string like
+StringGreen or StringYellow or StringRed, it show a colored sign in the
+corrispondent cells (shape choosed in SemaphorShape). It can be Case Sensitive
+(SemaphorCaseSensitive). If Semaphor is false, nothing happen.
+
+That's all
+Enjoy! Salvatore
+}
+
+unit SemaphorDBGrids;
+
+{$mode objfpc} {$H+}
+
+interface
+
+uses
+ Classes, SysUtils, LResources, LCLProc, LCLIntf, LCLType, Forms, Controls,
+ Graphics, Dialogs, Grids, DBGrids;
+
+type
+ TSemaphorShape=(ssTopBar, ssBottomBar, ssLeftBar, ssRigthBar, ssTopLeftSquare,
+ ssTopRigthSquare, ssBottomLeftSquare, ssBottomRigth, ssDisk);
+
+type
+ TSemaphorDBGrid = class(TdbGrid)
+ private
+ FSemaphor : boolean;
+ FStringRed : string;
+ FStringYellow : string;
+ FStringGreen : string;
+ FSemaphorShape : TSemaphorShape;
+ FSemaphorCaseSensitive : boolean;
+ procedure SetSemaphorShape(Value : TSemaphorShape);
+ protected
+ procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property Semaphor : boolean read FSemaphor write FSemaphor;
+ property StringRed : string read FStringRed write FStringRed;
+ property StringYellow : string read FStringYellow write FStringYellow;
+ property StringGreen : string read FStringGreen write FStringGreen;
+ property SemaphorShape : TSemaphorShape read FSemaphorShape write SetSemaphorShape;
+ property SemaphorCaseSensitive : boolean read FSemaphorCaseSensitive write FSemaphorCaseSensitive;
+ end;
+
+procedure Register;
+
+implementation
+
+{$R semaphordbgridicon.res}
+
+procedure TSemaphorDBGrid.SetSemaphorShape(Value : TSemaphorShape);
+begin
+ FSemaphorShape:=Value;
+ invalidate
+end;
+
+procedure TSemaphorDBGrid.DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState);
+const dr=4;
+var Rect:TRect;
+begin
+ inherited DrawCell(aCol,aRow,aRect,aState);
+ if not Semaphor then
+ exit;
+ Rect:=CellRect(aCol,aRow);
+ case SemaphorShape of
+ ssTopBar: Rect.Bottom:=Rect.Top+dr-1;
+ ssBottomBar:Rect.Top:=Rect.Bottom-dr;
+ ssLeftBar:Rect.Right:=rect.Left+dr-1;
+ ssRigthBar:Rect.Left:=rect.Right-dr;
+ ssTopLeftSquare:begin
+ Rect.Bottom:=Rect.Top+dr;
+ Rect.Right:=Rect.Left+dr;
+ end;
+ ssTopRigthSquare:begin
+ Rect.Bottom:=Rect.Top+dr;
+ Rect.Left:=Rect.Right-dr-1;
+ end;
+ ssBottomLeftSquare:begin
+ Rect.Top:=Rect.Bottom-dr-1;
+ Rect.Right:=Rect.Left+dr;
+ end;
+ ssBottomRigth:begin
+ Rect.Top:=Rect.Bottom-dr-1;
+ Rect.Left:=Rect.Right-dr-1;
+ end;
+ ssDisk:begin
+ Rect.Bottom:=Rect.Top+2*dr-1;
+ Rect.Left:=Rect.Right-2*dr+1-1;
+ end;
+ end;
+ case SemaphorCaseSensitive of
+ false: if (UpperCase(GetEditText(aCol,aRow))=UpperCase(StringGreen))and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clGreen;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end else if(UpperCase(GetEditText(aCol,aRow))=UpperCase(StringRed))and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clRed;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end else if(UpperCase( GetEditText(aCol,aRow))=UpperCase(StringYellow))and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clYellow;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end;
+ true: if (GetEditText(aCol,aRow)=StringGreen)and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clGreen;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end else if(GetEditText(aCol,aRow)=StringRed)and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clRed;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end else if(GetEditText(aCol,aRow)=StringYellow)and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clYellow;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end;
+ end;
+end;
+
+constructor TSemaphorDBGrid.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ Semaphor:=False;
+ StringRed:='no';
+ StringYellow:='maybe';
+ StringGreen:='yes';
+ SemaphorShape:=ssDisk;
+ SemaphorCaseSensitive:=False;
+end;
+
+procedure Register;
+begin
+ RegisterComponents('Data Controls',[TSemaphorDBGrid]);
+end;
+
+end.
+
+
diff --git a/components/grid_semaphor/semaphorgridlpk.lpk b/components/grid_semaphor/semaphorgridlpk.lpk
new file mode 100644
index 000000000..8dd10dea5
--- /dev/null
+++ b/components/grid_semaphor/semaphorgridlpk.lpk
@@ -0,0 +1,56 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/grid_semaphor/semaphorgridlpk.pas b/components/grid_semaphor/semaphorgridlpk.pas
new file mode 100644
index 000000000..dcef5bf49
--- /dev/null
+++ b/components/grid_semaphor/semaphorgridlpk.pas
@@ -0,0 +1,23 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit SemaphorGridLPK;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+ SemaphorGrids, SemaphorDBGrids, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('SemaphorGrids', @SemaphorGrids.Register);
+ RegisterUnit('SemaphorDBGrids', @SemaphorDBGrids.Register);
+end;
+
+initialization
+ RegisterPackage('SemaphorGridLPK', @Register);
+end.
diff --git a/components/grid_semaphor/semaphorgrids.pas b/components/grid_semaphor/semaphorgrids.pas
new file mode 100644
index 000000000..e1f894ec3
--- /dev/null
+++ b/components/grid_semaphor/semaphorgrids.pas
@@ -0,0 +1,774 @@
+{
+ SemaphorGrid.pas
+ -------------------
+ Lazarus LCL Component
+ First Release: January 2005
+
+ Author: Salvatore Coppola - Calabria (Italy)
+ *****************************************************************************
+ See the file COPYING.modifiedLGPL.txt, included in this distribution,
+ for details about the license.
+ *****************************************************************************
+ }
+
+{ABSTRACT
+SEMAFORO (Semaphor) in Italian Language means Traffic Lights. If Semaphor is
+set to true,when TSemaphorGrid detect in a non Fixed Cells a string like
+StringGreen or StringYellow or StringRed, it show a colored sign in the
+corrispondent cells (shape choosed in SemaphorShape). It can be Case Sensitive
+(SemaphorCaseSensitive). If Semaphor is false, nothing happen.
+
+SemaphorGrid is able to store and restore data by indipendent method
+LoadFromFileG and SaveToFileG wich manage also accented chars in data and
+similar. Data are separeted by CHSEP. LoadFromFileG has autoadjust wich allow
+SemaphorGrid to AutosizeColumns. SemaphorGrid, at the moment, is unable to store
+setting grid (only Column Hidden and in general ColWidth). With the method
+ExportToExcel, SemaphorGrid is able set CHSEP so that the file generated is
+MS Excel compatible. SemaphorGrid is also able to sort a column wrapping all
+the Grid with the method SortFromColumn with indipendent sorting method (maybe
+it should be better to use onCompareCell)
+That's all
+Enjoy! Salvatore
+
+Date: 15-Jan-2005
+- Changed SortFromColumn: now it use SortColRow, OnCompareCells and
+ DoCompareChange (from Jesus Rejes A.);
+- Removed SortDate, SortNumeric, uses Windows (now useless)
+- Correct some repainting problems (from Jesus Rejes A.)
+- removed ReDrawGrid (now useless)
+
+Date: 03-Apr-2005
+- Some sources cleaning
+- introduced System Metrics in AutoWidth and AutoHeight (keep in count
+ scrollbars);
+
+Date: 04-May-2005
+- set default CHARSEP to #255
+
+knowed bug:
+ re-sorting a column that have two or more cells equal, the
+ corrispondent rows are swapped, so there are more than one grid sorted by
+ the same column.
+}
+
+unit SemaphorGrids;
+{$mode objfpc}
+{$H+}
+interface
+
+uses
+ Classes, SysUtils, LazUTF8, LResources, LCLProc, LCLIntf, LCLType, Forms,
+ Controls, Graphics, Dialogs, Grids;
+
+const
+ SemaphorMarker='S_M_0_1';
+
+type
+ TSheetType=(stLandScape,stPortrait);
+ TSemaphorShape=(ssTopBar,ssBottomBar,ssLeftBar,ssRigthBar,
+ ssTopLeftSquare,ssTopRigthSquare,ssBottomLeftSquare,
+ ssBottomRigth,ssDisk);
+ TDirection = (sdDescending, sdAscending);
+ TTypeSort = (tsAlphabetic, tsDate, tsNumeric, tsAutomatic);
+
+type
+
+ { TSemaphorGrid }
+
+ TSemaphorGrid = class(TStringGrid)
+ private
+ WidthZero:integer;
+ ExWidths: TStringList;
+ FAlignment: TAlignment;
+ FCHSEP : Char;
+ FSemaphor : boolean;
+ FStringRed : string;
+ FStringYellow : string;
+ FStringGreen : string;
+ FSemaphorShape : TSemaphorShape;
+ FSemaphorCaseSensitive : boolean;
+ FSemaphorOnlyFloat : boolean;
+ FSortDirection: TDirection;
+ FSortType: TTypeSort;
+ procedure SetAlignment(Value: TAlignment);
+ procedure SetCHSEP(Value : Char);
+ procedure SetSemaphor(Value : boolean);
+ procedure SetStringRed(Value : string);
+ procedure SetStringYellow(Value : string);
+ procedure SetStringGreen(Value : string);
+ procedure SetSemaphorShape(Value : TSemaphorShape);
+ procedure SetSemaphorCaseSensitive(Value : boolean);
+ procedure SetSemaphorOnlyFloat(Value : boolean);
+ protected
+ procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
+ function DoCompareCells(Acol,ARow,Bcol,BRow: Integer): Integer; override;
+ procedure KeyPress(var Key: Char); override;
+ procedure LoadBase(tabella:TStringList; autoadjust:boolean);
+ procedure SaveBase(tabella:TStringList; addMarker:boolean);
+ procedure LoadFromString(StringName:string; autoadjust:boolean);
+ public
+ procedure LoadFromFileG(FileName:string; autoadjust:boolean);
+ procedure SaveToFileG(FileName:String;addMarker:boolean);
+ procedure SaveToString(var StringName:String; addMarker:boolean);
+ procedure AssignG(SG: TSemaphorGrid; autoadjust:boolean);
+ procedure AssignToG(SG: TSemaphorGrid; autoadjust:boolean);
+ procedure AutoWidth;
+ procedure AutoHeight;
+ procedure AutoFit;
+ procedure ExportToExcel(FileName:string;SelfExt:boolean);
+ procedure DeleteColumn(j:integer);
+ procedure DeleteRow(i:integer);
+ procedure SortFromColumn(j:integer; TS:TTypeSort; SD:TDirection; autoadjust:boolean);
+ procedure HideCol(j:integer);
+ procedure ShowCol(j:integer);
+ procedure ShowAllCols;
+ function Duplicate(var SG:TSemaphorGrid):boolean;
+ procedure ClearColRow(isColumn:boolean; i:integer);
+ procedure Clear(OnlyValue:boolean);
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Constraints;
+ property Alignment: TAlignment read FAlignment write SetAlignment;
+ property CHSEP : Char read FCHSEP write SetCHSEP default #255;
+ property Semaphor : boolean read FSemaphor write SetSemaphor;
+ property StringRed : string read FStringRed write SetStringRed;
+ property StringYellow : string read FStringYellow write SetStringYellow;
+ property StringGreen : string read FStringGreen write SetStringGreen;
+ property SemaphorShape : TSemaphorShape read FSemaphorShape write SetSemaphorShape;
+ property SemaphorCaseSensitive : boolean read FSemaphorCaseSensitive write SetSemaphorCaseSensitive;
+ property SemaphorOnlyFloat : boolean read FSemaphorOnlyFloat write SetSemaphorOnlyFloat;
+ end;
+
+procedure Register;
+
+implementation
+
+{$R semaphorgridsicon.res}
+
+procedure TSemaphorGrid.DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState);
+const dr=4;
+var Rect:TRect;
+ MyStyle:TTextStyle;
+begin
+ PrepareCanvas(aCol,aRow,aState);
+ Canvas.FillRect(aRect);
+ DrawCellGrid(aCol,aRow,aRect,astate);
+
+ MyStyle:=Canvas.TextStyle;
+ MyStyle.Alignment:=Alignment;
+ //text space
+ aRect.Left:=aRect.Left+dr;
+ aRect.Right:=aRect.Right-dr;
+ aRect.Bottom:=aRect.Bottom-dr;
+ aRect.Top:=aRect.Top+dr;
+ Canvas.TextRect(aRect,aRect.Left, aRect.Top, Cells[aCol,aRow],MyStyle);
+ if not Semaphor then
+ exit;
+ Rect:=CellRect(aCol,aRow);
+ case SemaphorShape of
+ ssTopBar: Rect.Bottom:=Rect.Top+dr-1;
+ ssBottomBar:Rect.Top:=Rect.Bottom-dr;
+ ssLeftBar:Rect.Right:=rect.Left+dr-1;
+ ssRigthBar:Rect.Left:=rect.Right-dr;
+ ssTopLeftSquare:begin
+ Rect.Bottom:=Rect.Top+dr;
+ Rect.Right:=Rect.Left+dr;
+ end;
+ ssTopRigthSquare:begin
+ Rect.Bottom:=Rect.Top+dr;
+ Rect.Left:=Rect.Right-dr-1;
+ end;
+ ssBottomLeftSquare:begin
+ Rect.Top:=Rect.Bottom-dr-1;
+ Rect.Right:=Rect.Left+dr;
+ end;
+ ssBottomRigth:begin
+ Rect.Top:=Rect.Bottom-dr-1;
+ Rect.Left:=Rect.Right-dr-1;
+ end;
+ ssDisk:begin
+ Rect.Bottom:=Rect.Top+2*dr-1;
+ Rect.Left:=Rect.Right-2*dr+1-1;
+ end;
+ end;
+ case SemaphorCaseSensitive of
+ false: if (UpperCase(Cells[aCol,aRow])=UpperCase(StringGreen))and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clGreen;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end else if(UpperCase(Cells[aCol,aRow])=UpperCase(StringRed))and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clRed;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end else if(UpperCase(Cells[aCol,aRow])=UpperCase(StringYellow))and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clYellow;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end;
+ true: if (Cells[aCol,aRow]=StringGreen)and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clGreen;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end else if(Cells[aCol,aRow]=StringRed)and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clRed;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end else if(Cells[aCol,aRow]=StringYellow)and((aCol>FixedCols-1)and(aRow>FixedRows-1)) then begin
+ Canvas.Brush.Color:=clYellow;
+ if not(SemaphorShape=ssDisk) then
+ Canvas.Rectangle(Rect)
+ else
+ Canvas.Ellipse(Rect);
+ end;
+ end;
+end;
+
+procedure TSemaphorGrid.KeyPress(var Key: Char);
+var strOld:string;
+ valore:double;
+begin
+ inherited KeyPress(Key);
+ if (SemaphorOnlyFloat)and(goEditing in Options) then begin
+ if (Key=',')or(Key='.') then
+ Key:=DecimalSeparator;
+ if (Key=' ')or(UpCase(Key)='E') then
+ key:=#0;
+ if Key='-' then begin
+ strOld:=Cells[Col,Row];
+ if Pos(Key,strOld)=1 then
+ delete(strOld,1,1)
+ else
+ strOld:=Key+strOld;
+ Cells[Col,Row]:=strOld;
+ Key:=#0;
+ exit
+ end;
+
+ if not(Ord(Key)=VK_BACK) then begin
+ if Cells[Col,Row]<>'' then begin
+ strOld:=Cells[Col,Row];
+ try
+ valore:=StrToFloat(strOld+Key)
+ except
+ Key:=#0;
+ exit
+ end
+ end else begin
+ strOld:='';
+ try
+ valore:=StrToFloat(Cells[Col,Row]+Key)
+ except
+ Cells[Col,Row]:=strOld;
+ Key:=#0
+ end;
+ end
+ end;
+ end;
+end;
+
+procedure TSemaphorGrid.LoadBase(tabella:TStringList; autoadjust:boolean);
+var riga:TStringList;
+ strtmp,strFirst:string;
+ i,j:integer;
+ strj:string;
+begin
+ riga:=TStringList.Create;
+ strFirst:=tabella.Strings[0];
+ RowCount:=FixedRows+2;//to prevent grid exception
+ ColCount:=FixedCols+2;
+ if pos(SemaphorMarker,strFirst)<>0 then begin
+ Delete(strFirst,1,pos(CHSEP,strFirst));//delete marker+CHSEP
+ j:=pos(CHSEP,strFirst)-1;
+ FixedCols:=StrToInt(copy(strFirst,1,j)); //retrive FixedCols
+ Delete(strFirst,1,j+1);//pos(CHSEP,strtmp));//delete FixedCols+CHSEP
+ i:=pos(CHSEP,strFirst)-1;
+ if i=-1 then //i.e. pos(CHSEP,strtmp)=0
+ i:=length(strFirst);
+ FixedRows:=StrToInt(copy(strFirst,1,i));//retrive FixedCols
+ Delete(strFirst,1,i);
+
+ strtmp:='';
+ RowCount:=FixedRows+1;
+ ColCount:=FixedCols+1;
+ for i:=1 to tabella.Count-1 do begin //riga[0] gia usata per fixed rows and cols
+ strtmp:=tabella.Strings[i];
+ riga.Clear;
+ j:=0;
+ while (strtmp<>'')or(pos(CHSEP,strtmp)<>0)do
+ if pos(CHSEP,strtmp)<>0 then begin
+ j:=j+1;
+ riga.Add(copy(strtmp,1,pos(CHSEP,strtmp)-1));
+ Delete(strtmp,1,pos(CHSEP,strtmp))
+ end else begin
+ riga.Add(strtmp);
+ strtmp:=''
+ end;
+ if RowCount'')or(pos(CHSEP,strtmp)<>0)do
+ if pos(CHSEP,strtmp)<>0 then begin
+ j:=j+1;
+ riga.Add(copy(strtmp,1,pos(CHSEP,strtmp)-1));
+ Delete(strtmp,1,pos(CHSEP,strtmp))
+ end else begin
+ riga.Add(strtmp);
+ strtmp:=''
+ end;
+ if RowCount'' then begin
+ ExWidths.Clear;
+ while pos(CHSEP+'j',strFirst)<>0 do begin
+ Delete(strFirst,1,2);//delete CHSEP+'j';
+ strj:=copy(strFirst,1,pos(CHSEP,strFirst)-1);
+ ColWidths[StrToInt(strj)]:=WidthZero;//GridLineWidth;
+ ExWidths.Add('j'+strj);
+ Delete(strFirst,1,length(strj+CHSEP));
+ if pos(CHSEP,strFirst)<>0 then begin
+ strj:=copy(strFirst,1,pos(CHSEP,strFirst)-1);
+ Delete(strFirst,1,pos(CHSEP,strFirst)-1);
+ end else
+ strj:=strFirst;
+ ExWidths.Add(strj);
+ end;
+ strFirst:='';
+ end;
+end;
+
+procedure TSemaphorGrid.SaveBase(tabella:TStringList; addMarker:boolean);
+var riga:TStringList;
+ strtmp:string;
+ i,j:integer;
+begin
+ riga:=TStringList.Create;
+ if addMarker then begin
+ strtmp:=SemaphorMarker+CHSEP+IntToStr(FixedCols)+CHSEP+IntToStr(FixedRows);//store n° fixed cols and rows
+ for j:=0 to ExWidths.Count-1 do //store the widths of hided cols if any (and then the hided cols)
+ strtmp:=strtmp+CHSEP+ExWidths.Strings[j];
+ tabella.Add(strtmp);
+ end;
+ for i:=0 to RowCount-1 do begin
+ riga.Assign(Rows[i]);
+ strtmp:=riga.Strings[0];
+ for j:=1 to riga.Count-1 do
+ strtmp:=strtmp+CHSEP+riga.Strings[j];
+ tabella.Add(strtmp);
+ end;
+ riga.Free;
+end;
+
+procedure TSemaphorGrid.LoadFromFileG(FileName:string;autoadjust:boolean);
+var tabella:TStringList;
+begin
+ tabella:=TStringList.Create;
+ tabella.LoadFromFile(UTF8ToSys(Filename));
+ LoadBase(tabella,autoadjust);
+ tabella.Free;
+end;
+
+{ FileName: file to store data }
+procedure TSemaphorGrid.SaveToFileG(FileName:String;addMarker:boolean);
+var tabella:TStringList;
+begin
+ tabella:=TStringList.Create;
+ SaveBase(tabella,addMarker);
+ tabella.SaveToFile(UTF8ToSys(FileName));
+ tabella.Free;
+end;
+
+procedure TSemaphorGrid.LoadFromString(StringName:string; autoadjust:boolean);
+var tabella:TStringList;
+begin
+ tabella:=TStringList.Create;
+ tabella.Text:=StringName;
+ LoadBase(tabella,autoadjust);
+ tabella.Free;
+end;
+
+procedure TSemaphorGrid.SaveToString(var StringName:String; addMarker:boolean);
+var tabella:TStringList;
+begin
+ tabella:=TStringList.Create;
+ SaveBase(tabella,addMarker);
+ StringName:=tabella.Text;
+ tabella.Free;
+end;
+
+procedure TSemaphorGrid.AssignG(SG: TSemaphorGrid; autoadjust:boolean);
+var strtmp:string;
+begin
+ SG.SaveToString(strtmp,true);
+ LoadFromString(strtmp, autoadjust);
+end;
+
+procedure TSemaphorGrid.AssignToG(SG: TSemaphorGrid; autoadjust:boolean);
+var strtmp:string;
+begin
+ SaveToString(strtmp,true);
+ SG.LoadFromString(strtmp, autoadjust);
+end;
+
+procedure TSemaphorGrid.AutoWidth;
+var j,Wtmp:integer;
+begin
+ Wtmp:=0;
+ if BorderStyle=bsSingle then
+ {$IFdef MSWindows}
+ Wtmp:=Wtmp+2*GetSystemMetrics(SM_CXFIXEDFRAME);
+ {$ELSE}
+ Wtmp:=Wtmp+2*1;//GetSystemMetrics(SM_CXFIXEDFRAME);
+ {$ENDIF}
+ for j:=0 to ColCount-1 do
+ Wtmp:=Wtmp+GridLineWidth+ColWidths[j];
+ Wtmp:=Wtmp-2*GridLineWidth;
+ if ScrollBarIsVisible(SB_Vert) then begin
+ Wtmp:=Wtmp+GetSystemMetrics(SM_CXVSCROLL);//+GetSystemMetrics(SM_CXEDGE);
+ end;
+ Width:=Wtmp;
+end;
+
+procedure TSemaphorGrid.AutoHeight;
+var i,Htmp:integer;
+begin
+ Htmp:=0;
+ if BorderStyle=bsSingle then
+ {$IFdef MSWindows}
+ Htmp:=Htmp+2*GetSystemMetrics(SM_CYFIXEDFRAME);
+ {$ELSE}
+ Htmp:=Htmp+2*1;//GetSystemMetrics(SM_CYFIXEDFRAME);
+ {$ENDIF}
+ for i:=0 to RowCount-1 do
+ Htmp:=Htmp+GridLineWidth+RowHeights[i];
+ Htmp:=Htmp-2*GridLineWidth;
+ if ScrollBarIsVisible(SB_Horz) then begin
+ Htmp:=Htmp+GetSystemMetrics(SM_CYVSCROLL);
+ end;
+ Height:=Htmp;
+end;
+
+procedure TSemaphorGrid.AutoFit;
+begin
+ AutoWidth;
+ AutoHeight;
+ if not ScrollBarIsVisible(SB_Vert) then
+ AutoWidth;
+ if not ScrollBarIsVisible(SB_Horz) then
+ AutoHeight;
+end;
+
+{ FileName: file to export data; SelfExt: if true SemaphorGrid change the file
+extension to xls compatible with MS Excel and maybe other similar, and if there
+is not extension SemaphorGrid append xls extension to FileName }
+procedure TSemaphorGrid.ExportToExcel(FileName:string;SelfExt:boolean);
+var CHSEPOld:Char;
+ FileNameXLS:string;
+
+begin
+ CHSEPOld:=CHSEP;
+ CHSEP:=#9;//tab
+ FileNameXLS:=FileName;
+ if (SelfExt)and(UpperCase(ExtractFileExt(FileNameXLS))<>'XLS') then begin
+ Delete(FileNameXLS,Length(FileNameXLS)-2,3);//pos(CHSEP,strtmp))
+ if Pos('.',FileNameXLS)<>(Length(FileNameXLS)) then
+ FileNameXLS:=FileNameXLS+'.xls'
+ else
+ FileNameXLS:=FileNameXLS+'xls';
+ end;
+ SaveToFileG(FileNameXLS,false);
+ CHSEP:=CHSEPOld
+end;
+
+function TSemaphorGrid.DoCompareCells(Acol, ARow, Bcol, BRow: Integer): Integer;
+var
+ S1,S2: String;
+ V1,V2: Extended;
+begin
+ case FSortType of
+ tsAlphabetic:
+ begin
+ S1 := Cells[ACol,ARow];
+ S2 := Cells[BCol,BRow];
+ if S1>S2 then Result := 1 else
+ if S1V2 then
+ Result := 1
+ else if V10 then result:=-1;
+ end;
+ if assigned(OnCompareCells) then
+ OnCompareCells(Self, ACol,ARow,BCol,BRow, Result);
+end;
+
+procedure TSemaphorGrid.DeleteColumn(j:integer);
+begin
+ DeleteColRow(true,j);
+end;
+
+procedure TSemaphorGrid.DeleteRow(i:integer);
+begin
+ DeleteColRow(false,i);
+end;
+
+procedure TSemaphorGrid.SortFromColumn(j:integer; TS:TTypeSort; SD:TDirection; autoadjust:boolean);
+ function AutomaticSortType: TTypeSort;
+ var i: Integer;
+ begin
+ // returns the sort type of a omogeneus column j
+ // for non omogeneus, Alphabetical is assumed
+ Result:=tsNumeric;
+ for i:=FixedRows to RowCount-1 do
+ if Cells[j,i]<>'' then
+ try
+ StrToFloat(Cells[j,i]);
+ except
+ Result:=tsDate;
+ break;
+ end;
+ if Result=tsNumeric then
+ exit;
+ for i:=FixedRows to RowCount-1 do
+ if Cells[j,i]<>'' then
+ try
+ StrToDate(Cells[j,i]);
+ except
+ Result:=tsAlphabetic;
+ break;
+ end;
+ end;
+begin
+ if Ts=tsAutomatic then
+ FSortType := AutomaticSortType
+ else
+ FSortType := Ts;
+ FSortDirection := SD;
+ BeginUpdate;
+ SortColRow(True, J);
+ if autoadjust then
+ AutoAdjustColumns;
+ EndUpdate(true);
+end;
+
+procedure TSemaphorGrid.HideCol(j:integer);
+var strj:string;
+begin
+ if j-1 then begin
+ exit
+ end else begin
+ ExWidths.Add(strj);
+ ExWidths.Add(IntToStr(ColWidths[j]));
+ end;
+ ColWidths[j]:=WidthZero;
+ end;
+end;
+
+procedure TSemaphorGrid.ShowCol(j:integer);
+var strj:string;
+ index:integer;
+begin
+ if j-1 then begin
+ ColWidths[j]:=StrToInt(ExWidths.Strings[index+1]);
+ ExWidths.Delete(index+1);
+ ExWidths.Delete(index);
+ end else
+ exit;
+ end;
+end;
+
+procedure TSemaphorGrid.ShowAllCols;
+var j:integer;
+ strj:string;
+begin
+ while ExWidths.Count>0 do begin
+ strj:=ExWidths.Strings[0];
+ Delete(strj,1,1);
+ j:=StrToInt(strj);
+ ColWidths[j]:=StrToInt(ExWidths.Strings[1]);
+ ExWidths.Delete(1);
+ ExWidths.Delete(0);
+ end;
+(* as different solution
+ for j:=0 to ColCount-1 do
+ ShowCol(j);
+*)
+end;
+
+function TSemaphorGrid.Duplicate(var SG:TSemaphorGrid):Boolean;
+var i,j:integer; // da migliorare
+ duptmp:Boolean;
+begin
+ duptmp:=True;
+ try
+ SG.ColCount:=ColCount;
+ SG.RowCount:=RowCount;
+ for i:=0 to RowCount-1 do
+ for j:=0 to ColCount-1 do
+ SG.Cells[j,i]:=Cells[j,i];
+ except
+ duptmp:=False;
+ SG.Clear(false);
+ end;
+ Result:=duptmp
+end;
+
+procedure TSemaphorGrid.ClearColRow(isColumn:boolean; i:integer);
+var j:integer;
+begin
+ if isColumn then
+ for j:=0 to RowCount-1 do
+ Cells[i,j]:=''
+ else
+ for j:=0 to ColCount-1 do
+ Cells[j,i]:=''
+end;
+
+procedure TSemaphorGrid.Clear(OnlyValue:boolean);
+var i:integer;
+begin
+ for i:= 0 to RowCount-1 do
+ ClearColRow(false,i);
+ if not OnlyValue then begin
+ RowCount:=FixedRows+1;
+ ColCount:=FixedCols+1
+ end
+end;
+
+procedure TSemaphorGrid.SetAlignment(Value: TAlignment);
+begin
+ If FAlignment <> Value then begin
+ FAlignment := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TSemaphorGrid.SetCHSEP(Value : Char);
+begin
+ FCHSEP:=Value;
+end;
+
+procedure TSemaphorGrid.SetSemaphor(Value : boolean);
+begin
+ FSemaphor:=Value;
+ Invalidate;
+end;
+
+procedure TSemaphorGrid.SetStringRed(Value : string);
+begin
+ FStringRed:=Value;
+ Invalidate;
+end;
+
+procedure TSemaphorGrid.SetStringYellow(Value : string);
+begin
+ FStringYellow:=Value;
+ Invalidate;
+end;
+
+procedure TSemaphorGrid.SetStringGreen(Value : string);
+begin
+ FStringGreen:=Value;
+ Invalidate;
+end;
+
+procedure TSemaphorGrid.SetSemaphorShape(Value : TSemaphorShape);
+begin
+ FSemaphorShape:=Value;
+ Invalidate;
+end;
+
+procedure TSemaphorGrid.SetSemaphorCaseSensitive(Value : boolean);
+begin
+ FSemaphorCaseSensitive:=Value;
+ invalidate;
+end;
+
+procedure TSemaphorGrid.SetSemaphorOnlyFloat(Value : boolean);
+begin
+ FSemaphorOnlyFloat:=Value;
+end;
+
+constructor TSemaphorGrid.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FCHSEP:=#255;
+ Semaphor:=False;
+ StringRed:='no';
+ StringYellow:='maybe';
+ StringGreen:='yes';
+ SemaphorShape:=ssDisk;
+ SemaphorCaseSensitive:=False;
+ SemaphorOnlyFloat:=False;
+ Alignment:=taLeftJustify;
+ WidthZero:=GridLineWidth;
+ ExWidths:=TStringList.Create;
+end;
+
+destructor TSemaphorGrid.Destroy;
+begin
+ ExWidths.Free;
+ inherited Destroy
+end;
+
+procedure Register;
+begin
+ RegisterComponents('Additional',[TSemaphorGrid]);
+end;
+
+end.
+
diff --git a/components/grid_semaphor/semaphorgridsicon.res b/components/grid_semaphor/semaphorgridsicon.res
new file mode 100644
index 000000000..a02dc501b
Binary files /dev/null and b/components/grid_semaphor/semaphorgridsicon.res differ
diff --git a/components/grid_semaphor/tsemaphorgrid.xpm b/components/grid_semaphor/tsemaphorgrid.xpm
new file mode 100644
index 000000000..30d066f5c
--- /dev/null
+++ b/components/grid_semaphor/tsemaphorgrid.xpm
@@ -0,0 +1,72 @@
+/* XPM */
+
+static char * TSemaforoGrid_xpm[] = {
+
+"23 23 10 1",
+
+" c None",
+
+". c #000000",
+
+"+ c #FF0000",
+
+"@ c #C0C0C0",
+
+"# c #FFFFFF",
+
+"$ c #46A057",
+
+"% c #FFFF00",
+
+"& c #008000",
+
+"* c #1D0101",
+
+"= c #0E0000",
+
+" ",
+
+" ................ ++ ",
+
+" .@.#@@@@#@@@@@@. ++++ ",
+
+" ................ ++++ ",
+
+" .@.####@#######. ++ ",
+
+" .#.#$$#@#%%%%%#. ",
+
+" .@.####@#######. %% ",
+
+" .#.#++#@#....##. %%%% ",
+
+" .@.####@#######. %%%% ",
+
+" .#.#%%#@#$$$$$#. %% ",
+
+" .@.####@#######. ",
+
+" .#.#..#@#++++##. && ",
+
+" .@.####@#######. &&&& ",
+
+" *=.............. &&&& ",
+
+" + && ",
+
+" + ",
+
+" ++ +++ ++ ",
+
+" + + + + + ",
+
+" +++ + + + ",
+
+" + + + + + ",
+
+" + + + + + + ",
+
+" +++ +++ ++ ",
+
+" "};
+