I am using delphi 2010 for a project with a stringgrid. I want some columns of the grid to be right justified. I understand how I can do this with defaultdrawing set to false.
I would like, however, to keep the runtime theme shading for the grid, if possible. Is there a way to right justify a column with defaultdrawing enabled, or at least duplicate the code in the onDrawCell event to imitate the runtime theme shading?
you can use an interposer class and override the DrawCell method, check this sample
type
TStringGrid = class(Grids.TStringGrid)
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
end;
TForm79 = class(TForm)
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
private
end;
var
Form79: TForm79;
implementation
{$R *.dfm}
{ TStringGrid }
procedure TStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
var
s : string;
LDelta : integer;
begin
if (ACol=1) and (ARow>0) then
begin
s := Cells[ACol, ARow];
LDelta := ColWidths[ACol] - Canvas.TextWidth(s);
Canvas.TextRect(ARect, ARect.Left+LDelta, ARect.Top+2, s);
end
else
Canvas.TextRect(ARect, ARect.Left+2, ARect.Top+2, Cells[ACol, ARow]);
end;
procedure TForm79.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0,0]:='title 1';
StringGrid1.Cells[1,0]:='title 2';
StringGrid1.Cells[2,0]:='title 3';
StringGrid1.Cells[0,1]:='normal text';
StringGrid1.Cells[1,1]:='right text';
StringGrid1.Cells[2,1]:='normal text';
end;
And the result
Related
I want to know on an overriding of DrawColumnCell if the grid is drawing its active row.
I thought of keeping an ActiveRecno private variable to check if the DrawColumnCell is drawing that row. I tried intercepting the DataChange of the Datasource to keep track of that ActiveRecno.
TMyDBGrid = class(TDBGrid)
protected
OnDataChange_Original: TDataChangeEvent;
procedure TrackPosition(Sender: TObject; Field: TField);
procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
public
ActiveRecno: integer;
constructor Create(AOwner: TComponent): override;
...
...
implementation
constructor TMyDBGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnDataChange_Original := nil;
if Assigned(DataSource) then begin
OnDataChange_Original := Datasource.OnDataChange;
Datasource.OnDataChange := TrackPosition;
end;
end;
procedure TMyDBGrid.TrackPosition(Sender: TObject; Field: TField);
begin
ActiveRecno := Datasource.DataSet.RecNo;
if Assigned(OnDataChange_Original) then OnDataChange_Original(Sender, Field);
end;
procedure TMyDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var ActiveRow: boolean;
begin
ActiveRow := (Self.ActiveRecno = Self.DataSource.Dataset.Recno);
...
...
inherited DrawColumnCell(Rect, DataCol, Column, State);
end;
But ActiveRecno remains always 0, making ActiveRow always False. That's because in the constructor Datasource is still nil, so I never set TrackPosition to keep the ActiveRecno.
Where can I set my handler for that event ?, the SetDataSource procedure is private, so I can't override it.
Do you recommend me another way to keep track of the active row, or detect in DrawColumnCell if the row to draw is the active row ?.
Thank you.
I think that what you want would be straightforward except for the fact that neither the current row
of the DBGrid nor the row being drawn in the OnDrawrDataCell event is readily accessible inside the event.
Fortunately, it is fairly straightforward to overcome these problems using an interposer TDBGrid class as shown below.
THe interposer TDBGrid class simply exposes the Row property of TCustomGrid as the ActiveRow
The OnDrawDataCell event is called from TCustomDBGrid.DrawCell, which is virtual and so can be overridden
in the interposer class. As you can see below, the overridden version first copies the row number (the ARow argument) used
in TCustomDBGrid.DrawCell into the FRowBeingDrawn field and then calls the inherited DrawDataCell, which in turn calls the OnDrawDataCell handler. Since this handler
sees the interposer class, both the grid's ActiveRow and RowBeingDrawn are accessible inside the
OnDrawDataCell event.
type
TDBGrid = class(DBGrids.TDBGrid)
private ,
FRowBeingDrawn : Integer;
function GetActiveRow: Integer;
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
property RowBeingDrawn : Integer read FRowBeingDrawn write FRowBeingDrawn;
property ActiveRow : Integer read GetActiveRow;
end;
TForm1 = class(TForm)
DBGrid1: TDBGrid;
ClientDataSet1: TClientDataSet;
DataSource1: TDataSource;
ComboBox1: TComboBox;
DBNavigator1: TDBNavigator;
procedure FormCreate(Sender: TObject);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
end;
[...]
procedure TForm1.FormCreate(Sender: TObject);
var
AField : TField;
begin
AField := TIntegerField.Create(Self);
AField.FieldKind := fkData;
AField.FieldName := 'ID';
AField.DataSet := ClientDataSet1;
AField := TStringField.Create(Self);
AField.FieldKind := fkData;
AField.FieldName := 'AValue';
AField.DataSet := ClientDataSet1;
ClientDataSet1.CreateDataSet;
ClientDataSet1.InsertRecord([1, 'One']);
ClientDataSet1.InsertRecord([2, 'Two']);
ClientDataSet1.InsertRecord([3, 'Three']);
ClientDataSet1.InsertRecord([4, 'Four']);
ClientDataSet1.InsertRecord([5, 'Five']);
DBGrid1.DefaultDrawing := True;
end;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if (Sender as TDBGrid).RowBeingDrawn = (Sender as TDBGrid).Row then
Caption := IntToStr((Sender as TDBGrid).RowBeingDrawn);
DBGrid1.DefaultDrawDataCell(Rect, Column.Field, State);
end;
procedure TDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
begin
RowBeingDrawn := ARow;
try
inherited;
finally
RowBeingDrawn := -1;
end;
end;
function TDBGrid.GetActiveRow: Integer;
begin
Result := Row;
end;
end.
The interposer class can, of course, be contained in a separate unit provided, of course, that it appears in the using unit's Uses list after DBGrids.
One minor point to beware of is that the code above does not take account of whether the title row of the grid is visble or not, and make require minor tweaking if it is not.
I'm using LMD Innovative library in my inherited Delphi project, and in particular the TLMDGrid component.
I just want to set last row color (summary) different from the rest of the table.
I can set different colors for different columns in the designer, but (due to poor documentation) cannot find how to set color for a single row.
Thanks for help.
I don't use the LMD grids myself, so the following is based on their most recent trial download.
I wasn't sure whether you were asking about the TLMDGrid or the TLMDDbGrid so the
minimal demo below shows how to set the last row of both of them to a specific color. As you'll
see, it is just a question of setting up an OnGetCellColor event handler for each grid, and then
setting the value of the AColor variable by whatever criteria suit you.
The onGetCellColor event is passed the current column as well as the
row number of the grid cell which is about to be drawn, so this show give
you the possibility of coloring cells in the same row differently if you want.
I confess I'm not very happy with basing the test on the OnGetCellColor event of LMDDBGrid1
on the dataset's RecordCount, because not all dataset types return a meaningful value
(and for some, there can be big performance hit in getting its value. With a standard TDBGrid,
in its drawing events, you can rely on the dataset cursor being synced with the event calls (so that
any data values can be picked up from the current dataset row). I'm not sure yet about how
you would do that with the LMD grid - obviously the best place to ask about that would be LMD themselves.
Code:
unit LMDGridTestu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DB, DBClient, Grids, LMDGrid, LMDDBGrid;
type
TForm1 = class(TForm)
CDS1: TClientDataSet;
DataSource1: TDataSource;
CDS1ID: TIntegerField;
CDS1Name: TStringField;
LMDDBGrid1: TLMDDBGrid;
LMDGridIntegerColumn1: TLMDGridIntegerColumn;
LMDGridTextColumn1: TLMDGridTextColumn;
LMDGrid1: TLMDGrid;
NameCol: TLMDGridTextColumn;
IDCol: TLMDGridIntegerColumn;
procedure FormCreate(Sender: TObject);
procedure LMDDBGrid1GetCellColor(Sender: TObject; ACellState:
TLMDGridCellStates; ARowState: TLMDGridRowState; const AData: Variant;
AColumn: TLMDGridColumn; ARow: Integer; var AColor: TColor);
procedure LMDGrid1GetCellColor(Sender: TObject; ACellState: TLMDGridCellStates;
ARowState: TLMDGridRowState; const AData: Variant; AColumn: TLMDGridColumn;
ARow: Integer; var AColor: TColor);
public
end;
[...]
procedure TForm1.LMDDBGrid1GetCellColor(Sender: TObject; ACellState:
TLMDGridCellStates; ARowState: TLMDGridRowState; const AData: Variant;
AColumn: TLMDGridColumn; ARow: Integer; var AColor: TColor);
begin
if ARow = CDS1.Recordcount - 1 then
AColor := clYellow;
end;
procedure TForm1.LMDGrid1GetCellColor(Sender: TObject; ACellState:
TLMDGridCellStates; ARowState: TLMDGridRowState; const AData: Variant;
AColumn: TLMDGridColumn; ARow: Integer; var AColor: TColor);
begin
if ARow = LMDGrid1.DataRowCount - 1 then // Rows are numbered from zero
AColor := clYellow;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
begin
CDS1.CreateDataSet;
CDS1.IndexFieldNames := 'ID';
for i := 1 to 12 do
CDS1.InsertRecord([i, StringOfChar(Chr((ord('a') + i -1)), 20)]);
CDS1.First;
LMDGrid1.DataRowCount := 10;
for i := 0 to LMDGrid1.DataRowCount - 1 do begin
LMDGrid1.Cells[IDCol.Position, i] := IntToStr(i);
LMDGrid1.Cells[NameCol.Position, i] := 'Name' + IntToStr(i);
end;
end;
I need to add a button (maybe TSpeedButton?) on every item of ComboBox. When one clicks the button the corresponding item is deleted from the list. For example:
I've seen similar discussion on SpeedButtons in string grids (here: TStringGrid with SpeedButtons), but I don't know how to implement all those things on ComboBox. Could you please give me some advice or links for further reading on the topic.
Besides the user experience comments aside, to which I agree, a solution to the question isn't really that hard.
You can do this by setting the Style property to csOwnerDrawFixed, drawing the items yourself in the OnDrawItem event, and deleting the selected item in the OnSelect event for example, as follows:
unit Unit1;
interface
uses
Winapi.Windows, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls,
Vcl.Imaging.PNGIMage;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ComboBox1Select(Sender: TObject);
private
FDeleteGraphic: TPNGImage;
FDeleteRect: TRect;
end;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
ComboBox1.Canvas.FillRect(Rect);
if Index >= 0 then
ComboBox1.Canvas.TextOut(Rect.Left + 2, Rect.Top, ComboBox1.Items[Index]);
if (odSelected in State) and not (odComboBoxEdit in State) then
begin
FDeleteRect := Rect;
FDeleteRect.Left := FDeleteRect.Right - FDeleteGraphic.Width;
ComboBox1.Canvas.Draw(FDeleteRect.Left, FDeleteRect.Top, FDeleteGraphic);
end;
end;
procedure TForm1.ComboBox1Select(Sender: TObject);
var
MousePos: TPoint;
begin
MousePos := ComboBox1.ScreenToClient(Mouse.CursorPos);
MousePos.Offset(0, -ComboBox1.Height);
if PtInRect(FDeleteRect, MousePos) then
begin
ComboBox1.Items.Delete(ComboBox1.ItemIndex);
ComboBox1.Invalidate;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FDeleteGraphic := TPNGImage.Create;
FDeleteGraphic.LoadFromFile('H:\Icons\FamFam Common\Delete.png');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FDeleteGraphic.Free;
end;
end.
With this result:
You might want to (re)store the previous ItemIndex setting. Customize to your wishes.
I do custom drawing of a Delphi TStringGrid using the OnDrawCell event.
There is no problem with the area covered by cells, but how do I paint the background right of the rightmost column and below the last row ?
(Edit)
Painting is not really necessary, I just want to set the color used for background.
I am using XE2 and investigating VCL styles.
Even in default drawing, setting Colors in a stringgrid, seams to have no effect at all.
TIA
This is some code I found with google (It is not from me, I could not find the name of the author, maybe it comes from StackExchange on some way...). It defines a descendant from TStringGrid and implements a new background drawing. (The example uses a bitmap, but you easily can change that...)
type
TStringGrid = class(Grids.TStringGrid)
private
FGraphic: TGraphic;
FStretched: Boolean;
function BackgroundVisible(var ClipRect: TRect): Boolean;
procedure PaintBackground;
protected
procedure Paint; override;
procedure Resize; override;
procedure TopLeftChanged; override;
public
property BackgroundGraphic: TGraphic read FGraphic write FGraphic;
property BackgroundStretched: Boolean read FStretched write FStretched;
end;
TForm1 = class(TForm)
StringGrid: TStringGrid;
Image: TImage;
procedure FormCreate(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TStringGrid }
function TStringGrid.BackgroundVisible(var ClipRect: TRect): Boolean;
var
Info: TGridDrawInfo;
R: TRect;
begin
CalcDrawInfo(Info);
SetRect(ClipRect, 0, 0, Info.Horz.GridBoundary, Info.Vert.GridBoundary);
R := ClientRect;
Result := (ClipRect.Right < R.Right) or (ClipRect.Bottom < R.Bottom);
end;
procedure TStringGrid.Paint;
begin
inherited Paint;
PaintBackground;
end;
procedure TStringGrid.PaintBackground;
var
R: TRect;
begin
if (FGraphic <> nil) and BackgroundVisible(R) then
begin
with R do
ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
if FStretched then
Canvas.StretchDraw(ClientRect, FGraphic)
else
Canvas.Draw(0, 0, FGraphic);
end;
end;
procedure TStringGrid.Resize;
begin
inherited Resize;
PaintBackground;
end;
procedure TStringGrid.TopLeftChanged;
begin
inherited TopLeftChanged;
PaintBackground;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
// Usage:
StringGrid.BackgroundGraphic := Image.Picture.Graphic;
StringGrid.BackgroundStretched := True;
end;
In Delphi I show/hide controls during runtime and it does not look good as controls suddenly appear or disappear , so any one know a component that can do the show/hide (using visible property) but with some sort of animation ?
thanks
Give it a go with AnimateWindow. Only for WinControls, well, it doesn't look stunning anyway:
procedure TForm1.Button1Click(Sender: TObject);
begin
if Button2.Visible then
AnimateWindow(Button2.Handle, 250, AW_HIDE or AW_VER_NEGATIVE or AW_SLIDE)
else
AnimateWindow(Button2.Handle, 250, AW_VER_POSITIVE or AW_SLIDE);
Button2.Visible := not Button2.Visible; // synch with VCL
end;
edit: A threaded version to hide show multiple controls simultaneously:
type
TForm1 = class(TForm)
..
private
procedure AnimateControls(Show: Boolean; Controls: array of TWinControl);
procedure OnAnimateEnd(Sender: TObject);
public
end;
implementation
..
type
TAnimateThr = class(TThread)
protected
procedure Execute; override;
public
FHWnd: HWND;
FShow: Boolean;
constructor Create(Handle: HWND; Show: Boolean);
end;
{ TAnimateThr }
constructor TAnimateThr.Create(Handle: HWND; Show: Boolean);
begin
FHWnd := Handle;
FShow := Show;
FreeOnTerminate := True;
inherited Create(True);
end;
procedure TAnimateThr.Execute;
begin
if FShow then
AnimateWindow(FHWnd, 250, AW_VER_POSITIVE or AW_SLIDE)
else
AnimateWindow(FHWnd, 250, AW_HIDE or AW_VER_NEGATIVE or AW_SLIDE);
end;
{ Form1 }
procedure TForm1.OnAnimateEnd(Sender: TObject);
begin
FindControl(TAnimateThr(Sender).FHWnd).Visible := TAnimateThr(Sender).FShow;
end;
procedure TForm1.AnimateControls(Show: Boolean; Controls: array of TWinControl);
var
i: Integer;
begin
for i := Low(Controls) to High(Controls) do
with TAnimateThr.Create(Controls[i].Handle, Show) do begin
OnTerminate := OnAnimateEnd;
Resume;
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
AnimateControls(not Button1.Visible,
[Button1, Button2, Button3, Edit1, CheckBox1]);
end;