mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 21:16:32 +02:00
Examples, added stringgrid column editors sampler, from Mike Sapsard, issue #24076
git-svn-id: trunk@40583 -
This commit is contained in:
jesus
parent
a2a2d1599a
commit
e8206aeb4a
6
.gitattributes
vendored
6
.gitattributes
vendored
@ -4316,6 +4316,12 @@ examples/fpdocmanager/fupdateview.pas svneol=native#text/pascal
|
|||||||
examples/fpdocmanager/ulpk.pp svneol=native#text/pascal
|
examples/fpdocmanager/ulpk.pp svneol=native#text/pascal
|
||||||
examples/fpdocmanager/umakeskel.pas svneol=native#text/pascal
|
examples/fpdocmanager/umakeskel.pas svneol=native#text/pascal
|
||||||
examples/fpdocmanager/umanager.pas svneol=native#text/pascal
|
examples/fpdocmanager/umanager.pas svneol=native#text/pascal
|
||||||
|
examples/gridexamples/columneditors/main.lfm svneol=native#text/plain
|
||||||
|
examples/gridexamples/columneditors/main.lrs svneol=native#text/plain
|
||||||
|
examples/gridexamples/columneditors/main.pas svneol=native#text/plain
|
||||||
|
examples/gridexamples/columneditors/readme.txt svneol=native#text/plain
|
||||||
|
examples/gridexamples/columneditors/stringgrideditor.lpi svneol=native#text/plain
|
||||||
|
examples/gridexamples/columneditors/stringgrideditor.lpr svneol=native#text/plain
|
||||||
examples/gridexamples/grid_semaphor/TSemaphorDBGrid.xpm -text svneol=native#image/x-xpixmap
|
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.lpi svneol=native#text/plain
|
||||||
examples/gridexamples/grid_semaphor/example/project1.lpr svneol=native#text/pascal
|
examples/gridexamples/grid_semaphor/example/project1.lpr svneol=native#text/pascal
|
||||||
|
|||||||
@ -137,6 +137,7 @@ Micha Nelissen
|
|||||||
Michael A. Hess
|
Michael A. Hess
|
||||||
Michal Bukovjan
|
Michal Bukovjan
|
||||||
Michalis Kamburelis
|
Michalis Kamburelis
|
||||||
|
Mike Sapsard
|
||||||
Nikolay Ermolov
|
Nikolay Ermolov
|
||||||
Olivier Guilbaud
|
Olivier Guilbaud
|
||||||
Patrick Chevalley
|
Patrick Chevalley
|
||||||
|
|||||||
158
examples/gridexamples/columneditors/main.lfm
Normal file
158
examples/gridexamples/columneditors/main.lfm
Normal file
@ -0,0 +1,158 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 435
|
||||||
|
Height = 224
|
||||||
|
Top = 198
|
||||||
|
Width = 608
|
||||||
|
HorzScrollBar.Page = 399
|
||||||
|
VertScrollBar.Page = 299
|
||||||
|
ActiveControl = StringGrid1
|
||||||
|
Caption = 'StringGrid Editor'
|
||||||
|
ClientHeight = 224
|
||||||
|
ClientWidth = 608
|
||||||
|
OnCreate = FormCreate
|
||||||
|
LCLVersion = '1.1'
|
||||||
|
object StringGrid1: TStringGrid
|
||||||
|
Left = 16
|
||||||
|
Height = 136
|
||||||
|
Top = 53
|
||||||
|
Width = 576
|
||||||
|
ColCount = 8
|
||||||
|
Columns = <
|
||||||
|
item
|
||||||
|
Title.Caption = 'Auto'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Title.Caption = 'EditMask'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
ButtonStyle = cbsButton
|
||||||
|
Title.Caption = 'Button'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
ButtonStyle = cbsButtonColumn
|
||||||
|
Title.Caption = 'ButtonColumn'
|
||||||
|
Width = 90
|
||||||
|
end
|
||||||
|
item
|
||||||
|
ButtonStyle = cbsCheckboxColumn
|
||||||
|
Title.Caption = 'CheckBox'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
ButtonStyle = cbsEllipsis
|
||||||
|
Title.Caption = 'Ellipsis'
|
||||||
|
end
|
||||||
|
item
|
||||||
|
ButtonStyle = cbsNone
|
||||||
|
Title.Caption = 'None'
|
||||||
|
Width = 80
|
||||||
|
end
|
||||||
|
item
|
||||||
|
ButtonStyle = cbsPickList
|
||||||
|
PickList.Strings = (
|
||||||
|
'Cow'
|
||||||
|
'Dog'
|
||||||
|
'Pig'
|
||||||
|
'Goat'
|
||||||
|
'Elephant'
|
||||||
|
)
|
||||||
|
Title.Caption = 'PickList'
|
||||||
|
end>
|
||||||
|
FixedCols = 0
|
||||||
|
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goSmoothScroll, goCellHints]
|
||||||
|
ParentShowHint = False
|
||||||
|
ScrollBars = ssBoth
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 0
|
||||||
|
OnCheckboxToggled = StringGrid1CheckboxToggled
|
||||||
|
OnDrawCell = StringGrid1DrawCell
|
||||||
|
OnButtonClick = StringGrid1ButtonClick
|
||||||
|
OnGetCellHint = StringGrid1GetCellHint
|
||||||
|
OnGetCheckboxState = StringGrid1GetCheckboxState
|
||||||
|
OnGetEditMask = StringGrid1GetEditMask
|
||||||
|
OnSetEditText = StringGrid1SetEditText
|
||||||
|
OnValidateEntry = StringGrid1ValidateEntry
|
||||||
|
Cells = (
|
||||||
|
1
|
||||||
|
0
|
||||||
|
0
|
||||||
|
'Name'
|
||||||
|
)
|
||||||
|
end
|
||||||
|
object Edit1: TEdit
|
||||||
|
Left = 429
|
||||||
|
Height = 21
|
||||||
|
Hint = 'Change ''None'' text'
|
||||||
|
Top = 192
|
||||||
|
Width = 80
|
||||||
|
OnChange = Edit1Change
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 26
|
||||||
|
Top = 8
|
||||||
|
Width = 501
|
||||||
|
Caption = 'The stringgrid below shows the following button types:'#13#10'Auto, Auto with Editmask, Button, ButtonColumn, CheckBox, Ellipsis, None, and Picklist.'
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 296
|
||||||
|
Height = 13
|
||||||
|
Top = 199
|
||||||
|
Width = 116
|
||||||
|
Caption = 'Change text in this box:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 13
|
||||||
|
Top = 198
|
||||||
|
Width = 64
|
||||||
|
Caption = 'SetEdit text: '
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label4: TLabel
|
||||||
|
Left = 88
|
||||||
|
Height = 13
|
||||||
|
Top = 198
|
||||||
|
Width = 101
|
||||||
|
Caption = 'Auto && EditMask text'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object ColorDialog1: TColorDialog
|
||||||
|
Color = clBlack
|
||||||
|
CustomColors.Strings = (
|
||||||
|
'ColorA=000000'
|
||||||
|
'ColorB=000080'
|
||||||
|
'ColorC=008000'
|
||||||
|
'ColorD=008080'
|
||||||
|
'ColorE=800000'
|
||||||
|
'ColorF=800080'
|
||||||
|
'ColorG=808000'
|
||||||
|
'ColorH=808080'
|
||||||
|
'ColorI=C0C0C0'
|
||||||
|
'ColorJ=0000FF'
|
||||||
|
'ColorK=00FF00'
|
||||||
|
'ColorL=00FFFF'
|
||||||
|
'ColorM=FF0000'
|
||||||
|
'ColorN=FF00FF'
|
||||||
|
'ColorO=FFFF00'
|
||||||
|
'ColorP=FFFFFF'
|
||||||
|
'ColorQ=C0DCC0'
|
||||||
|
'ColorR=F0CAA6'
|
||||||
|
'ColorS=F0FBFF'
|
||||||
|
'ColorT=A4A0A0'
|
||||||
|
)
|
||||||
|
left = 24
|
||||||
|
top = 120
|
||||||
|
end
|
||||||
|
object CalculatorDialog1: TCalculatorDialog
|
||||||
|
CalculatorLayout = clNormal
|
||||||
|
Value = 0
|
||||||
|
left = 136
|
||||||
|
top = 120
|
||||||
|
end
|
||||||
|
end
|
||||||
48
examples/gridexamples/columneditors/main.lrs
Normal file
48
examples/gridexamples/columneditors/main.lrs
Normal file
@ -0,0 +1,48 @@
|
|||||||
|
{ This is an automatically generated lazarus resource file }
|
||||||
|
|
||||||
|
LazarusResources.Add('TForm1','FORMDATA',[
|
||||||
|
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#179#1#6'Height'#3#224#0#3'Top'#3#198#0#5
|
||||||
|
+'Width'#3'`'#2#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1
|
||||||
|
+#13'ActiveControl'#7#11'StringGrid1'#7'Caption'#6#17'StringGrid Editor'#12'C'
|
||||||
|
+'lientHeight'#3#224#0#11'ClientWidth'#3'`'#2#8'OnCreate'#7#10'FormCreate'#10
|
||||||
|
+'LCLVersion'#6#3'1.1'#0#11'TStringGrid'#11'StringGrid1'#4'Left'#2#16#6'Heigh'
|
||||||
|
+'t'#3#136#0#3'Top'#2'5'#5'Width'#3'@'#2#8'ColCount'#2#8#7'Columns'#14#1#13'T'
|
||||||
|
+'itle.Caption'#6#4'Auto'#0#1#13'Title.Caption'#6#8'EditMask'#0#1#11'ButtonSt'
|
||||||
|
+'yle'#7#9'cbsButton'#13'Title.Caption'#6#6'Button'#0#1#11'ButtonStyle'#7#15
|
||||||
|
+'cbsButtonColumn'#13'Title.Caption'#6#12'ButtonColumn'#5'Width'#2'Z'#0#1#11
|
||||||
|
+'ButtonStyle'#7#17'cbsCheckboxColumn'#13'Title.Caption'#6#8'CheckBox'#0#1#11
|
||||||
|
+'ButtonStyle'#7#11'cbsEllipsis'#13'Title.Caption'#6#8'Ellipsis'#0#1#11'Butto'
|
||||||
|
+'nStyle'#7#7'cbsNone'#13'Title.Caption'#6#4'None'#5'Width'#2'P'#0#1#11'Butto'
|
||||||
|
+'nStyle'#7#11'cbsPickList'#16'PickList.Strings'#1#6#3'Cow'#6#3'Dog'#6#3'Pig'
|
||||||
|
+#6#4'Goat'#6#8'Elephant'#0#13'Title.Caption'#6#8'PickList'#0#0#9'FixedCols'#2
|
||||||
|
+#0#7'Options'#11#15'goFixedVertLine'#15'goFixedHorzLine'#10'goVertLine'#10'g'
|
||||||
|
+'oHorzLine'#13'goRangeSelect'#9'goEditing'#18'goAlwaysShowEditor'#14'goSmoot'
|
||||||
|
+'hScroll'#11'goCellHints'#0#14'ParentShowHint'#8#10'ScrollBars'#7#6'ssBoth'#8
|
||||||
|
+'ShowHint'#9#8'TabOrder'#2#0#17'OnCheckboxToggled'#7#26'StringGrid1CheckboxT'
|
||||||
|
+'oggled'#10'OnDrawCell'#7#19'StringGrid1DrawCell'#13'OnButtonClick'#7#22'Str'
|
||||||
|
+'ingGrid1ButtonClick'#13'OnGetCellHint'#7#22'StringGrid1GetCellHint'#18'OnGe'
|
||||||
|
+'tCheckboxState'#7#27'StringGrid1GetCheckboxState'#13'OnGetEditMask'#7#22'St'
|
||||||
|
+'ringGrid1GetEditMask'#13'OnSetEditText'#7#22'StringGrid1SetEditText'#15'OnV'
|
||||||
|
+'alidateEntry'#7#24'StringGrid1ValidateEntry'#5'Cells'#1#2#1#2#0#2#0#6#4'Nam'
|
||||||
|
+'e'#0#0#0#5'TEdit'#5'Edit1'#4'Left'#3#173#1#6'Height'#2#21#4'Hint'#6#18'Chan'
|
||||||
|
+'ge ''None'' text'#3'Top'#3#192#0#5'Width'#2'P'#8'OnChange'#7#11'Edit1Change'
|
||||||
|
+#14'ParentShowHint'#8#8'ShowHint'#9#8'TabOrder'#2#1#0#0#6'TLabel'#6'Label1'#4
|
||||||
|
+'Left'#2#16#6'Height'#2#26#3'Top'#2#8#5'Width'#3#245#1#7'Caption'#6#170'The '
|
||||||
|
+'stringgrid below shows the following button types:'#13#10'Auto, Auto with E'
|
||||||
|
+'ditmask, Button, ButtonColumn, CheckBox, Ellipsis, None, '
|
||||||
|
+' and Picklist.'#11'ParentColor'#8#8'WordWrap'#9#0#0#6'TLabel'#6'Lab'
|
||||||
|
+'el2'#4'Left'#3'('#1#6'Height'#2#13#3'Top'#3#199#0#5'Width'#2't'#7'Caption'#6
|
||||||
|
+#24'Change text in this box:'#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4'Le'
|
||||||
|
+'ft'#2#16#6'Height'#2#13#3'Top'#3#198#0#5'Width'#2'@'#7'Caption'#6#14'SetEdi'
|
||||||
|
+'t text: '#11'ParentColor'#8#0#0#6'TLabel'#6'Label4'#4'Left'#2'X'#6'Height'#2
|
||||||
|
+#13#3'Top'#3#198#0#5'Width'#2'e'#7'Caption'#6#21'Auto && EditMask text'#11'P'
|
||||||
|
+'arentColor'#8#0#0#12'TColorDialog'#12'ColorDialog1'#5'Color'#7#7'clBlack'#20
|
||||||
|
+'CustomColors.Strings'#1#6#13'ColorA=000000'#6#13'ColorB=000080'#6#13'ColorC'
|
||||||
|
+'=008000'#6#13'ColorD=008080'#6#13'ColorE=800000'#6#13'ColorF=800080'#6#13'C'
|
||||||
|
+'olorG=808000'#6#13'ColorH=808080'#6#13'ColorI=C0C0C0'#6#13'ColorJ=0000FF'#6
|
||||||
|
+#13'ColorK=00FF00'#6#13'ColorL=00FFFF'#6#13'ColorM=FF0000'#6#13'ColorN=FF00F'
|
||||||
|
+'F'#6#13'ColorO=FFFF00'#6#13'ColorP=FFFFFF'#6#13'ColorQ=C0DCC0'#6#13'ColorR='
|
||||||
|
+'F0CAA6'#6#13'ColorS=F0FBFF'#6#13'ColorT=A4A0A0'#0#4'left'#2#24#3'top'#2'x'#0
|
||||||
|
+#0#17'TCalculatorDialog'#17'CalculatorDialog1'#16'CalculatorLayout'#7#8'clNo'
|
||||||
|
+'rmal'#5'Value'#5#0#0#0#0#0#0#0#0#0#0#4'left'#3#136#0#3'top'#2'x'#0#0#0
|
||||||
|
]);
|
||||||
266
examples/gridexamples/columneditors/main.pas
Normal file
266
examples/gridexamples/columneditors/main.pas
Normal file
@ -0,0 +1,266 @@
|
|||||||
|
unit main;
|
||||||
|
|
||||||
|
{ fpc/Lazarus demo of TStringGrid and the associated cell/button types.
|
||||||
|
|
||||||
|
Copyright (C) 2013 Windsurfer contact via fpc/Lazarus forum
|
||||||
|
|
||||||
|
This library is free software; you can redistribute it and/or modify it
|
||||||
|
under the terms of the GNU Library General Public License as published by
|
||||||
|
the Free Software Foundation; either version 2 of the License, or (at your
|
||||||
|
option) any later version with the following modification:
|
||||||
|
|
||||||
|
As a special exception, the copyright holders of this library give you
|
||||||
|
permission to link this library with independent modules to produce an
|
||||||
|
executable, regardless of the license terms of these independent modules,and
|
||||||
|
to copy and distribute the resulting executable under terms of your choice,
|
||||||
|
provided that you also meet, for each linked independent module, the terms
|
||||||
|
and conditions of the license of that module. An independent module is a
|
||||||
|
module which is not derived from or based on this library. If you modify
|
||||||
|
this library, you may extend this exception to your version of the library,
|
||||||
|
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||||
|
exception statement from your version.
|
||||||
|
|
||||||
|
This program 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 Library General Public License
|
||||||
|
for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Library General Public License
|
||||||
|
along with this library; if not, write to the Free Software Foundation,
|
||||||
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||||
|
}
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids,
|
||||||
|
StdCtrls, ExtDlgs;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
CalculatorDialog1: TCalculatorDialog;
|
||||||
|
ColorDialog1: TColorDialog;
|
||||||
|
Edit1: TEdit;
|
||||||
|
Label1: TLabel;
|
||||||
|
Label2: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
Label4: TLabel;
|
||||||
|
StringGrid1: TStringGrid;
|
||||||
|
procedure Edit1Change(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure StringGrid1ButtonClick(Sender: TObject; aCol, aRow: integer);
|
||||||
|
procedure StringGrid1CheckboxToggled(Sender: TObject; aCol, aRow: integer;
|
||||||
|
aState: TCheckboxState);
|
||||||
|
procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: integer;
|
||||||
|
aRect: TRect; aState: TGridDrawState);
|
||||||
|
procedure StringGrid1GetCellHint(Sender: TObject; ACol, ARow: integer;
|
||||||
|
var HintText: string);
|
||||||
|
procedure StringGrid1GetCheckboxState(Sender: TObject; ACol, ARow: integer;
|
||||||
|
var Value: TCheckboxState);
|
||||||
|
procedure StringGrid1GetEditMask(Sender: TObject; ACol, ARow: integer;
|
||||||
|
var Value: string);
|
||||||
|
procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: integer;
|
||||||
|
const Value: string);
|
||||||
|
procedure StringGrid1ValidateEntry(Sender: TObject; aCol, aRow: integer;
|
||||||
|
const OldValue: string; var NewValue: string);
|
||||||
|
public
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
type
|
||||||
|
TMyInput = record
|
||||||
|
Auto: string;
|
||||||
|
EditMask: string;
|
||||||
|
Button: TColor;
|
||||||
|
ButtonColumn: string;
|
||||||
|
CheckBox: TCheckBoxState;
|
||||||
|
Ellipsis: string;
|
||||||
|
None: string;
|
||||||
|
PickList: string;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
//Additional Note:
|
||||||
|
//The cbsButton can call the DrawCell event and change the colour immediately
|
||||||
|
//the ColorDialog closes. The cbsEllipsis can only call the DrawCell event when
|
||||||
|
//focus moves to another cell.
|
||||||
|
//In Grids.pas it can be seen that cbsEllipsis calls TButtonCellEditor, but
|
||||||
|
//cbsButton calls both TButtonCellEditor and TStringEditor.
|
||||||
|
//Changing the ButtonStyle of Column 'Button' from cbsButton to cbsEllipsis will
|
||||||
|
//demonstrate this.
|
||||||
|
|
||||||
|
var
|
||||||
|
ayMyInput: array of TMyInput; //All status information is written to and read
|
||||||
|
//from here. This is not strictly necesary, but allows a real program to destroy
|
||||||
|
//the form and keep the information.
|
||||||
|
|
||||||
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
|
var
|
||||||
|
I: integer;
|
||||||
|
begin
|
||||||
|
SetLength(ayMyInput, StringGrid1.RowCount - 1); //grid and array count from 0
|
||||||
|
// Ensure button column is correct colour. Otherwise, DrawCell event will paint it black.
|
||||||
|
for I := 0 to length(ayMyInput) - 1 do
|
||||||
|
ayMyInput[I].Button := clWindow; //TColor
|
||||||
|
for I := 0 to length(ayMyInput) - 1 do
|
||||||
|
ayMyInput[I].CheckBox := cbUnChecked; //TCheckBoxState
|
||||||
|
|
||||||
|
for I := 0 to length(ayMyInput) - 1 do
|
||||||
|
begin
|
||||||
|
ayMyInput[I].None := 'Not editable'; //'None' can only be changed in program
|
||||||
|
StringGrid1.Cells[6, I + 1] := ayMyInput[I].None;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Edit1.Text := ayMyInput[0].None;
|
||||||
|
StringGrid1.Options := StringGrid1.Options + [goCellHints];
|
||||||
|
StringGrid1.ShowHint := True;
|
||||||
|
StringGrid1.Columns.Items[7].PickList.Add('Giraffe'); //Add an item progamatically
|
||||||
|
//The others are added in the Object Inspector
|
||||||
|
Application.HintPause := 1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StringGrid1GetEditMask(Sender: TObject; ACol, ARow: integer;
|
||||||
|
var Value: string);
|
||||||
|
begin
|
||||||
|
//'!' = delete leading blanks. '0' = position must be a number.
|
||||||
|
//'1' = keep formatting symbols. '_' = trailing '0'.
|
||||||
|
//Does not limit fields to 23:59:59.
|
||||||
|
//Use ValidateEntry and Copy()to check and change each character as the cell is exited.
|
||||||
|
if (ARow > 0) and (ACol = 1) then
|
||||||
|
Value := '!00:00:00;1;_';
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: integer;
|
||||||
|
const Value: string);
|
||||||
|
begin //Capture text from columns 0 and 1 to ayMyInput.Auto and .EditMask
|
||||||
|
//SetEditText works for each keystroke
|
||||||
|
if (ARow > 0) then
|
||||||
|
if (ACol = 0) then
|
||||||
|
ayMyInput[aRow - 1].Auto := StringGrid1.Cells[ACol, ARow]
|
||||||
|
else if (ACol = 1) then
|
||||||
|
ayMyInput[aRow - 1].EditMask := StringGrid1.Cells[ACol, ARow];
|
||||||
|
|
||||||
|
Label4.Caption := Value; //Show text as it is typed
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StringGrid1ValidateEntry(Sender: TObject; aCol, aRow: integer;
|
||||||
|
const OldValue: string; var NewValue: string);
|
||||||
|
begin
|
||||||
|
//Constrain to '23:59:59'.
|
||||||
|
//This only takes effect on leaving cell.
|
||||||
|
if (aRow > 0) and (aCol = 1) then
|
||||||
|
begin
|
||||||
|
if Copy(NewValue, 1, 1) > '2' then
|
||||||
|
NewValue[1] := '2';
|
||||||
|
if Copy(NewValue, 2, 1) > '3' then
|
||||||
|
NewValue[2] := '3';
|
||||||
|
if Copy(NewValue, 4, 1) > '5' then
|
||||||
|
NewValue[4] := '5';
|
||||||
|
if Copy(NewValue, 7, 1) > '5' then
|
||||||
|
NewValue[7] := '5';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StringGrid1ButtonClick(Sender: TObject; aCol, aRow: integer);
|
||||||
|
begin
|
||||||
|
//For these columns there is no manual entry into the cell,
|
||||||
|
//so use ButtonClick event
|
||||||
|
|
||||||
|
if (aCol = 2) and ColorDialog1.Execute then //Button
|
||||||
|
begin
|
||||||
|
ayMyInput[aRow - 1].Button := Colordialog1.Color; //store cell colour in array
|
||||||
|
StringGrid1.Invalidate; //Could also use 'Repaint' te force DrawCell event
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (aCol = 3) then //ButtonColumn
|
||||||
|
begin
|
||||||
|
StringGrid1.Options := StringGrid1.Options - [goEditing];
|
||||||
|
//Prevent write to previous cell
|
||||||
|
ayMyInput[aRow - 1].ButtonColumn := IntToStr(aCol) + ',' + IntToStr(aRow);
|
||||||
|
//store as string
|
||||||
|
StringGrid1.Cells[aCol, aRow] := ayMyInput[aRow - 1].ButtonColumn;
|
||||||
|
StringGrid1.Options := StringGrid1.Options + [goEditing]; //Turn cell editing back on
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (aCol = 5) and CalculatorDialog1.Execute then //Ellipsis
|
||||||
|
begin
|
||||||
|
// Click 'tick' sign on calculator to get result
|
||||||
|
ayMyInput[aRow - 1].Ellipsis := FloattoStr(Calculatordialog1.Value);
|
||||||
|
//Store as string
|
||||||
|
StringGrid1.Cells[aCol, aRow] := ayMyInput[aRow - 1].Ellipsis;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StringGrid1CheckboxToggled(Sender: TObject;
|
||||||
|
aCol, aRow: integer; aState: TCheckboxState);
|
||||||
|
begin
|
||||||
|
if (ARow > 0) and (ACol = 4) then
|
||||||
|
ayMyInput[ARow - 1].CheckBox := aState;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StringGrid1GetCheckboxState(Sender: TObject;
|
||||||
|
ACol, ARow: integer; var Value: TCheckboxState);
|
||||||
|
begin
|
||||||
|
if (ARow > 0) and (ACol = 4) then
|
||||||
|
Value := ayMyInput[ARow - 1].CheckBox;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Edit1Change(Sender: TObject);
|
||||||
|
var
|
||||||
|
I: integer;
|
||||||
|
begin
|
||||||
|
for I := 1 to StringGrid1.RowCount - 1 do //'None' can only be changed in program
|
||||||
|
begin
|
||||||
|
ayMyInput[I - 1].None := Edit1.Text;
|
||||||
|
StringGrid1.Cells[6, I] := ayMyInput[I - 1].None;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: integer;
|
||||||
|
aRect: TRect; aState: TGridDrawState);
|
||||||
|
begin
|
||||||
|
//Note in Col 2 'Button' the Repaint event takes place before the focus changes
|
||||||
|
//to another cell.
|
||||||
|
|
||||||
|
if (aRow > 0) then //Use DrawCell to paint rectangle
|
||||||
|
if (ACol = 2) then
|
||||||
|
begin //Get colour from array
|
||||||
|
stringgrid1.canvas.Brush.Color := ayMyInput[aRow - 1].Button;
|
||||||
|
stringgrid1.canvas.FillRect(aRect); //Paint Cell
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.StringGrid1GetCellHint(Sender: TObject; ACol, ARow: integer;
|
||||||
|
var HintText: string);
|
||||||
|
begin
|
||||||
|
case ACol of
|
||||||
|
0: HintText := 'Button style cbsAuto sting grid column' +
|
||||||
|
sLineBreak + ' - enter any text.';
|
||||||
|
1: HintText := 'Button style cbsAuto, with basic Editmask for Time format.' +
|
||||||
|
sLineBreak + 'Uses ValidateEntry as cell is exited to enforce max of ''23:59:59''';
|
||||||
|
2: HintText := 'Button style cbsButton that shows colour dialog' +
|
||||||
|
sLineBreak + ' and changes cell colour.';
|
||||||
|
3: HintText := 'Button style cbsButtonColumn that shows cell position.';
|
||||||
|
4: HintText := 'Button style cbsCheckbox that toggles ''check'' mark.';
|
||||||
|
5: HintText := 'Button style cbsEllipsis that opens calculator.' +
|
||||||
|
sLineBreak + 'Click ''tick'' on calculator to send value to cell.';
|
||||||
|
6: HintText := 'Button style cbsNone that cannot be changed manually.' +
|
||||||
|
sLineBreak + 'Change Edit box contents to change displayed text.';
|
||||||
|
7: HintText := 'Button style cbsPicklist that offers a choice from' +
|
||||||
|
sLineBreak + 'a list set in the Object Inspector.';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{$I main.lrs}
|
||||||
|
|
||||||
|
end.
|
||||||
38
examples/gridexamples/columneditors/readme.txt
Normal file
38
examples/gridexamples/columneditors/readme.txt
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
Readme.txt
|
||||||
|
|
||||||
|
There are seven different kinds of column, and they have different events for
|
||||||
|
control. Mastering them requires some study.
|
||||||
|
|
||||||
|
This example was started because I did not understand how to make a checkbox
|
||||||
|
column work in a TStringGrid. I also needed to have a sticky output, so that the
|
||||||
|
form could be destroyed leaving the results. All results are therefore passed to
|
||||||
|
an array as they are generated. The types of each field in the array are
|
||||||
|
appropriate to this program. You may choose other types for the array fields,
|
||||||
|
and change your code accordingly.
|
||||||
|
|
||||||
|
The basic functionality of each of the seven kinds of column plus a basic (Auto)
|
||||||
|
column with an EditMask are demonstrated. The Editmask constrains the input
|
||||||
|
to between 00:00:00 and 99:99:99 but cannot limit it to 23:59:59. The
|
||||||
|
onValidateEntry event is used to do this.
|
||||||
|
|
||||||
|
Other buttons change cell colours, show grid position, or add results from a
|
||||||
|
calculator. Some are changed manually and others programmatically.
|
||||||
|
|
||||||
|
The cbsButton can call the DrawCell event and change the colour immediately
|
||||||
|
the ColorDialog closes. The cbsEllipsis can only call the DrawCell event when
|
||||||
|
focus moves to another cell.
|
||||||
|
In Grids.pas it can be seen that cbsEllipsis calls TButtonCellEditor, but
|
||||||
|
cbsButton calls both TButtonCellEditor and TStringEditor.
|
||||||
|
Changing the ButtonStyle of Column 'Button' from cbsButton to cbsEllipsis will
|
||||||
|
demonstrate this.
|
||||||
|
|
||||||
|
If the cell focus is changed to the next column in code, this is not noticeable.
|
||||||
|
Example:
|
||||||
|
With StringGrid1 do
|
||||||
|
If (Col < ColCount-1) then
|
||||||
|
Col := Col + 1;
|
||||||
|
|
||||||
|
The code is commented, but also read
|
||||||
|
http://wiki.freepascal.org/Grids_Reference_Page.
|
||||||
|
|
||||||
|
Windsurfer 2013
|
||||||
100
examples/gridexamples/columneditors/stringgrideditor.lpi
Normal file
100
examples/gridexamples/columneditors/stringgrideditor.lpi
Normal file
@ -0,0 +1,100 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<LRSInOutputDirectory Value="False"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="stringgrideditor"/>
|
||||||
|
</General>
|
||||||
|
<VersionInfo>
|
||||||
|
<StringTable ProductVersion=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<DestinationDirectory Value="$(ProjPath)/published/"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml|txt)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="1">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item1>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="3">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="stringgrideditor.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="stringgrideditor"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="main.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="Form1"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
<UnitName Value="main"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="readme.txt"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit2>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="stringgrideditor"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Parsing>
|
||||||
|
<SyntaxOptions>
|
||||||
|
<UseAnsiStrings Value="False"/>
|
||||||
|
</SyntaxOptions>
|
||||||
|
</Parsing>
|
||||||
|
<CodeGeneration>
|
||||||
|
<Checks>
|
||||||
|
<IOChecks Value="True"/>
|
||||||
|
<RangeChecks Value="True"/>
|
||||||
|
<OverflowChecks Value="True"/>
|
||||||
|
<StackChecks Value="True"/>
|
||||||
|
</Checks>
|
||||||
|
<Optimizations>
|
||||||
|
<OptimizationLevel Value="2"/>
|
||||||
|
</Optimizations>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Linking>
|
||||||
|
<Debugging>
|
||||||
|
<GenerateDebugInfo Value="False"/>
|
||||||
|
</Debugging>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<Verbosity>
|
||||||
|
<ShowHints Value="False"/>
|
||||||
|
<ShowGenInfo Value="False"/>
|
||||||
|
</Verbosity>
|
||||||
|
<WriteFPCLogo Value="False"/>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
</CONFIG>
|
||||||
46
examples/gridexamples/columneditors/stringgrideditor.lpr
Normal file
46
examples/gridexamples/columneditors/stringgrideditor.lpr
Normal file
@ -0,0 +1,46 @@
|
|||||||
|
program stringgrideditor;
|
||||||
|
|
||||||
|
{ fpc/Lazarus demo of TStringGrid and the associated cell/button types.
|
||||||
|
|
||||||
|
Copyright (C) 2013 Windsurfer contact via fpc/Lazarus forum
|
||||||
|
|
||||||
|
This library is free software; you can redistribute it and/or modify it
|
||||||
|
under the terms of the GNU Library General Public License as published by
|
||||||
|
the Free Software Foundation; either version 2 of the License, or (at your
|
||||||
|
option) any later version with the following modification:
|
||||||
|
|
||||||
|
As a special exception, the copyright holders of this library give you
|
||||||
|
permission to link this library with independent modules to produce an
|
||||||
|
executable, regardless of the license terms of these independent modules,and
|
||||||
|
to copy and distribute the resulting executable under terms of your choice,
|
||||||
|
provided that you also meet, for each linked independent module, the terms
|
||||||
|
and conditions of the license of that module. An independent module is a
|
||||||
|
module which is not derived from or based on this library. If you modify
|
||||||
|
this library, you may extend this exception to your version of the library,
|
||||||
|
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||||
|
exception statement from your version.
|
||||||
|
|
||||||
|
This program 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 Library General Public License
|
||||||
|
for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Library General Public License
|
||||||
|
along with this library; if not, write to the Free Software Foundation,
|
||||||
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||||
|
}
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
|
||||||
|
cthreads, {$ENDIF} {$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms { add your units here },
|
||||||
|
main;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user