StringGrid

[Rafael Luiz M. França]

Hi all, how can i put the arrow like in MS Outlook...

I ha ve a String Grid, and i want when i click the title (Head Click), order
the columm, and wanna put that down arrow...

Regards
Rafael

[DC Lawrence]

Check out TStringGrid.OnDrawCell in the online help.

Rafael Luiz M. França wrote in message <83qa9q$4m...@forums.borland.com>...

[Peter Below (TeamB)]

> Hi all, how can i put the arrow like in MS Outlook...
> I ha ve a String Grid, and i want when i click the title (Head Click), order
> the columm, and wanna put that down arrow...
>

Rafael,

here is an example of a stringgrid sortable by a click on a header cell. It
displays a sort marker on the cell, using characters from the Marlett font.
You can use another, of course, if you find the look a bit bland.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, StdCtrls;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Label1: TLabel;
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
{ Private declarations }
FDownCell: TGridCoord;
procedure HeaderClicked( grid: TStringgrid; const cell: TGridCoord);
procedure SortGrid(grid: TStringgrid; byColumn: Integer;
ascending: Boolean);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
TGridCracker = Class( TStringgrid );
// provides access to protected methods of TStringgrid, like InvalidateCell

procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
If (Button = mbLeft) and (Shift = [ssLeft]) Then
(Sender As TStringgrid).MouseToCell( X, Y, FDownCell.X, FDownCell.Y )
Else
With FDownCell Do Begin
X:= 0;
Y:= 0;
End;
end;

procedure TForm1.SortGrid( grid: TStringgrid; byColumn: Integer; ascending:
Boolean );
Procedure ExchangeGridRows( i, j: Integer );
Var
k: Integer;
Begin
With Grid Do
For k:= 0 To ColCount-1 Do
Cols[k].Exchange(i,j);
End;
procedure QuickSort(L, R: Integer);
var
I, J: Integer;
P: String;
begin
repeat
I := L;
J := R;
P := Grid.Cells[byColumn, (L + R) shr 1];
repeat
while CompareStr(Grid.Cells[byColumn, I], P) < 0 do Inc(I);
while CompareStr(Grid.Cells[byColumn, J], P) > 0 do Dec(J);
if I <= J then
begin
If I <> J Then
ExchangeGridRows( I, J );
Inc(I);
Dec(J);
end;
until I > J;
if L < J then QuickSort(L, J);
L := I;
until I >= R;
end;
Procedure InvertGrid;
Var
i, j: Integer;
Begin
i:= Grid.Fixedrows;
j:= Grid.Rowcount-1;
While i < j Do Begin
ExchangeGridRows( I, J );
Inc( i );
Dec( j );
End; { While }
End;
Begin
Screen.Cursor := crHourglass;
Grid.Perform( WM_SETREDRAW, 0, 0 );
try
QuickSort( Grid.FixedRows, Grid.Rowcount-1 );
If not ascending Then
InvertGrid;
finally
Grid.Perform( WM_SETREDRAW, 1, 0 );
Grid.Refresh;
Screen.Cursor := crDefault;
end;
End;

procedure TForm1.HeaderClicked( grid: TStringgrid; const cell: TGridCoord );
var
i: Integer;
begin
// The header cell stores a flag in the Objects property that signals the
// current sort order of the grid column. A value of 0 shows no sort marker,
// 1 means sorted ascending, -1 sorted descending

// clear markers
For i:= grid.FixedCols to grid.ColCount-1 Do
If Assigned( grid.Objects[ i, 0 ] ) and (i <> cell.x) Then Begin
grid.Objects[i ,0]:= Nil;
TGridCracker( grid ).InvalidateCell( i, 0 );
End;

// Sort grid on new column. If grid is currently sorted ascending on this
// column we invert the sort direction, otherwise we sort it ascending.
If Integer( grid.Objects[cell.x,cell.y] ) = 1 Then Begin
SortGrid( grid, cell.x, false );
grid.Objects[cell.x, 0]:= Pointer(-1);
End
Else Begin
SortGrid( grid, cell.x, true );
grid.Objects[cell.x, 0]:= Pointer(1);
End;
TGridCracker( grid ).InvalidateCell( cell.x, cell.y );
end;

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
p: TGridCoord;
grid: TStringgrid;
begin
grid := Sender As TStringgrid;
If (Button = mbLeft) and (Shift = []) Then Begin
grid.MouseToCell( X, Y, p.X, p.Y );
If CompareMem(@p, @FDownCell, sizeof(p))
and (p.Y < grid.FixedRows)
and (p.X >= grid.FixedCols)
Then
HeaderClicked( grid, p );
End;
With FDownCell Do Begin
X:= 0;
Y:= 0;
End;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
grid: TStringgrid;
marker: Char;
begin
grid:= Sender As TStringgrid;

// paint the sort marker on header columns
If (ACol >= grid.FixedCols) and (aRow = 0) Then
If Assigned( grid.Objects[ aCol, aRow ] ) Then Begin
If Integer( grid.Objects[ aCol, aRow ] ) > 0 Then
marker := 't' // up wedge in Marlett font
Else
marker := 'u'; // down wedge in Marlett font

with grid.canvas do begin
font.Name := 'Marlett';
font.Charset := SYMBOL_CHARSET;
font.Size := 12;
textout( Rect.Right - TextWidth(marker),
Rect.Top + 2,
marker );
font := grid.font;
end;

End;
end;

end.

Peter Below (TeamB) 10011...@compuserve.com)
No e-mail responses, please, unless explicitly requested!