How To Toggle The cell Colour And Text In A TStringGrid On And Off - lazarus

I am running Lazarus v0.9.30 (32 bit compiler).
I have a TForm with a standard TStringGrid on it. The grid has the following properties set. RowCount = 5, ColumnCount = 5, FixedCols = 0, FixedRows = 0.
I Googled some code that showed me how to change the cell colour and add some text to the cell when a user clicks on a TStringGrid cell. All works fine and I have extended it slightly to toggle the color/text on and off on the GridClick event.
The questions I have are more to better understand the purpose behind some of the elements of the code.
There is an array of Foregroud (FG) and Background (BG) TColor objects. Are they there to store the cell color attributes that are set on the GridClick event, so if the DrawCell event needs to get triggered again for any reason the cell can redraw itself? Can you avoid using the array of TColors and just set the colour / text in the DrawCell event as required?
If you need to use the arrays, I would assume that dimensions must match the Grid.ColCount and Grid.RowCount (ie. set via the SetLength call in Form.Create)
Is there a way to detect that you are clicking outside of the 5 x 5 cells of the stringgrid (ie in the whitespace) and thus prevent the GridClick from calling the DrawCell event. No matter where you click you always get a valid value for Row and Col.
unit testunit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Menus, ComCtrls, Buttons, Grids, StdCtrls, Windows, Variants,
LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
Grid: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure GridClick(Sender: TObject);
procedure GridDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
end;
var
Form1: TForm1;
implementation
var
FG: array of array of TColor;
BG: array of array of TColor;
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
Col, Row: integer;
begin
// Set the sizes of the arrays
SetLength(FG, 5, 5);
SetLength(BG, 5, 5);
// Initialize with default colors
for Col := 0 to Grid.ColCount - 1 do begin
for Row := 0 to Grid.RowCount - 1 do begin
FG[Col, Row] := clBlack;
BG[Col, Row] := clWhite;
end;
end;
end;
procedure TForm1.GridDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
var
S: string;
begin
S := Grid.Cells[ACol, ARow];
// Fill rectangle with colour
Grid.Canvas.Brush.Color := BG[ACol, ARow];
Grid.Canvas.FillRect(aRect);
// Next, draw the text in the rectangle
Grid.Canvas.Font.Color := FG[ACol, ARow];
Grid.Canvas.TextOut(aRect.Left + 22, aRect.Top + 2, S);
end;
procedure TForm1.GridClick(Sender: TObject);
var
Col, Row: integer;
begin
Col := Grid.Col;
Row := Grid.Row;
// Set the cell color and text to be displayed
if (Grid.Cells[Col,Row] <> 'Yes') then
begin
BG[Col, Row] := rgb(131, 245, 44);
FG[Col, Row] := RGB(0, 0, 0);
Grid.Cells[Col, Row] := 'Yes'
end {if}
else
begin
BG[Col, Row] := rgb(255, 255, 255);
FG[Col, Row] := RGB(255, 255, 255);
Grid.Cells[Col, Row] := '';
end; {else}
end;
end.

If you set the AllowOutboundEvents to False, the OnClick event will be fired only when you click on a certain cell, not when you click on a whitespace. So if you use this property, you will always get valid cell coordinates when you click somewhere.
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.AllowOutboundEvents := False;
...
end;
Another point is that you should use the OnPrepareCanvas event instead of OnDrawCell, because in OnDrawCell you would have to paint everything, including text rendering. With OnPrepareCanvas you just set the Brush.Color and Font.Color for each cell which is going to be rendered.
And, you don't need to use arrays, you can use the Objects like you did with your columns, but surely you can keep the colors in the arrays. In the following example I've used the Objects and there's also shown the usage of the OnPrepareCanvas event, but note that this example as well as yours from the question colorize all cells including the fixed ones:
type
TCellData = class(TObject)
private
FStateYes: Boolean;
FForeground: TColor;
FBackground: TColor;
public
property StateYes: Boolean read FStateYes write FStateYes;
property Foreground: TColor read FForeground write FForeground;
property Background: TColor read FBackground write FBackground;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Col, Row: Integer;
CellData: TCellData;
begin
for Col := 0 to StringGrid1.ColCount - 1 do
for Row := 0 to StringGrid1.RowCount - 1 do
begin
CellData := TCellData.Create;
CellData.StateYes := False;
CellData.Foreground := clBlack;
CellData.Background := clWhite;
StringGrid1.Objects[Col, Row] := CellData;
end;
StringGrid1.AllowOutboundEvents := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
Col, Row: Integer;
begin
for Col := 0 to StringGrid1.ColCount - 1 do
for Row := 0 to StringGrid1.RowCount - 1 do
StringGrid1.Objects[Col, Row].Free;
end;
procedure TForm1.StringGrid1Click(Sender: TObject);
var
Col, Row: Integer;
CellData: TCellData;
begin
Col := StringGrid1.Col;
Row := StringGrid1.Row;
if StringGrid1.Objects[Col, Row] is TCellData then
begin
CellData := TCellData(StringGrid1.Objects[Col, Row]);
if CellData.StateYes then
begin
StringGrid1.Cells[Col, Row] := '';
CellData.StateYes := False;
CellData.Foreground := RGB(255, 255, 255);
CellData.Background := RGB(255, 255, 255);
end
else
begin
StringGrid1.Cells[Col, Row] := 'Yes';
CellData.StateYes := True;
CellData.Foreground := RGB(0, 0, 0);
CellData.Background := RGB(131, 245, 44);
end;
end;
end;
procedure TForm1.StringGrid1PrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
var
CellData: TCellData;
begin
if StringGrid1.Objects[ACol, ARow] is TCellData then
begin
CellData := TCellData(StringGrid1.Objects[ACol, ARow]);
StringGrid1.Canvas.Brush.Color := CellData.Background;
StringGrid1.Canvas.Font.Color := CellData.Foreground;
end;
end;

Related

FMX, TGrid, OnCellClick

On my fmx-form I have TGrid with column of type TCheckColumn. To capture click events on cells of grid I connect the OnCellClick handler to it.
My Question is: how to reliably trigger the OnCellClick event when clicking the left mouse button (LMB) for an arbitrary line, if:
LMB clicks occur on the same cell in the TCheckColumn;
LMB clicks are not accompanied by mouse cursor displacement.
For a better explanation of the essence of the issue, I will give a picture (see below). LMB is pressed on it in the same cell without cursor offsets. Events arising in this situation are logged in the CodeSite window (on the right). As you can see from the picture: the cell in the TCheckColumn column changes its state (the checkmark appears or disappears), but the OnCellClick event occurs only 1 time.
The picture itself
TGrid with OnCellClick event handler:
unit uMain;
interface
uses
System.SysUtils,
System.Types,
System.UITypes,
System.Classes,
System.Variants,
System.Rtti,
//
FMX.Types,
FMX.Controls,
FMX.Forms,
FMX.Graphics,
FMX.Dialogs,
FMX.Grid.Style,
FMX.Grid,
FMX.Controls.Presentation,
FMX.ScrollBox,
FMX.StdCtrls,
FMX.ImgList;
//
type
//for grid row
TRow = record
ID:integer;
Checked:boolean;
end;
//Test form
TForm1 = class(TForm)
grd: TGrid;
CheckColumn2: TCheckColumn;
Label2: TLabel;
IntegerColumn1: TIntegerColumn;
procedure FormCreate(Sender: TObject);
procedure grdGetValue(Sender: TObject; const ACol, ARow: Integer; var Value: TValue);
procedure grdSetValue(Sender: TObject; const ACol, ARow: Integer; const Value: TValue);
procedure grdCellClick(const Column: TColumn; const Row: Integer);
private
FRowsA: array of TRow;
FSelectedRow: integer;
//
procedure PopulateGrid;
//
end;
//for cols of grid
TMyCols = (mcID, mcChecked);
var
Form1: TForm1;
implementation
{$R *.fmx}
//FormCreate
procedure TForm1.FormCreate(Sender: TObject);
begin
PopulateGrid;
end;
{$REGION 'TGrid'}
//PopulateGrid
procedure TForm1.PopulateGrid;
const
rows = 10;//rows count
begin
Grd.RowCount := rows ;
SetLength(FRowsA, rows);
for var r := 0 to rows-1 do
begin
//
FRowsA[r].ID := r; //id
FRowsA[r].Checked := false ; //check
end;
end;
//grdCellClick
procedure TForm1.grdCellClick(const Column: TColumn; const Row: Integer);
var
selRow, cnt: integer;
begin
var ci := Column.Index ;
FSelectedRow := Row;
cnt := grd.RowCount ;
//checked col
if ci = Ord(TMyCols.mcChecked) then
begin
//
grd.RowCount := 0;
grd.RowCount := cnt;
grd.SelectRow(FSelectedRow);
//
FRowsA[Row].Checked := not FRowsA[Row].Checked;
//
Log.d( Format('CellClick raised: row=%d; col=%d', [Row, ci]) );
end;
end;
//grdSetValue
procedure TForm1.grdSetValue(Sender: TObject; const ACol, ARow: Integer; const Value: TValue);
var
oldVal, newVal: boolean;
begin
var g := Sender as TGrid;
if not Assigned(g) then Exit;
if (ARow < 0) or (ARow >= g.RowCount) then Exit;
//
//col num
case ACol of
//id col
Ord(TMyCols.mcID):
begin
FRowsA[ARow].Checked := Value.AsBoolean;//id
end;
//checked col
Ord(TMyCols.mcChecked):
begin
oldVal := FRowsA[ARow].Checked;
Value.TryAsType<boolean>(newVal);
FRowsA[ARow].Checked := newVal;//checked
Log.d( Format('OnSetValue raised: row=%d; col=%d; oldValue=%s; newValue=%s', [ARow, ACol, oldVal.ToString(), newVal.ToString()]) );
end;
//
end;
//
end;
//grdGetValue
procedure TForm1.grdGetValue(Sender: TObject; const ACol, ARow: Integer; var Value: TValue);
var
val: boolean;
begin
var g := Sender as TGrid;
if not Assigned(g) then Exit;
if (ARow < 0) or (ARow >= g.RowCount) then Exit;
case ACol of
//id
Ord(TMyCols.mcID) :
begin
Value := FRowsA[ARow].ID;
end;
//checked
Ord(TMyCols.mcChecked):
begin
Value := FRowsA[ARow].Checked;
end;
end;
Log.d( Format('OnGetValue raised: row=%d; col=%d', [ARow, ACol]) );
//
end;
{$ENDREGION}
//
end.

How to display list text with other controls on same line?

As an exercise for myself, I'm trying to recreate the To-Do app from the (fascinating) todomvc.com web site. The UI looks like this:
A user writes a To-Do item in an Edit box control (above the crossed out "buy milk") and presses Enter. To-Do items appear below.
As you can see, each line includes a stylized radio control, the text, and a button with an image (red x). The button appears when a user hovers the cursor inside the line.
I don't care about the button, having an image, or appearing only upon OnEnter. I can't figure out how to make a similarly styled (ListView? ComboBox?) control with a radio control and button.
I'm using Delphi VCL, but could switch to FMX.
There really isn't any shortcut here: you simply need to write quite a lot of code. The Windows OS doesn't provide anything like this. I would implement from scratch using an empty window with custom GDI painting and mouse and keyboard input processing. It's not difficult at all, but it does require quite a lot of code.
That was a lot of words and no code.
As a remedy, here is a very quick demonstration control based on Direct2D (because I realised I really do need anti aliasing):
unit ItemListBox;
interface
uses
Windows, SysUtils, Types, UITypes, Classes, Controls, Graphics, Generics.Defaults,
Generics.Collections, Forms, Messages, Direct2D, D2D1;
type
TItem = class
strict private
FCaption: TCaption;
FChecked: Boolean;
FTag: NativeInt;
FOnChanged: TNotifyEvent;
procedure Changed;
procedure SetCaption(const Value: TCaption);
procedure SetChecked(const Value: Boolean);
public
property Caption: TCaption read FCaption write SetCaption;
property Checked: Boolean read FChecked write SetChecked;
property Tag: NativeInt read FTag write FTag;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;
TPart = (ilbpText, ilbpCheckBox, ilbpClearButton);
TItemListBox = class(TCustomControl)
strict private
FItems: TObjectList<TItem>;
FItemHeight: Integer;
FCanvas: TDirect2DCanvas;
FIndex: Integer;
FPart: TPart;
FMouseDownIndex: Integer;
FMouseDownPart: TPart;
FFocusIndex: Integer;
function GetItem(Index: Integer): TItem;
function GetItemCount: Integer;
procedure ItemChanged(Sender: TObject);
procedure DrawItem(Index: Integer; Item: TItem);
procedure DrawCheckBox(Index: Integer; Item: TItem; Hot: Boolean = False);
procedure DrawClearButton(Index: Integer; Visible: Boolean; Hot: Boolean = False);
function ItemRect(Index: Integer): TRect;
function TextRect(Index: Integer): TRect;
function CheckBoxRect(Index: Integer): TRect;
function ClearButtonRect(Index: Integer): TRect;
procedure CreateDeviceResources;
procedure HitTest(const P: TPoint; out Index: Integer; out Part: TPart);
procedure StateChange(ANewIndex: Integer; ANewPart: TPart);
function CanvasWidth: Integer;
function CanvasHeight: Integer;
protected
procedure Paint; override;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure CreateWnd; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TDirect2DCanvas read FCanvas;
function AddItem(const ACaption: string; AChecked: Boolean;
ATag: NativeInt = 0): Integer;
procedure RemoveItem(AIndex: Integer);
property Items[Index: Integer]: TItem read GetItem;
property ItemCount: Integer read GetItemCount;
published
property Align;
property AlignWithMargins;
property Anchors;
property Cursor;
property Font;
property Hint;
property PopupMenu;
property TabOrder;
property TabStop default True;
end;
procedure Register;
implementation
uses
Math;
procedure Register;
begin
RegisterComponents('Rejbrand 2020', [TItemListBox]);
end;
function Scale(X: Integer): Integer;
begin
Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;
{ TItem }
procedure TItem.Changed;
begin
if Assigned(FOnChanged) then
FOnChanged(Self);
end;
procedure TItem.SetCaption(const Value: TCaption);
begin
if FCaption <> Value then
begin
FCaption := Value;
Changed;
end;
end;
procedure TItem.SetChecked(const Value: Boolean);
begin
if FChecked <> Value then
begin
FChecked := Value;
Changed;
end;
end;
{ TItemListBox }
function TItemListBox.AddItem(const ACaption: string; AChecked: Boolean;
ATag: NativeInt): Integer;
var
Item: TItem;
begin
Item := TItem.Create;
Item.Caption := ACaption;
Item.Checked := AChecked;
Item.OnChanged := ItemChanged;
Result := FItems.Add(Item);
InvalidateRect(Handle, ItemRect(Result), True);
end;
function TItemListBox.ClearButtonRect(Index: Integer): TRect;
begin
Result := Rect(CanvasWidth - 32, Index * FItemHeight, CanvasWidth,
(Index + 1) * FItemHeight);
end;
procedure TItemListBox.CMMouseLeave(var Message: TMessage);
begin
inherited;
StateChange(-1, ilbpText);
end;
constructor TItemListBox.Create(AOwner: TComponent);
begin
inherited;
FItems := TObjectList<TItem>.Create;
FItemHeight := 32;
FIndex := -1;
FMouseDownIndex := -1;
FFocusIndex := -1;
Color := clWindow;
TabStop := True;
end;
procedure TItemListBox.CreateDeviceResources;
begin
FreeAndNil(FCanvas);
FCanvas := TDirect2DCanvas.Create(Handle);
end;
procedure TItemListBox.CreateWnd;
begin
inherited;
CreateDeviceResources;
end;
destructor TItemListBox.Destroy;
begin
FreeAndNil(FItems);
FreeAndNil(FCanvas);
inherited;
end;
procedure TItemListBox.DrawClearButton(Index: Integer; Visible: Boolean; Hot: Boolean);
var
R: TRect;
begin
if not Visible then
Exit;
R := ClearButtonRect(Index);
InflateRect(R, -7, -7);
Canvas.Pen.Color := IfThen(Hot, clRed, clMaroon);
Canvas.Pen.Width := 2;
Canvas.MoveTo(R.Left, R.Top);
Canvas.LineTo(R.Right, R.Bottom);
Canvas.MoveTo(R.Right, R.Top);
Canvas.LineTo(R.Left, R.Bottom);
end;
procedure TItemListBox.DrawItem(Index: Integer; Item: TItem);
var
R: TRect;
S: string;
begin
// Background
Canvas.Brush.Color := clWindow;
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Color := clWindowText;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
R := ItemRect(Index);
Canvas.FillRect(R);
// Text
R := TextRect(Index);
S := Item.Caption;
Canvas.Font.Assign(Font);
Canvas.Font.Color := IfThen(Item.Checked, clGrayText, clWindowText);
if Item.Checked then
Canvas.Font.Style := [fsStrikeOut]
else
Canvas.Font.Style := [];
Canvas.TextRect(R, S, [tfSingleLine, tfEndEllipsis, tfVerticalCenter]);
// Check box
DrawCheckBox(Index, Item, (FIndex = Index) and (FPart = ilbpCheckBox));
// Clear button
DrawClearButton(Index, FIndex = Index, (FIndex = Index) and (FPart = ilbpClearButton));
// Focus indicator
if InRange(FFocusIndex, 0, FItems.Count - 1) and Focused then
begin
Canvas.Pen.Color := clSilver;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsClear;
R := TextRect(FFocusIndex);
InflateRect(R, 0, -2);
Canvas.Rectangle(R);
end;
end;
procedure TItemListBox.DrawCheckBox(Index: Integer; Item: TItem;
Hot: Boolean);
var
R: TRect;
begin
R := CheckBoxRect(Index);
InflateRect(R, -5, -5);
Canvas.Pen.Color := clSilver;
Canvas.Pen.Width := 1;
Canvas.Brush.Color := IfThen(Hot, clSilver, clWhite);
Canvas.Ellipse(R);
if Assigned(Item) and Item.Checked then
begin
Canvas.Pen.Color := clGreen;
Canvas.Pen.Width := 2;
Canvas.MoveTo(R.Left + R.Width div 5, R.Bottom - R.Height div 2);
Canvas.LineTo(R.Left + Round(R.Width / 2.5), R.Bottom - Round(R.Height / 3.8));
Canvas.LineTo(R.Right - Round(R.Width / 4.5), R.Top + R.Height div 5);
end;
end;
function TItemListBox.GetItem(Index: Integer): TItem;
begin
Result := FItems[Index];
end;
function TItemListBox.GetItemCount: Integer;
begin
Result := FItems.Count;
end;
procedure TItemListBox.HitTest(const P: TPoint; out Index: Integer;
out Part: TPart);
var
i: Integer;
Q: TPoint;
begin
Q.X := MulDiv(P.X, 96, Screen.PixelsPerInch);
Q.Y := MulDiv(P.Y, 96, Screen.PixelsPerInch);
for i := 0 to FItems.Count - 1 do
if ItemRect(i).Contains(Q) then
begin
Index := i;
if CheckBoxRect(i).Contains(Q) then
Part := ilbpCheckBox
else if ClearButtonRect(i).Contains(Q) then
Part := ilbpClearButton
else
Part := ilbpText;
Exit;
end;
Index := -1;
Part := ilbpText;
end;
procedure TItemListBox.ItemChanged(Sender: TObject);
begin
Invalidate;
end;
function TItemListBox.ItemRect(Index: Integer): TRect;
begin
Result := Rect(0, Index * FItemHeight, CanvasWidth, (Index + 1) * FItemHeight);
end;
procedure TItemListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
case Key of
VK_DOWN:
if Succ(FFocusIndex) <= FItems.Count - 1 then
begin
Inc(FFocusIndex);
Invalidate;
end;
VK_UP:
if Pred(FFocusIndex) >= 0 then
begin
Dec(FFocusIndex);
Invalidate;
end;
VK_HOME:
if FFocusIndex <> 0 then
begin
FFocusIndex := 0;
Invalidate;
end;
VK_END:
if FFocusIndex <> FItems.Count - 1 then
begin
FFocusIndex := FItems.Count - 1;
Invalidate;
end;
VK_SPACE:
if InRange(FFocusIndex, 0, FItems.Count - 1) then
FItems[FFocusIndex].Checked := not FItems[FFocusIndex].Checked;
VK_DELETE:
if InRange(FFocusIndex, 0, FItems.Count - 1) then
RemoveItem(FFocusIndex);
end;
end;
procedure TItemListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
if CanFocus then
SetFocus;
HitTest(Point(X, Y), FMouseDownIndex, FMouseDownPart);
if FFocusIndex <> FMouseDownIndex then
begin
FFocusIndex := FMouseDownIndex;
Invalidate;
end;
end;
procedure TItemListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
var
NewIndex: Integer;
NewPart: TPart;
begin
inherited;
HitTest(Point(X, Y), NewIndex, NewPart);
StateChange(NewIndex, NewPart);
end;
procedure TItemListBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
Index: Integer;
Part: TPart;
begin
HitTest(Point(X, Y), Index, Part);
if (Index <> -1) and (Index = FMouseDownIndex) and (Button = mbLeft) then
begin
if (Part = ilbpCheckBox) and (Part = FMouseDownPart) then
FItems[Index].Checked := not FItems[Index].Checked
else if (Part = ilbpClearButton) and (Part = FMouseDownPart) then
RemoveItem(Index);
end;
end;
procedure TItemListBox.Paint;
var
i: Integer;
begin
Canvas.RenderTarget.Clear(D2D1ColorF(clWhite));
for i := 0 to FItems.Count - 1 do
DrawItem(i, FItems[i]);
end;
procedure TItemListBox.RemoveItem(AIndex: Integer);
begin
FItems.Delete(AIndex);
FFocusIndex := EnsureRange(FFocusIndex, 0, FItems.Count - 1);
Invalidate;
end;
procedure TItemListBox.StateChange(ANewIndex: Integer; ANewPart: TPart);
var
OldIndex: Integer;
OldPart: TPart;
begin
OldIndex := FIndex;
OldPart := FPart;
FIndex := ANewIndex;
FPart := ANewPart;
if FIndex = OldIndex then
begin
if FPart <> OldPart then
begin
if ilbpCheckBox in [FPart, OldPart] then
InvalidateRect(Handle, CheckBoxRect(FIndex), True);
if ilbpClearButton in [FPart, OldPart] then
InvalidateRect(Handle, ClearButtonRect(FIndex), True);
end;
end
else
begin
InvalidateRect(Handle, ItemRect(OldIndex), True);
InvalidateRect(Handle, ItemRect(FIndex), True);
end;
end;
function TItemListBox.CanvasHeight: Integer;
begin
Result := MulDiv(ClientHeight, 96, Screen.PixelsPerInch);
end;
function TItemListBox.CanvasWidth: Integer;
begin
Result := MulDiv(ClientWidth, 96, Screen.PixelsPerInch);
end;
function TItemListBox.CheckBoxRect(Index: Integer): TRect;
begin
Result := Rect(0, Index * FItemHeight, 32, (Index + 1) * FItemHeight);
end;
function TItemListBox.TextRect(Index: Integer): TRect;
begin
Result := Rect(40, Index * FItemHeight, CanvasWidth - 40,
(Index + 1) * FItemHeight);
end;
procedure TItemListBox.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TItemListBox.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
inherited;
Message.Result := Message.Result or DLGC_WANTARROWS;
end;
procedure TItemListBox.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
Invalidate;
end;
procedure TItemListBox.WMPaint(var Message: TWMPaint);
var
PaintStruct: TPaintStruct;
res: HRESULT;
begin
BeginPaint(Handle, PaintStruct);
try
if Assigned(FCanvas) then
begin
FCanvas.BeginDraw;
try
Paint;
finally
res := FCanvas.RenderTarget.EndDraw;
if res = D2DERR_RECREATE_TARGET then
CreateDeviceResources;
end;
end;
finally
EndPaint(Handle, PaintStruct);
end;
end;
procedure TItemListBox.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
Invalidate;
end;
procedure TItemListBox.WMSize(var Message: TWMSize);
var
S: TD2DSizeU;
begin
if Assigned(FCanvas) then
begin
S := D2D1SizeU(ClientWidth, ClientHeight);
ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(S);
end;
Invalidate;
inherited;
end;
end.
Example (with a simple TEdit at the top):
But please notice that this is not a finished control; it's merely a very primitive sketch or prototype. It is not fully tested. In addition, a real control would have scrolling support and a keyboard interface. Since it is very late in Sweden right now, I don't really have time to add that at the moment.
Update: I added high-DPI support and a keyboard interface (up, down, home, end, space, delete):

TObjectList re-order

I need to re-order a TObjectList, according to some rules. How can I achieve this?
So I add panels to a ScrollBox dinamically.
When I add them, I also add them to the ObjectList in the order that they are added at runtime, for future use. Then I can re-organize the panels in the scrollBox by drag/drop.
I want the ObjectList to mirror the same order that is set at runtime by drag/drop.
Here is my code:
var
MainForm: TMainForm;
PanelList,PanelListTMP:TObjectList;
implementation
...
procedure TMainForm.FormCreate(Sender: TObject);
begin
PanelList:=TObjectList.Create;
PanelListTMP:=TObjectList.Create;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
AddPanel('0');
AddPanel('1');
AddPanel('2');
AddPanel('3');
AddPanel('4');
end;
procedure TMainForm.Addpanel(what:string);
var
pan:TPanel;
bv:TShape;
begin
pan:=TPanel.Create(self);
pan.Parent:=TheContainer;
pan.Height:=50;
pan.BevelOuter:=bvNone;
pan.BorderStyle:=bsNone;
pan.Ctl3D:=false;
pan.Name:='LayerPan'+what;
pan.Caption:=what;
pan.Align:=alBottom;
pan.OnMouseDown:=panMouseDown;
end;
procedure TMainForm.panMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var
i:integer;
idu:String;
panui:TPanel;
begin
panui:=Sender as TPanel;
panui.ParentColor:=false;
panui.BringToFront;
// DRAG DROP STUFF
ReleaseCapture;
panui.Perform(wm_nclbuttondown,HTCAPTION,0);
for i := 0 to MainForm.ComponentCount - 1 do
begin
if MainForm.Components[i] is TWinControl then
if TWinControl(MainForm.Components[i]) is TPanel then
if (TWinControl(MainForm.Components[i]) as TPanel).Parent=MainForm.TheContainer then
begin
(TWinControl(MainForm.Components[i]) as TPanel).Align:=alBottom;
end;
end;
TheContainer.ScrollInView(panui);
ReOrderPanels;
end;
Procedure TMainForm.ReOrderPanels;
begin
end;
What should I do in the ReOrderPanels procedure?
I was thinking about feeding the panels of the ScrollBox from bottom to top into a new TObjectList (PanelListTMP), clear the PanelList and re-add them from the PanelListTMP, but when I do that, I get an error: Access Violation, and EInvalidPointer - Invalid Pointer Operation
So this is what I thought:
procedure TMainForm.ReOrderPanels;
var
ctrl:TControl;
pos:TPoint;
pan:TPanel;
bad:boolean;
ord,i:integer;
begin
memo2.Lines.Add('*** new order START');
panelListTMP.Clear;
// scroll top
TheContainer.VertScrollBar.Position := 0;
// scroll down
TheContainer.VertScrollBar.Position := TheContainer.VertScrollBar.Range;
// get panel
Pos:=TheContainer.ClientOrigin;
Pos.Y:=Pos.Y+TheContainer.Height-5;
ctrl := FindVCLWindow(pos) ;
if ctrl is TPanel then
if TPanel(ctrl).Parent = TheContainer then
begin
pan:=(ctrl as TPanel);
panelListTMP.Add(pan);
end;
ord:=1;
bad:=false;
repeat
repeat
Pos.Y:=pos.Y-1;
until (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos)<>pan);
if (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos).Name<>'LayerPan') then
begin
pan:=FindVCLWindow(pos) as TPanel;
containeru.VertScrollBar.Position := 0;
containeru.ScrollInView(pan);
ord:=ord+1;
panelListTMP.Add(pan);
end
else
bad:=true;
until bad=true;
// and now I do the swap between the ObjectLists...
panelList.Clear;
for i:=0 to PanelListTMP.Count-1 do
begin
(PanelListTMP.Items[i] as TPanel).Parent:=containeru;
panelList.Add(PanelListTMP.Items[i]);
end;
end;
So I assume that because the ObjectList is storing pointers to the actual objects, then when I clear the initial ObjectList, the actual objects are freed, so the second ObjectList contains a list of pointers that are no longer viable...
But then how can I achieve what I want?
So on ButtonClick, I get a ObjectList that contains panels in the following order:
PanelList[0] - Panel0
PanelList[1] - Panel1
PanelList[2] - Panel2
PanelList[3] - Panel3
PanelList[4] - Panel4
After I drag - drop panels inside the ScrollBox, I can end up with an order like this (in the ScrollBox)
Panel3
panel1
Panel4
Panel2
Panel0
But in the ObjectList, the order is the same as before...
Again, I want to be able to have the ObjectList ordered according to the order of the panels from the scrollBox.
In the re-order procedure I actually get all the panels in the desired order.
I just need to have them in the same order in my ObjectList.
Is there any other way of doing this? Other that with me creating a new class that would hold an index beside a TPanel and use that in the ObjectList to maintain the order?
TObjectList has an OwnsObjects property that is True by default. Make sure to set it to False since you don't want the list to auto-free the objects as they are owned by the Form.
As for the actual sorting of the TObjectList, consider using its Sort() or SortList() method for that. After you have repositioned the Panels as desired within their container, call Sort() or SortList(). The sorting callback you provide will be given two object pointers at a time while the sorting is iterating the list. Use the current positions of the objects relative to each other to tell the list what order they should appear in.
Try something like this:
var
MainForm: TMainForm;
PanelList: TObjectList;
implementation
...
procedure TMainForm.FormCreate(Sender: TObject);
begin
PanelList := TObjectList.Create(False);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
PanelList.Free;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
AddPanel('0');
AddPanel('1');
AddPanel('2');
AddPanel('3');
AddPanel('4');
end;
procedure TMainForm.Addpanel(what: string);
var
pan: TPanel;
bv: TShape;
begin
pan := TPanel.Create(Self);
try
pan.Parent := TheContainer;
pan.Height := 50;
pan.BevelOuter := bvNone;
pan.BorderStyle := bsNone;
pan.Ctl3D := false;
pan.Name := 'LayerPan'+what;
pan.Caption := what;
pan.Align := alBottom;
pan.OnMouseDown := panMouseDown;
PanelList.Add(pan);
except
pan.Free;
raise;
end;
end;
procedure TMainForm.panMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: integer;
idu: String;
panui, pan: TPanel;
tmpList: TObjectList;
begin
panui := Sender as TPanel;
panui.ParentColor := false;
panui.BringToFront;
// DRAG DROP STUFF
ReleaseCapture;
panui.Perform(WM_NCLBUTTONDOWN, HTCAPTION, 0);
tmpList := TObjectList.Create(False);
try
for i := 0 to TheContainer.ControlCount - 1 do
begin
if TheContainer.Controls[i] is TPanel then
tmpList.Add(TPanel(TheContainer.Controls[i]));
end;
for i := 0 to tmpList.Count - 1 do
TPanel(tmpList[i]).Align := alBottom;
finally
tmpList.Free;
end;
TheContainer.ScrollInView(panui);
ReOrderPanels;
end;
function SortPanels(Item1, Item2: Pointer): Integer;
begin
Result := TPanel(Item2).Top - TPanel(Item1).Top;
end;
procedure TMainForm.ReOrderPanels;
begin
PanelList.Sort(SortPanels);
// Alternatively:
{
PanelList.SortList(
function(Item1, Item2: Pointer): Integer;
begin
Result := TPanel(Item2).Top - TPanel(Item1).Top;
end
);
}
end;
I think I found my answer using a temporary ObjectList and Extract(Object)
My code that seems to work is:
procedure TMainForm.ReOrderPanels;
var
ctrl:TControl;
pos:TPoint;
pan,panx:TPanel;
bad:boolean;
ord,i:integer;
begin
panelListTMP.Clear;
panelList.OwnsObjects:=false;
// scroll top
TheContainer.VertScrollBar.Position := 0;
// scroll down
TheContainer.VertScrollBar.Position := TheContainer.VertScrollBar.Range;
// get panel
Pos:=TheContainer.ClientOrigin;
Pos.Y:=Pos.Y+TheContainer.Height-5;
ctrl := FindVCLWindow(pos) ;
if ctrl is TPanel then
if TPanel(ctrl).Parent = TheContainer then
begin
pan:=(ctrl as TPanel);
panelListTMP.Add(PanelList.Extract(pan) as TPanel);
end;
ord:=1;
bad:=false;
repeat
repeat
Pos.Y:=pos.Y-1;
until (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos)<>pan);
if (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos).Name<>'LayerPan') then
begin
pan:=FindVCLWindow(pos) as TPanel;
TheContainer.VertScrollBar.Position := 0;
TheContainer.ScrollInView(pan);
ord:=ord+1;
panelListTMP.Add(PanelList.Extract(pan) as TPanel);
end
else
bad:=true;
until bad=true;
panelList.Clear;
panelListTMP.OwnsObjects:=false;
i:=0;
while (PanelListTMP.Count<>0) do
panelList.Add(PanelListTMP.Extract(PanelListTMP.Items[i]) as TPanel);
panelList.OwnsObjects:=true;
panelListTmp.Clear;
end;

How to create a pan from composite image in Delphi

I'm kind of new to delphi graphics methods and I'm stucked at creating a ... viewport , thats how I call it while i was doing it for a project. I'm sorry I can't provide any code for it but I'm stuck at the logic part , searching google pointed me to some OnPaint , Draw methods. But those are not what I'm trying to accomplish, since I have , for example:
A 1600x1000 background image anchored to the client's top/bottom/right and left.
Multiple TImage elements placed at set x/y coords.
A "hotspot" like a map element in HTML where I can set the clickable areas (for the images i'm placing at step 2)
No zoom needed.
And the most important thing, while the background is dragged, those TImages placed on top of the background need to be dragged too.
My logic (in HTML/jQuery) was to create a #viewportBinder (which was the div i was dragging, transparent bg), followed by another div inside it called #viewtown (1600x1000, the background) which contains the divs (those TImages) placed at set coordinates in CSS.
So when I am dragging the viewportBinder, jQuery sets the new x/y on the #viewport. Implicitly, the divs (TImages) inside the #viewport are moving because the parent was positioned relative.
Does anybody have any experience with this kind of project ? Any snippet of code ?
To be more specific i'll give you my html example of what i accomplised and what i want to port into Delphi code: http://www.youtube.com/watch?v=9iYqzvZFnGA
Sorry if i'm not clear enough, i have no starting point since I have no experience with this in delphi at all. (using RAD Studio 2010)
A very short example how it could be realized in an easy way.
You would use a Paintbox for painting, 1 Backimage, an array of Records with info and transparent pngimages.
Canvas can be manipulated in offset/zoom/rotation.
Moving and hitdetection would happen in mousedown and mousemove.
It's not complete, but might give you an idea how it could be done.
[delphi]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls,PNGImage, StdCtrls;
type
TBuilding=Record // record for building informations
Pos:TPoint;
PNGImage:TPngImage;
// what ever needed
End;
TBuildingArray=Array of TBuilding; // array of buildings
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
FXoffs,FYOffs,FZoom:Double; // offset and zoom for painting
FMouseDownPoint:TPoint;
FBackGroundPNG:TPNGImage;
FBuildingArray:TBuildingArray;
procedure Check4Hit(X, Y: Integer);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
uses Math;
{$R *.dfm}
Procedure SetCanvasZoomAndRotation(ACanvas:TCanvas;Zoom:Double;Angle:Double;CenterpointX,CenterpointY:Double);
var
form : tagXFORM;
Winkel:Double;
begin
Winkel := DegToRad(Angle);
SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
SetMapMode(ACanvas.Handle,MM_ANISOTROPIC);
form.eM11 := Zoom * cos( Winkel);
form.eM12 := Zoom *Sin( Winkel) ;
form.eM21 := Zoom * (-sin( Winkel));
form.eM22 := Zoom * cos( Winkel) ;
form.eDx := CenterpointX;
form.eDy := CenterpointY;
SetWorldTransform(ACanvas.Handle,form);
end;
Procedure ResetCanvas(ACanvas:TCanvas);
begin
SetCanvasZoomAndRotation(ACanvas , 1, 0, 0,0);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Path:String;
i:Integer;
begin
FZoom := 1;
DoubleBuffered := true;
Path := ExtractFilePath(Paramstr(0));
FBackGroundPNG:=TPNGImage.Create;
FBackGroundPNG.LoadFromFile(Path + 'infect.png');
SetLength(FBuildingArray,3);
for I := 0 to High(FBuildingArray) do
begin
FBuildingArray[i].PNGImage := TPngImage.Create;
FBuildingArray[i].PNGImage.LoadFromFile(Path + Format('B%d.png',[i]));
FBuildingArray[i].Pos.X := I * 300;
FBuildingArray[i].Pos.Y := Random(1000);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
i:Integer;
begin
for I := 0 to High(FBuildingArray) do
begin
FBuildingArray[i].PNGImage.Free;
end;
FBackGroundPNG.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FZoom=0.5 then FZoom := 1 else FZoom := 0.5;
PaintBox1.Invalidate;
end;
procedure TForm1.Check4Hit(X,Y:Integer);
var
i,Index:Integer;
R:TRect;
P:TPoint;
begin
index := -1;
for I := 0 to High(FBuildingArray) do
begin
R := Rect(FBuildingArray[i].Pos.X,FBuildingArray[i].Pos.Y
,FBuildingArray[i].Pos.X + FBuildingArray[i].PNGImage.Width
,FBuildingArray[i].Pos.Y + FBuildingArray[i].PNGImage.Height);
P := Point(Round((x - FXOffs)/FZoom) ,Round((y - FYOffs)/FZoom));
if PtInRect(R,P) then Index := i;
end;
if index > -1 then
begin
Caption := Format('Last hit %d',[index]);
end
else Caption := 'No Hit';
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Check4Hit(X,Y);
FMouseDownPoint.X := X;
FMouseDownPoint.Y := Y;
end;
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then
begin
FXoffs := -( FMouseDownPoint.X - X) ;
FYoffs := -( FMouseDownPoint.Y - Y) ;
if FXoffs>0 then FXoffs := 0;
if FYoffs>0 then FYoffs := 0;
PaintBox1.Invalidate;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
i:Integer;
begin
SetCanvasZoomAndRotation(PaintBox1.Canvas,FZoom,0,FXoffs,FYOffs);
PaintBox1.Canvas.Draw(0,0,FBackGroundPNG);
for I := 0 to High(FBuildingArray) do
begin
PaintBox1.Canvas.Draw(FBuildingArray[i].Pos.X,FBuildingArray[i].Pos.Y,FBuildingArray[i].PNGImage);
end;
end;
end.
[/delphi]
Sorry, but for last several years i working with Lazarus instead of Delphi. But tis article will be informative: http://wiki.lazarus.freepascal.org/Developing_with_Graphics#Create_a_custom_control_which_draws_itself
About relative coordinates nothing to say - it is simple.
About dragging: A long time ago in a galaxy far, far away.. that was something like:
// To start dragging
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
// To stop dragging
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
// To perform dragging
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;

How can you change the text orientation in cells in the fixed rows in a Delphi TStringGrid

I have a standard TStringGrid on a form.
I have one Fixed Row in the grid that contains a number of columns, which are all TGridColumns objects. I have set the column titles using the object inspector and the default orientation is horizontal. Is there any way you can make the orientation vertical (like you can in cells in Excel)?
Here's how to render the first row's text vertically in Lazarus:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
StdCtrls;
type
TStringGrid = class(Grids.TStringGrid)
protected
procedure DrawCellText(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState; AText: String); override;
end;
type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure TStringGrid.DrawCellText(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState; AText: String);
var
TextPosition: TPoint;
begin
if ARow = 0 then
begin
Canvas.Font.Orientation := 900;
TextPosition.X := ARect.Left +
((ARect.Right - ARect.Left - Canvas.TextHeight(AText)) div 2);
TextPosition.Y := ARect.Bottom -
((ARect.Bottom - ARect.Top - Canvas.TextWidth(AText)) div 2);
Canvas.TextOut(TextPosition.X, TextPosition.Y, AText);
end
else
inherited DrawCellText(ACol, ARow, ARect, AState, AText);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
GridColumn: TGridColumn;
begin
for I := 0 to 4 do
begin
GridColumn := StringGrid1.Columns.Add;
GridColumn.Width := 24;
GridColumn.Title.Font.Orientation := 900;
GridColumn.Title.Layout := tlBottom;
GridColumn.Title.Caption := 'Column no. ' + IntToStr(I);
end;
StringGrid1.RowHeights[0] := 80;
end;
end.
Here's how to render the first row's text of the TStringGrid vertically in Delphi:
I would prefer to use the overriden DrawCell procedure because it seems to me as the easiest way to go because if you want to render the text simply in the OnDrawCell event then you should consider:
if you'll have the DefaultDrawing set to True then the text will already be rendered when the OnDrawCell event is fired, so here I would recommend e.g. to store the cell captions in a separate variable, not into Cells property so then no text will be rendered and you can draw your own stored captions vertically
if you'll have the DefaultDrawing set to False then you'll have to draw the whole cell by your own, including the 3D border, what is IMHO not so cool, and I would personally prefer to let the control draw the background for us
Here is the Delphi code which uses the overriden DrawCell procedure. The text is being centered inside of the cell rectangle; please note that I haven't used the DrawTextEx for text size measurement because this function doesn't take the changed font orientation into account.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids;
type
TStringGrid = class(Grids.TStringGrid)
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
end;
type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState);
var
LogFont: TLogFont;
TextPosition: TPoint;
NewFontHandle: HFONT;
OldFontHandle: HFONT;
begin
if ARow = 0 then
begin
GetObject(Canvas.Font.Handle, SizeOf(LogFont), #LogFont);
LogFont.lfEscapement := 900;
LogFont.lfOrientation := LogFont.lfEscapement;
NewFontHandle := CreateFontIndirect(LogFont);
OldFontHandle := SelectObject(Canvas.Handle, NewFontHandle);
TextPosition.X := ARect.Left +
((ARect.Right - ARect.Left - Canvas.TextHeight(Cells[ACol, ARow])) div 2);
TextPosition.Y := ARect.Bottom -
((ARect.Bottom - ARect.Top - Canvas.TextWidth(Cells[ACol, ARow])) div 2);
Canvas.TextRect(ARect, TextPosition.X, TextPosition.Y, Cells[ACol, ARow]);
NewFontHandle := SelectObject(Canvas.Handle, OldFontHandle);
DeleteObject(NewFontHandle);
end
else
inherited DrawCell(ACol, ARow, ARect, AState);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to StringGrid1.ColCount - 1 do
begin
StringGrid1.ColWidths[I] := 24;
StringGrid1.Cells[I, 0] := 'Column no. ' + IntToStr(I);
end;
StringGrid1.RowHeights[0] := 80;
end;
end.
And here's how it looks like:

Resources