lazarus/examples/gridexamples/title_images/main.pas
ondrej aee454aa3c Merged revision(s) 54872 #f9266d01ea,54874 #dbe072e701,54875 #b8d6c0d8dc,54877 #cd4add856f,54878 #5377b0e786,54881 #c5cf593797,54812 #e3f7770451,54813 #ede8a86d9d,54815 #118cfb3d98,54816 #43e271b439,54817 #76e4dccfaa,54840 #553d56948a,54841 #5fc40612bc,54842 #2abbee1637,54843 #dcdcafb794,54844 #92cf9781fa,54882 #3ba0ca06c3,54883 #bff91a4961 from trunk:
- r54872 #f9266d01ea lhelp: Fix lhelp to show popup hints. Issue #31732.
- r54874 #dbe072e701 Menu designer: Call GlobalDesignHook.Modified after adding an item. Issue #31791.
- r54875 #b8d6c0d8dc gridexamples: in title_image_demo show images at start, adapt height of header row to image layout) (http://forum.lazarus.freepascal.org/index.php/topic,36841.0.html)
- r54877 #cd4add856f Examples: Minor improvements of sample project motiongraphics (http://forum.lazarus.freepascal.org/index.php/topic,36858.msg245986.html)
- r54878 #5377b0e786 Examples: Improved usability of demo "openurltest".
- r54881 #c5cf593797 Examples: Fix crash of demo "propstorage" (http://forum.lazarus.freepascal.org/index.php/topic,36862.msg246019/topicseen.html).
- r54812 #e3f7770451 lcl: grids: disable VisualChange and UpdateSizes if AutoSize is disabled. Solves part of Issue #31715
- r54813 #ede8a86d9d lcl: support for DebugDisableAutoSizing compiler define
- r54815 #118cfb3d98 lcl: wincontrol: ignore FBoundsRealized in WM_SIZE. Solves part of Issue #31715
- r54816 #43e271b439 lcl: grids: Hi-DPI: row heights and column width. New default (system) value is -1. Solves part of Issue #31715
- r54817 #76e4dccfaa lcl: grids: ignore WMSIZE when updating scrollbars. Solves part of Issue #31715
- r54840 lcl: grids: fix scrolling after r54816 #43e271b439, Issue #31715
- r54841 #5fc40612bc lcl: grids: scroll to highest possible value if col/row are out of valid bounds. Related to Issue #31766
- r54842 lcl: dbgrids: adapt after r54816 #43e271b439. Issue #31765 and #31715
- r54843 ide: packager: adapt after r54816 #43e271b439. Issue #31762 and #31715
- r54844 #92cf9781fa lcl: grids: make GetDefaultRowHeight and *ColWidth public. Issue #31762 and #31715
- r54882 #3ba0ca06c3 lcl: grids: make default value for DefRowHeight and DefColWidth 0 and not -1 (due to LCL consistency). Issue #31715
- r54883 #bff91a4961 lcl: grids: rename GetRealDefaultColWidth and GetRealDefaultRowHeight to GetRealDef* (LCL consistency). Issue #31715

git-svn-id: branches/fixes_1_8@54884 -
2017-05-12 20:01:43 +00:00

101 lines
2.3 KiB
ObjectPascal

unit main;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Forms, Controls, Grids, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
ImageList1: TImageList;
RadioGroup1: TRadioGroup;
StringGrid1: TStringGrid;
procedure RadioGroup1Click(Sender: TObject);
procedure StringGrid1HeaderClick(
Sender: TObject; IsColumn: Boolean;Index: Integer);
private
procedure AdjustTitleHeight;
procedure Refresh;
public
end;
var
Form1: TForm1;
implementation
{$R main.lfm}
uses
Buttons;
{ TForm1 }
procedure TForm1.AdjustTitleHeight;
begin
if RadioGroup1.ItemIndex < 2 then
StringGrid1.RowHeights[0] := StringGrid1.DefaultRowHeight
else
StringGrid1.RowHeights[0] := StringGrid1.RowHeights[1] + ImageList1.Height;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
var
i: Integer;
begin
for i := 0 to StringGrid1.Columns.Count - 1 do begin
if RadioGroup1.ItemIndex>1 then
StringGrid1.RowHeights[0] := 2*StringGrid1.DefaultRowHeight
else
StringGrid1.RowHeights[0] := StringGrid1.DefaultRowHeight;
StringGrid1.Columns[i].Title.ImageLayout :=
TButtonLayout(RadioGroup1.ItemIndex);
end;
AdjustTitleHeight;
end;
procedure TForm1.Refresh;
var
i, j: Integer;
t: String;
begin
with StringGrid1 do
for i := 1 to RowCount - 2 do
for j := i + 1 to RowCount - 1 do begin
if
(Columns[0].Title.ImageIndex = 1) and (Cells[1, i] > Cells[1, j]) or
(Columns[0].Title.ImageIndex = 2) and (Cells[1, i] < Cells[1, j]) or
(Columns[1].Title.ImageIndex = 1) and (StrToInt(Cells[2, i]) > StrToInt(Cells[2, j])) or
(Columns[1].Title.ImageIndex = 2) and (StrToInt(Cells[2, i]) < StrToInt(Cells[2, j]))
then begin
t := Cells[1, i]; Cells[1, i] := Cells[1, j]; Cells[1, j] := t;
t := Cells[2, i]; Cells[2, i] := Cells[2, j]; Cells[2, j] := t;
end;
end;
end;
procedure TForm1.StringGrid1HeaderClick(
Sender: TObject; IsColumn: Boolean; Index: Integer);
begin
if not IsColumn then exit;
with StringGrid1.Columns[Index - 1].Title do begin
if ImageIndex = 2 then
ImageIndex := 0
else
ImageIndex := ImageIndex + 1;
if ImageIndex > 0 then
StringGrid1.Columns[2 - Index].Title.ImageIndex := 0;
end;
AdjustTitleHeight;
Refresh;
end;
end.