PageRenderTime 16ms CodeModel.GetById 13ms app.highlight 1ms RepoModel.GetById 1ms app.codeStats 0ms

/examples/gridexamples/title_images/main.pas

http://github.com/graemeg/lazarus
Pascal | 89 lines | 68 code | 17 blank | 4 comment | 7 complexity | fec4b1e481467e004c3522973e37d624 MD5 | raw file
 1unit main;
 2
 3{$mode objfpc}{$H+}
 4
 5interface
 6
 7uses
 8  SysUtils, Forms, Controls, Grids, ExtCtrls;
 9
10type
11
12  { TForm1 }
13
14  TForm1 = class(TForm)
15    ImageList1: TImageList;
16    RadioGroup1: TRadioGroup;
17    StringGrid1: TStringGrid;
18    procedure RadioGroup1Click(Sender: TObject);
19    procedure StringGrid1HeaderClick(
20      Sender: TObject; IsColumn: Boolean;Index: Integer);
21  private
22    procedure Refresh;
23  public
24
25  end; 
26
27var
28  Form1: TForm1; 
29
30implementation
31
32{$R main.lfm}
33
34uses
35  Buttons;
36
37{ TForm1 }
38
39procedure TForm1.RadioGroup1Click(Sender: TObject);
40var
41  i: Integer;
42begin
43  for i := 0 to StringGrid1.Columns.Count - 1 do begin
44    if RadioGroup1.ItemIndex>1 then
45      StringGrid1.RowHeights[0] := 2*StringGrid1.DefaultRowHeight
46    else
47      StringGrid1.RowHeights[0] := StringGrid1.DefaultRowHeight;
48    StringGrid1.Columns[i].Title.ImageLayout :=
49      TButtonLayout(RadioGroup1.ItemIndex);
50  end;
51end;
52
53procedure TForm1.Refresh;
54var
55  i, j: Integer;
56  t: String;
57begin
58  with StringGrid1 do
59    for i := 1 to RowCount - 2 do
60      for j := i + 1 to RowCount - 1 do begin
61        if
62          (Columns[0].Title.ImageIndex = 1) and (Cells[1, i] > Cells[1, j]) or
63          (Columns[0].Title.ImageIndex = 2) and (Cells[1, i] < Cells[1, j]) or
64          (Columns[1].Title.ImageIndex = 1) and (StrToInt(Cells[2, i]) > StrToInt(Cells[2, j])) or
65          (Columns[1].Title.ImageIndex = 2) and (StrToInt(Cells[2, i]) < StrToInt(Cells[2, j]))
66        then begin
67          t := Cells[1, i]; Cells[1, i] := Cells[1, j]; Cells[1, j] := t;
68          t := Cells[2, i]; Cells[2, i] := Cells[2, j]; Cells[2, j] := t;
69        end;
70      end;
71end;
72
73procedure TForm1.StringGrid1HeaderClick(
74  Sender: TObject; IsColumn: Boolean; Index: Integer);
75begin
76  if not IsColumn then exit;
77  with StringGrid1.Columns[Index - 1].Title do begin
78    if ImageIndex = 2 then
79      ImageIndex := 0
80    else
81      ImageIndex := ImageIndex + 1;
82    if ImageIndex > 0 then
83      StringGrid1.Columns[2 - Index].Title.ImageIndex := 0;
84  end;
85  Refresh;
86end;
87
88end.
89