mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 02:58:05 +02:00
Move package SemaphorGridLPK and its example project to Lazarus-CCR.
git-svn-id: trunk@56248 -
This commit is contained in:
juha
parent
0bf8f0f4c9
commit
ad57283d64
18
.gitattributes
vendored
18
.gitattributes
vendored
@ -5925,23 +5925,6 @@ examples/gridexamples/embedded_images/images.lpi svneol=native#text/plain
|
||||
examples/gridexamples/embedded_images/images.lpr svneol=native#text/plain
|
||||
examples/gridexamples/embedded_images/imgmain.lfm svneol=native#text/plain
|
||||
examples/gridexamples/embedded_images/imgmain.pas svneol=native#text/plain
|
||||
examples/gridexamples/grid_semaphor/TSemaphorDBGrid.xpm -text svneol=native#image/x-xpixmap
|
||||
examples/gridexamples/grid_semaphor/example/project1.lpi svneol=native#text/plain
|
||||
examples/gridexamples/grid_semaphor/example/project1.lpr svneol=native#text/pascal
|
||||
examples/gridexamples/grid_semaphor/example/table01.stb -text svneol=unset#application/octet-stream
|
||||
examples/gridexamples/grid_semaphor/example/table02.stb -text svneol=unset#application/octet-stream
|
||||
examples/gridexamples/grid_semaphor/example/table03hidden.stb -text svneol=unset#application/octet-stream
|
||||
examples/gridexamples/grid_semaphor/example/table04hidden.stb -text svneol=unset#application/octet-stream
|
||||
examples/gridexamples/grid_semaphor/example/unit1.lfm svneol=native#text/plain
|
||||
examples/gridexamples/grid_semaphor/example/unit1.pas svneol=native#text/pascal
|
||||
examples/gridexamples/grid_semaphor/readme.txt svneol=native#text/plain
|
||||
examples/gridexamples/grid_semaphor/semaphordbgridicon.res -text
|
||||
examples/gridexamples/grid_semaphor/semaphordbgrids.pas svneol=native#text/pascal
|
||||
examples/gridexamples/grid_semaphor/semaphorgridlpk.lpk svneol=native#text/pascal
|
||||
examples/gridexamples/grid_semaphor/semaphorgridlpk.pas svneol=native#text/pascal
|
||||
examples/gridexamples/grid_semaphor/semaphorgrids.pas svneol=native#text/pascal
|
||||
examples/gridexamples/grid_semaphor/semaphorgridsicon.res -text
|
||||
examples/gridexamples/grid_semaphor/tsemaphorgrid.xpm -text svneol=native#image/x-xpixmap
|
||||
examples/gridexamples/gridcelleditor/gridcelleditor.lpi svneol=native#text/plain
|
||||
examples/gridexamples/gridcelleditor/gridcelleditor.lpr svneol=native#text/plain
|
||||
examples/gridexamples/gridcelleditor/unit1.lfm svneol=native#text/plain
|
||||
@ -9787,7 +9770,6 @@ packager/globallinks/quickfixexample-0.lpl svneol=native#text/plain
|
||||
packager/globallinks/runtimetypeinfocontrols-0.1.lpl svneol=native#text/plain
|
||||
packager/globallinks/rx-1.lpl svneol=native#text/plain
|
||||
packager/globallinks/sdflaz-0.1.1.lpl svneol=native#text/plain
|
||||
packager/globallinks/semaphorgridlpk-1.0.1.lpl svneol=native#text/plain
|
||||
packager/globallinks/simpleideintf-0.lpl svneol=native#text/plain
|
||||
packager/globallinks/sparta_dockedformeditor-0.lpl svneol=native#text/plain
|
||||
packager/globallinks/sparta_generics-0.lpl svneol=native#text/plain
|
||||
|
||||
@ -1,33 +0,0 @@
|
||||
/* 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",
|
||||
"@@@@@@@@@@@@@@@ ",
|
||||
"@#@*####*#####@ ",
|
||||
"@@@@@@@@@@@@@@@ ",
|
||||
"@#@****#******@ $$ ",
|
||||
"@*@*$$*#*++++*@ $$$$ ",
|
||||
"@#@****#******@ $$$$ ",
|
||||
"@*@*&&*#*###**@ $$ ",
|
||||
"@#@****#******@ ",
|
||||
"@*@..............&&..",
|
||||
"@#@.#.*#####*###&&&&.",
|
||||
"@@@.............&&&&.",
|
||||
" .#.*****#*****&&*.",
|
||||
" .*.##############.",
|
||||
" .#.*****#*****++*.",
|
||||
" .*.##########++++.",
|
||||
" .#.*****#****++++.",
|
||||
" .*.###########++#.",
|
||||
" .#.*****#********.",
|
||||
" .*.##############.",
|
||||
" .#.*****#********.",
|
||||
" .................."};
|
||||
@ -1,61 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="10"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<SaveOnlyProjectUnits Value="True"/>
|
||||
<LRSInOutputDirectory Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InIDEConfig"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="project1"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="SemaphorGridLPK"/>
|
||||
<MinVersion Minor="1" Release="6" Build="1" Valid="True"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
@ -1,37 +0,0 @@
|
||||
{
|
||||
***************************************************************************
|
||||
* *
|
||||
* 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
|
||||
}
|
||||
|
||||
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.
|
||||
|
||||
@ -1,6 +0,0 @@
|
||||
S_M_0_1˙1˙1
|
||||
˙˙˙˙
|
||||
˙no˙yes˙˙
|
||||
˙Semaphor˙Grid˙no˙
|
||||
˙if˙0.9877˙˙
|
||||
˙maybe˙˙˙
|
||||
@ -1,6 +0,0 @@
|
||||
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˙˙˙
|
||||
@ -1,6 +0,0 @@
|
||||
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
|
||||
@ -1,6 +0,0 @@
|
||||
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
|
||||
@ -1,349 +0,0 @@
|
||||
object Form1: TForm1
|
||||
Left = 183
|
||||
Height = 423
|
||||
Top = 115
|
||||
Width = 590
|
||||
HorzScrollBar.Page = 589
|
||||
VertScrollBar.Page = 422
|
||||
ActiveControl = SemaphorGrid1
|
||||
Caption = 'Try SemaphorGrid'
|
||||
OnCreate = Form1Create
|
||||
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 = 20
|
||||
Top = 165
|
||||
Width = 84
|
||||
Caption = 'Ascending'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 10
|
||||
end
|
||||
object RadioButton2: TRadioButton
|
||||
Left = 286
|
||||
Height = 20
|
||||
Top = 196
|
||||
Width = 91
|
||||
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 = 20
|
||||
Top = 196
|
||||
Width = 84
|
||||
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 = 20
|
||||
Top = 196
|
||||
Width = 83
|
||||
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
|
||||
ColCount = 5
|
||||
DefaultRowHeight = 24
|
||||
FixedColor = clBtnFace
|
||||
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll]
|
||||
RowCount = 5
|
||||
ScrollBars = ssAutoBoth
|
||||
TabOrder = 0
|
||||
TabStop = True
|
||||
Constraints.MaxHeight = 160
|
||||
Constraints.MaxWidth = 350
|
||||
Alignment = taCenter
|
||||
Semaphor = True
|
||||
StringRed = 'no'
|
||||
StringYellow = 'maybe'
|
||||
StringGreen = 'yes'
|
||||
SemaphorShape = ssDisk
|
||||
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
|
||||
Height = 111
|
||||
Top = 305
|
||||
Width = 288
|
||||
ColCount = 5
|
||||
FixedColor = clBtnFace
|
||||
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll]
|
||||
RowCount = 5
|
||||
ScrollBars = ssAutoBoth
|
||||
TabOrder = 21
|
||||
TabStop = True
|
||||
StringRed = 'no'
|
||||
StringYellow = 'maybe'
|
||||
StringGreen = 'yes'
|
||||
SemaphorShape = ssDisk
|
||||
end
|
||||
object SemaphorGrid3: TSemaphorGrid
|
||||
Left = 296
|
||||
Height = 112
|
||||
Top = 304
|
||||
Width = 279
|
||||
ColCount = 5
|
||||
FixedColor = clBtnFace
|
||||
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll]
|
||||
RowCount = 5
|
||||
ScrollBars = ssAutoBoth
|
||||
TabOrder = 22
|
||||
TabStop = True
|
||||
Semaphor = True
|
||||
StringRed = 'no'
|
||||
StringYellow = 'maybe'
|
||||
StringGreen = 'yes'
|
||||
SemaphorShape = ssDisk
|
||||
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
|
||||
Title = 'Save file as'
|
||||
FilterIndex = 0
|
||||
left = 40
|
||||
top = 376
|
||||
end
|
||||
object OpenDialog1: TOpenDialog
|
||||
Title = 'Open existing file'
|
||||
FilterIndex = 0
|
||||
left = 8
|
||||
top = 376
|
||||
end
|
||||
end
|
||||
@ -1,227 +0,0 @@
|
||||
{
|
||||
***************************************************************************
|
||||
* *
|
||||
* 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., 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
|
||||
{ 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.
|
||||
|
||||
@ -1,35 +0,0 @@
|
||||
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
|
||||
Binary file not shown.
@ -1,172 +0,0 @@
|
||||
{*****************************************************************************
|
||||
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
|
||||
{ Private declarations }
|
||||
FSemaphor : boolean;
|
||||
FStringRed : string;
|
||||
FStringYellow : string;
|
||||
FStringGreen : string;
|
||||
FSemaphorShape : TSemaphorShape;
|
||||
FSemaphorCaseSensitive : boolean;
|
||||
procedure SetSemaphorShape(Value : TSemaphorShape);
|
||||
protected
|
||||
{ Protected declarations }
|
||||
procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override;
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
{ Published declarations }
|
||||
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.
|
||||
|
||||
|
||||
@ -1,52 +0,0 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="SemaphorGridLPK"/>
|
||||
<AddToProjectUsesSection Value="True"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<ConfigFile>
|
||||
<ConfigFilePath Value=".\fpc.cfg"/>
|
||||
</ConfigFile>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Version Major="1" Release="1"/>
|
||||
<Files Count="2">
|
||||
<Item1>
|
||||
<Filename Value="semaphorgrids.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="SemaphorGrids"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="semaphordbgrids.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="SemaphorDBGrids"/>
|
||||
</Item2>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
<MinVersion Major="1" Valid="True"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
<MinVersion Major="1" Valid="True"/>
|
||||
</Item2>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
@ -1,23 +0,0 @@
|
||||
{ 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.
|
||||
@ -1,778 +0,0 @@
|
||||
{
|
||||
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
|
||||
{ Private declarations }
|
||||
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
|
||||
{ Protected declarations }
|
||||
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
|
||||
{ Public declarations }
|
||||
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
|
||||
{ Published declarations }
|
||||
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<i then
|
||||
RowCount:=RowCount+1;
|
||||
if ColCount<j+1 then
|
||||
ColCount:=j+1;
|
||||
Rows[i-1]:=riga;
|
||||
end;
|
||||
end else begin
|
||||
RowCount:=FixedRows+1;
|
||||
ColCount:=FixedCols+1;
|
||||
strFirst:='';
|
||||
strtmp:='';
|
||||
for i:=0 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<i+1 then
|
||||
RowCount:=RowCount+1;
|
||||
if ColCount<j+1 then
|
||||
ColCount:=j+1;
|
||||
Rows[i]:=riga;
|
||||
end
|
||||
end;
|
||||
riga.Free;
|
||||
|
||||
if autoadjust then
|
||||
AutoAdjustColumns;//all cols, also hidden
|
||||
|
||||
if strFirst<>'' 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 S1<S2 then Result := -1
|
||||
else result := 0;
|
||||
end;
|
||||
tsNumeric, tsDate:
|
||||
begin
|
||||
if fSortType = tsNumeric then begin
|
||||
V1 := StrToFloatDef(Cells[ACol,ARow], 0.0);
|
||||
V2 := StrToFloatDef(Cells[BCol,BRow], 0.0);
|
||||
end else begin
|
||||
V1 := StrToDate(Cells[ACol,ARow]);
|
||||
V2 := StrToDate(Cells[BCol,BRow]);
|
||||
end;
|
||||
if V1>V2 then
|
||||
Result := 1
|
||||
else if V1<V2 then
|
||||
Result := -1
|
||||
else
|
||||
result := 0;
|
||||
end;
|
||||
end;
|
||||
if FSortDirection=sdDescending then begin
|
||||
if Result<0 then result:=1 else
|
||||
if result>0 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<ColCount then begin
|
||||
strj:='j'+IntToStr(j);
|
||||
if ExWidths.IndexOf(strj)<>-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<ColCount then begin
|
||||
strj:='j'+IntToStr(j);
|
||||
index:=ExWidths.IndexOf(strj);
|
||||
if index<>-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.
|
||||
|
||||
Binary file not shown.
@ -1,72 +0,0 @@
|
||||
/* 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",
|
||||
|
||||
" ",
|
||||
|
||||
" ................ ++ ",
|
||||
|
||||
" .@.#@@@@#@@@@@@. ++++ ",
|
||||
|
||||
" ................ ++++ ",
|
||||
|
||||
" .@.####@#######. ++ ",
|
||||
|
||||
" .#.#$$#@#%%%%%#. ",
|
||||
|
||||
" .@.####@#######. %% ",
|
||||
|
||||
" .#.#++#@#....##. %%%% ",
|
||||
|
||||
" .@.####@#######. %%%% ",
|
||||
|
||||
" .#.#%%#@#$$$$$#. %% ",
|
||||
|
||||
" .@.####@#######. ",
|
||||
|
||||
" .#.#..#@#++++##. && ",
|
||||
|
||||
" .@.####@#######. &&&& ",
|
||||
|
||||
" *=.............. &&&& ",
|
||||
|
||||
" + && ",
|
||||
|
||||
" + ",
|
||||
|
||||
" ++ +++ ++ ",
|
||||
|
||||
" + + + + + ",
|
||||
|
||||
" +++ + + + ",
|
||||
|
||||
" + + + + + ",
|
||||
|
||||
" + + + + + + ",
|
||||
|
||||
" +++ +++ ++ ",
|
||||
|
||||
" "};
|
||||
|
||||
@ -1 +0,0 @@
|
||||
$(LazarusDir)/examples/gridexamples/grid_semaphor/semaphorgridlpk.lpk
|
||||
Loading…
Reference in New Issue
Block a user