I want to use a TStringGrid to create a Custom Calendar. I want to be
able to select date ranges in the calendar by clicking in the firstdate
and then moving the mouse to the end date. The problem is that the grid
only selects cell with in a TRect, so, it's excluding all the dates that
are in the range date but not in the TRect selection.
So, i was hopping to do my own selection procedure, but im clue less.
I tried writing my own DrawCell event handler, and tried to determinate
if the cell is with in my range date, but it's not working. I think the
Grid's DrawCells method it's drawing only the cells within the range,
so, the other cells are never drawn
procedure TfEmpleado.CalendarDrawCell(Sender: TObject; Col,
Row: Integer; Rect: TRect; State: TGridDrawState);
begin
if PointInSelection( Col, Row, Calendar.Selection ) then
Calendar.Canvas.Brush.Color := clActiveCaption {selected color}
else
Calendar.Canvas.Brush.Color := clWindow; {unselected color}
Calendar.Canvas.FillRect( Rect );
end;
function PointInSelection(Col, Row: Longint; const Rect: TGridRect):
Boolean;
begin
Result := False;
if ( Row >= Rect.Top ) and ( Row <= Rect.Bottom) then
begin
if (Col < Rect.Left) and (Row = Rect.Top) then
result := False
else if (Col > Rect.Right) and (Row = Rect.Bottom) then
Result := false
else
Result := True;
end;
end;
I would thank any ideas that some kind sould could provide me.
Here is a bunch of code that shows how to do a grid that can select cells
as the mouse moves above them. Note the goRowSelect and goRangeSelect are
both False for this grids Options.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
ComCtrls, ToolWin, StdCtrls, Grids;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure ToolButton2Click(Sender: TObject);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
FDownCell: TGridCoord;
procedure SelectCell( aGrid: TStringgrid; aCell: TGridCoord );
procedure ClearSelections(aGrid: TStringgrid);
function CellSelected( aGrid: TStringgrid; acol, arow: Integer ):
boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type TGridCracker= Class( TStringgrid );
procedure TForm1.ToolButton2Click(Sender: TObject);
begin
SHOWMESSAGE('Ouch');
end;
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Const
NoSelection : TGridRect = (Left:-1; Top:-1; Right:-1; Bottom:-1 );
var
cell: TGridCoord;
grid: TStringgrid;
begin
grid := Sender As TStringgrid;
// grid.Selection := NoSelection;
grid.MOusetoCell( X, Y, cell.X, cell.Y );
FDownCell := cell;
If not (ssCtrl In Shift) Then
ClearSelections( grid );
{ No shift-click range selection in this example }
SelectCell( grid, cell );
end;
procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
cell: TGridCoord;
grid: TStringgrid;
begin
If ssLeft In Shift Then Begin
{ left button is down }
grid := Sender As TStringgrid;
grid.MOusetoCell( X, Y, cell.X, cell.Y );
SelectCell( grid, cell );
End;
end;
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
cell: TGridCoord;
grid: TStringgrid;
// sel: TGridRect;
begin
grid := Sender As TStringgrid;
grid.MOusetoCell( X, Y, cell.X, cell.Y );
If (cell.x >= grid.FixedCols) and (cell.y >= grid.FixedRows) Then
If CompareMem( @cell, @FDownCell, Sizeof(cell)) Then
If (goEditing In grid.OPtions) and
(cell.x < grid.colcount) and (cell.y < grid.rowcount) Then Begin
grid.Col := cell.X;
grid.Row := cell.Y;
grid.EditorMode := True;
End;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
Var
grid: Tstringgrid;
begin
If not ( gdfixed In state ) Then Begin
grid:= Sender As TStringgrid;
If CellSelected( grid, aCol, aRow ) Then begin
grid.Canvas.brush.color := clBlue;
grid.Canvas.font.color := clYellow;
grid.Canvas.FillRect( Rect );
grid.Canvas.TextRect( Rect, rect.left+2, rect.top+2,
grid.cells[acol, arow]);
End;
End;
end;
function TForm1.CellSelected(aGrid: TStringgrid; acol,
arow: Integer): boolean;
begin
result := (acol >= aGrid.FixedCols) and (arow >= aGrid.FixedRows) and
(aGrid.Objects[ acol, arow ] <> Nil);
end;
procedure TForm1.ClearSelections(aGrid: TStringgrid);
var
i, k: Integer;
begin
for i:= aGrid.FixedCols to aGrid.ColCount - 1 do
for k:= aGrid.FixedRows to aGrid.RowCount -1 do
If (aGrid.Objects[ i, k ] <> Nil) Then Begin
aGrid.Objects[ i, k ] := Nil;
TGridCracker( aGrid ).InvalidateCell( i, k );
End;
end;
procedure TForm1.SelectCell(aGrid: TStringgrid; aCell: TGridCoord);
procedure SelectRow( aRow: Integer );
var
i: Integer;
begin
for i:= aGrid.FixedCols To aGrid.ColCount - 1 do
aGrid.Objects[ i, aRow] := Pointer(1);
TGridCracker( aGrid ).InvalidateRow( aRow );
end;
procedure SelectCol( aCol: Integer );
var
i: Integer;
begin
for i:= aGrid.FixedRows To aGrid.RowCount - 1 do
aGrid.Objects[ aCol, i] := Pointer(1);
TGridCracker( aGrid ).InvalidateCol( aCol );
end;
begin
If (aCell.X < 0) or (aCell.Y < 0) then Exit;
If aCell.X < aGrid.FixedRows Then
SelectRow( aCell.Y )
Else If aCell.Y < aGrid.FixedCols Then
SelectCol( aCell.X )
Else If (aCell.X < aGrid.ColCount) and (aCell.Y < aGrid.RowCount)Then
Begin
aGrid.Objects[ aCell.X, aCell.Y] := Pointer(1);
TGridCracker( aGrid ).InvalidateCell( aCell.X, aCell.Y );
End;
end;
end.
Peter Below (TeamB) 10011...@compuserve.com)
No e-mail responses, please, unless explicitly requested!