← Back to branch summary

~ubuntu-branches/ubuntu/vivid/lazarus/vivid

« back to all changes in this revision

Viewing changes to examples/gridexamples/columneditors/main.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Paul Gevers
  • Date: 2014-02-22 10:25:57 UTC
  • mfrom: (1.1.11)
  • Revision ID: package-import@ubuntu.com-20140222102557-ors9d31r84nz31jq
Tags: 1.2~rc2+dfsg-1
http://bugs.debian.org/724776
[ Abou Al Montacir ]
* New upstream pre-release.
  + Moved ideintf to components directory.
  + Added new package cairocanvas.
* Remove usage of depreciated parameters form of find. (Closes: Bug#724776)
* Bumped standard version to 3.9.5.
* Clean the way handling make files generation and removal.

[ Paul Gevers ]
* Remove nearly obsolete bzip compression for binary packages
  (See https://lists.debian.org/debian-devel/2014/01/msg00542.html)
* Update d/copyright for newly added dir in examples and components
* Update Vcs-* fields with new packaging location
* Update d/watch file to properly (Debian way) change upstreams versions
* Prevent 46MB of package size by sym linking duplicate files
* Patches
  - refresh to remove fuzz
  - add more Lintian found spelling errors
  - new patch to add shbang to two scripts in lazarus-src
* Drop lcl-# from Provides list of lcl-units-#
* Make lazarus-ide-qt4-# an arch all until it really contains stuff
* Make all metapackages arch all as the usecase for arch any doesn't
  seem to warrant the addition archive hit
* Fix permissions of non-scripts in lazarus-src-#

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/gridexamples/columneditors/main.pas
 
1
unit main;
 
2
 
 
3
{ fpc/Lazarus demo of TStringGrid and the associated cell/button types.
 
4
 
 
5
  Copyright (C) 2013 Windsurfer contact via fpc/Lazarus forum
 
6
 
 
7
  This library is free software; you can redistribute it and/or modify it
 
8
  under the terms of the GNU Library General Public License as published by
 
9
  the Free Software Foundation; either version 2 of the License, or (at your
 
10
  option) any later version with the following modification:
 
11
 
 
12
  As a special exception, the copyright holders of this library give you
 
13
  permission to link this library with independent modules to produce an
 
14
  executable, regardless of the license terms of these independent modules,and
 
15
  to copy and distribute the resulting executable under terms of your choice,
 
16
  provided that you also meet, for each linked independent module, the terms
 
17
  and conditions of the license of that module. An independent module is a
 
18
  module which is not derived from or based on this library. If you modify
 
19
  this library, you may extend this exception to your version of the library,
 
20
  but you are not obligated to do so. If you do not wish to do so, delete this
 
21
  exception statement from your version.
 
22
 
 
23
  This program is distributed in the hope that it will be useful, but WITHOUT
 
24
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
25
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
 
26
  for more details.
 
27
 
 
28
  You should have received a copy of the GNU Library General Public License
 
29
  along with this library; if not, write to the Free Software Foundation,
 
30
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
31
}
 
32
{$mode objfpc}{$H+}
 
33
 
 
34
interface
 
35
 
 
36
uses
 
37
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids,
 
38
  StdCtrls, ExtDlgs;
 
39
 
 
40
type
 
41
 
 
42
  { TForm1 }
 
43
 
 
44
  TForm1 = class(TForm)
 
45
    CalculatorDialog1: TCalculatorDialog;
 
46
    ColorDialog1: TColorDialog;
 
47
    Edit1: TEdit;
 
48
    Label1: TLabel;
 
49
    Label2: TLabel;
 
50
    Label3: TLabel;
 
51
    Label4: TLabel;
 
52
    StringGrid1: TStringGrid;
 
53
    procedure Edit1Change(Sender: TObject);
 
54
    procedure FormCreate(Sender: TObject);
 
55
    procedure StringGrid1ButtonClick(Sender: TObject; aCol, aRow: integer);
 
56
    procedure StringGrid1CheckboxToggled(Sender: TObject; aCol, aRow: integer;
 
57
      aState: TCheckboxState);
 
58
    procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: integer;
 
59
      aRect: TRect; aState: TGridDrawState);
 
60
    procedure StringGrid1GetCellHint(Sender: TObject; ACol, ARow: integer;
 
61
      var HintText: string);
 
62
    procedure StringGrid1GetCheckboxState(Sender: TObject; ACol, ARow: integer;
 
63
      var Value: TCheckboxState);
 
64
    procedure StringGrid1GetEditMask(Sender: TObject; ACol, ARow: integer;
 
65
      var Value: string);
 
66
    procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: integer;
 
67
      const Value: string);
 
68
    procedure StringGrid1ValidateEntry(Sender: TObject; aCol, aRow: integer;
 
69
      const OldValue: string; var NewValue: string);
 
70
  public
 
71
  end;
 
72
 
 
73
var
 
74
  Form1: TForm1;
 
75
 
 
76
type
 
77
  TMyInput = record
 
78
    Auto: string;
 
79
    EditMask: string;
 
80
    Button: TColor;
 
81
    ButtonColumn: string;
 
82
    CheckBox: TCheckBoxState;
 
83
    Ellipsis: string;
 
84
    None: string;
 
85
    PickList: string;
 
86
  end;
 
87
 
 
88
implementation
 
89
 
 
90
{ TForm1 }
 
91
 
 
92
//Additional Note:
 
93
//The cbsButton can call the DrawCell event and change the colour immediately
 
94
//the ColorDialog closes. The cbsEllipsis can only call the DrawCell event when
 
95
//focus moves to another cell.
 
96
//In Grids.pas it can be seen that cbsEllipsis calls TButtonCellEditor, but
 
97
//cbsButton calls both TButtonCellEditor and TStringEditor.
 
98
//Changing the ButtonStyle of Column 'Button' from cbsButton to cbsEllipsis will
 
99
//demonstrate this.
 
100
 
 
101
var
 
102
  ayMyInput: array of TMyInput;  //All status information is written to and read
 
103
//from here. This is not strictly necesary, but allows a real program to destroy
 
104
//the form and keep  the information.
 
105
 
 
106
procedure TForm1.FormCreate(Sender: TObject);
 
107
var
 
108
  I: integer;
 
109
begin
 
110
  SetLength(ayMyInput, StringGrid1.RowCount - 1); //grid and array count from 0
 
111
  // Ensure button column is correct colour. Otherwise, DrawCell event will paint it black.
 
112
  for I := 0 to length(ayMyInput) - 1 do
 
113
    ayMyInput[I].Button := clWindow;  //TColor
 
114
  for I := 0 to length(ayMyInput) - 1 do
 
115
    ayMyInput[I].CheckBox := cbUnChecked; //TCheckBoxState
 
116
 
 
117
  for I := 0 to length(ayMyInput) - 1 do
 
118
  begin
 
119
    ayMyInput[I].None := 'Not editable';  //'None' can only be changed in program
 
120
    StringGrid1.Cells[6, I + 1] := ayMyInput[I].None;
 
121
  end;
 
122
 
 
123
  Edit1.Text := ayMyInput[0].None;
 
124
  StringGrid1.Options := StringGrid1.Options + [goCellHints];
 
125
  StringGrid1.ShowHint := True;
 
126
  StringGrid1.Columns.Items[7].PickList.Add('Giraffe'); //Add an item progamatically
 
127
  //The others are added in the Object Inspector
 
128
  Application.HintPause := 1;
 
129
end;
 
130
 
 
131
procedure TForm1.StringGrid1GetEditMask(Sender: TObject; ACol, ARow: integer;
 
132
  var Value: string);
 
133
begin
 
134
  //'!' = delete leading blanks. '0' = position must be a number.
 
135
  //'1' = keep formatting symbols. '_' =  trailing '0'.
 
136
  //Does not limit fields to 23:59:59.
 
137
  //Use ValidateEntry and Copy()to check and change each character as the cell is exited.
 
138
  if (ARow > 0) and (ACol = 1) then
 
139
    Value := '!00:00:00;1;_';
 
140
end;
 
141
 
 
142
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: integer;
 
143
  const Value: string);
 
144
begin      //Capture text from columns 0 and 1 to ayMyInput.Auto and .EditMask
 
145
  //SetEditText works for each keystroke
 
146
  if (ARow > 0) then
 
147
    if (ACol = 0) then
 
148
      ayMyInput[aRow - 1].Auto := StringGrid1.Cells[ACol, ARow]
 
149
    else if (ACol = 1) then
 
150
      ayMyInput[aRow - 1].EditMask := StringGrid1.Cells[ACol, ARow];
 
151
 
 
152
  Label4.Caption := Value;   //Show text as it is typed
 
153
end;
 
154
 
 
155
procedure TForm1.StringGrid1ValidateEntry(Sender: TObject; aCol, aRow: integer;
 
156
  const OldValue: string; var NewValue: string);
 
157
begin
 
158
  //Constrain to '23:59:59'.
 
159
  //This only takes effect on leaving cell.
 
160
  if (aRow > 0) and (aCol = 1) then
 
161
  begin
 
162
    if Copy(NewValue, 1, 1) > '2' then
 
163
      NewValue[1] := '2';
 
164
    if Copy(NewValue, 2, 1) > '3' then
 
165
      NewValue[2] := '3';
 
166
    if Copy(NewValue, 4, 1) > '5' then
 
167
      NewValue[4] := '5';
 
168
    if Copy(NewValue, 7, 1) > '5' then
 
169
      NewValue[7] := '5';
 
170
  end;
 
171
end;
 
172
 
 
173
procedure TForm1.StringGrid1ButtonClick(Sender: TObject; aCol, aRow: integer);
 
174
begin
 
175
  //For these columns there is no manual entry into the cell,
 
176
  //so use ButtonClick event
 
177
 
 
178
  if (aCol = 2) and ColorDialog1.Execute then //Button
 
179
  begin
 
180
    ayMyInput[aRow - 1].Button := Colordialog1.Color; //store cell colour in array
 
181
    StringGrid1.Invalidate; //Could also use 'Repaint' te force DrawCell event
 
182
  end;
 
183
 
 
184
  if (aCol = 3) then  //ButtonColumn
 
185
  begin
 
186
    StringGrid1.Options := StringGrid1.Options - [goEditing];
 
187
    //Prevent write to previous cell
 
188
    ayMyInput[aRow - 1].ButtonColumn := IntToStr(aCol) + ',' + IntToStr(aRow);
 
189
    //store as string
 
190
    StringGrid1.Cells[aCol, aRow] := ayMyInput[aRow - 1].ButtonColumn;
 
191
    StringGrid1.Options := StringGrid1.Options + [goEditing]; //Turn cell editing back on
 
192
  end;
 
193
 
 
194
  if (aCol = 5) and CalculatorDialog1.Execute then //Ellipsis
 
195
  begin
 
196
    // Click 'tick' sign on calculator to get result
 
197
    ayMyInput[aRow - 1].Ellipsis := FloattoStr(Calculatordialog1.Value);
 
198
    //Store as string
 
199
    StringGrid1.Cells[aCol, aRow] := ayMyInput[aRow - 1].Ellipsis;
 
200
  end;
 
201
end;
 
202
 
 
203
procedure TForm1.StringGrid1CheckboxToggled(Sender: TObject;
 
204
  aCol, aRow: integer; aState: TCheckboxState);
 
205
begin
 
206
  if (ARow > 0) and (ACol = 4) then
 
207
    ayMyInput[ARow - 1].CheckBox := aState;
 
208
end;
 
209
 
 
210
procedure TForm1.StringGrid1GetCheckboxState(Sender: TObject;
 
211
  ACol, ARow: integer; var Value: TCheckboxState);
 
212
begin
 
213
  if (ARow > 0) and (ACol = 4) then
 
214
    Value := ayMyInput[ARow - 1].CheckBox;
 
215
end;
 
216
 
 
217
procedure TForm1.Edit1Change(Sender: TObject);
 
218
var
 
219
  I: integer;
 
220
begin
 
221
  for I := 1 to StringGrid1.RowCount - 1 do  //'None' can only be changed in program
 
222
  begin
 
223
    ayMyInput[I - 1].None := Edit1.Text;
 
224
    StringGrid1.Cells[6, I] := ayMyInput[I - 1].None;
 
225
  end;
 
226
end;
 
227
 
 
228
procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: integer;
 
229
  aRect: TRect; aState: TGridDrawState);
 
230
begin
 
231
  //Note in Col 2 'Button' the Repaint event takes place before the focus changes
 
232
  //to another cell.
 
233
 
 
234
  if (aRow > 0) then         //Use DrawCell to paint rectangle
 
235
    if (ACol = 2) then
 
236
    begin                    //Get colour from array
 
237
      stringgrid1.canvas.Brush.Color := ayMyInput[aRow - 1].Button;
 
238
      stringgrid1.canvas.FillRect(aRect);   //Paint Cell
 
239
    end;
 
240
end;
 
241
 
 
242
procedure TForm1.StringGrid1GetCellHint(Sender: TObject; ACol, ARow: integer;
 
243
  var HintText: string);
 
244
begin
 
245
  case ACol of
 
246
    0: HintText := 'Button style cbsAuto sting grid column' +
 
247
        sLineBreak + ' - enter any text.';
 
248
    1: HintText := 'Button style cbsAuto, with basic Editmask for Time format.' +
 
249
        sLineBreak + 'Uses ValidateEntry as cell is exited to enforce  max of ''23:59:59''';
 
250
    2: HintText := 'Button style cbsButton that shows colour dialog' +
 
251
        sLineBreak + ' and changes cell colour.';
 
252
    3: HintText := 'Button style cbsButtonColumn that shows cell position.';
 
253
    4: HintText := 'Button style cbsCheckbox that toggles ''check'' mark.';
 
254
    5: HintText := 'Button style cbsEllipsis that opens calculator.' +
 
255
        sLineBreak + 'Click ''tick'' on calculator to send value to cell.';
 
256
    6: HintText := 'Button style cbsNone that cannot be changed manually.' +
 
257
        sLineBreak + 'Change Edit box contents to change displayed text.';
 
258
    7: HintText := 'Button style cbsPicklist that offers a choice from' +
 
259
        sLineBreak + 'a list set in the Object Inspector.';
 
260
  end;
 
261
end;
 
262
 
 
263
initialization
 
264
  {$I main.lrs}
 
265
 
 
266
end.