All is in the title.
How can we also make an officehint customisable for each row. Mean when mousemove on a row, display the information of this record (from a db query).
Thanks
You can color individual cells using the CellProperties property of the grid. You can use this to color an entire row:
var
RowIndex: Integer;
ColIndex: Integer;
with MyDBAdvGrid do
begin
// you choose the row index; you may want to iterate all rows to
// color each of them
RowIndex := 2;
// now iterate all (non-fixed, visible) cells in the row and color each cell
for ColIndex := FixedCols to ColCount - 1 do
begin
CellProperties[ColIndex, RowIndex].BrushColor := clYellow;
CellProperties[ColIndex, RowIndex].FontColor := clGreen;
end;
end;
To fill your office hint with record data I would suggest updating it when the user moves the mouse. Use the MouseToCell function to get row and column under the mouse, then use MyDBAdvGrid.AllCells[ColIndex, RowIndex] to access the cell content.
An Alternative to Heinrich answer is to use the OnGetCellColor event.
This can be use like so:
procedure TDBAdvGrid.DBGridGetCellColor(Sender: TObject; ARow,
ACol: Integer; AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
begin
if (your condition) then ABrush.Color := clRed;
end;
Similarly for the hint:
procedure TDBAdvGrid.DBGridGridHint(Sender: TObject; ARow, ACol: Integer;
var hintstr: String);
begin
hintstr := 'your hint text';
end;
Related
How can I customize my listview to display different background colors like in the picture below ?
My listview is bound to a datasource (Livebindng). I want to use the color field to set my backgroud color.
I've customized my view this way :
3 Text items (Designation,Date and Resume)
1 Bitmap item (Couleur)
Text items are bound to datasource but there is no way to bind my Bitmap to my "color" field.
I've filled the listview ActivesUpdateObjects event but this is not enough as bitmap is not changed when datasource record is updated!
procedure TfrmMain.lvTachesActivesUpdateObjects(const Sender: TObject;
const AItem: TListViewItem);
begin
SetItemColor(AItem);
end;
procedure TfrmMain.SetItemColor(const AItem: TListViewItem; const UpdateColor:
Boolean = False);
var
LObject: TListItemImage;
VC: TColor;
begin
LObject := AItem.Objects.FindObjectT<TListItemImage>('Couleur');
VC:= dtmMain.qrTaches.FieldByName('couleur').AsInteger;
if LObject.Bitmap = nil then
begin
LObject.Bitmap := FMX.Graphics.TBitmap.Create(10,240);
LObject.Bitmap.Clear(VC);
end else if UpdateColor then LObject.Bitmap.Clear(VC);
end;
Is there a better way to proceed? I was also looking to use style but it appears (or I didn't find) that itemlistview can apply styles!
Ps : Firemonkey / Windows / Delphi Berlin XE10.1
I'm using Delphi 7 so take this with a grain of salt.
You may have to write your own CustomDrawItem method on your TreeView to handle this stuff
This is mine (I edited out some code because it has some lengthy logic behind). Also, I don't draw icons so the DrawImage part is commented.
procedure TVentanaVisorComponentes.TreeView1CustomDrawItem(
Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
NodeRect: TRect;
EsSeleccion, EsDespejado: boolean;
begin
with TreeView1.Canvas do
begin
//If DefaultDraw it is true, any of the node's font properties can be
//changed. Note also that when DefaultDraw = True, Windows draws the
//buttons and ignores our font background colors, using instead the
//TreeView's Color property.
DefaultDraw := False;
//DefaultDraw = False means you have to handle all the item drawing yourself,
//including the buttons, lines, images, and text.
if not DefaultDraw then
begin
Brush.Color := clMenuHighLight;
Font.Color := clWhite;
NodeRect := Node.DisplayRect(True);
FillRect(NodeRect);
// ...
NodeRect := Node.DisplayRect(False);
// ...
FillRect(NodeRect);
NodeRect.Left := NodeRect.Left + (Node.Level * TreeView1.Indent);
//NodeRect.Left now represents the left-most portion of the expand button
DrawButton(NodeRect, Node);
NodeRect.Left := NodeRect.Left + TreeView1.Indent;
//NodeRect.Left is now the leftmost portion of the image.
//DrawImage(NodeRect, Node.ImageIndex);
// NodeRect.Left := NodeRect.Left + ImageList.Width;
//Now we are finally in a position to draw the text.
TextOut(NodeRect.Left, NodeRect.Top, (Node as TNodoArbolComponentes).Texto);
end;
end;
end;
How can I make all my grids look the same way all over my forms?
I want to implement an alternate row color that must be applied on all grids of my project. Is it possible without adding the same DrawColumnCell event code for every grid?
I want to avoid adding the same code for each of my grids. I have like 30 grids in my project and multiplied by 13 rows of code it just adds a lot of code lines to my project making it "unfriendly".
I am looking for a solution that will only add 13 lines of code to the project, not 390 lines.
My formatting code looks like this (for example):
procedure TDBGrid.DBGrid1DrawColumnCell(Sender: TObject;const Rect: TRect;DataCol: Integer;Column: TColumn;State: TGridDrawState) ;
var
grid : TDBGrid;
row : integer;
begin
grid := sender as TDBGrid;
row := grid.DataSource.DataSet.RecNo;
if Odd(row) then
grid.Canvas.Brush.Color := clSilver
else
grid.Canvas.Brush.Color := clDkGray;
grid.DefaultDrawColumnCell(Rect, DataCol, Column, State) ;
end;
Probably I would need to extend the DBGrid somehow, but I do not know exactly how nor how to look for a solution for this on google
I tried to hack the DBGRid inside each form like this:
type
TDBGrid = class(DBGrids.TDBGrid)
protected
procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;Column: TColumn; State: TGridDrawState); override;
end;
...
procedure TDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;Column: TColumn; State: TGridDrawState) ;
var
grid : TDBGrid;
row : integer;
begin
row := 2;//grid.DataSource.DataSet.RecNo;
if Odd(row) then
Canvas.Brush.Color := clSilver
else
Canvas.Brush.Color := clDkGray;
DefaultDrawColumnCell(Rect, DataCol, Column, State) ;
end;
I can do this but I cannot access the sender, so I can access the dataset and know which record to color and which not (odd and even).
And this is a poor approach anyways since I will have to do it on every form, so it's not really a solution
Any ideas?
Thank you
If you put something like this in your datamodule, and assign it to the OnDrawColumnCell of every DBGrid, it seems to work (see notes that follow):
procedure TDataModule1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
const
RowColors: array[Boolean] of TColor = (clSilver, clDkGray);
var
OddRow: Boolean;
begin
// Safety check, although it really isn't needed; no other control accepts
// this event handler definition, AFAIK, so the only way to call it with the
// wrong Sender type would be to do so in your own code manually. In my own
// code, I'd simply leave out the check and let the exception happen; if I
// was stupid enough to do so, I'd want my hand slapped rudely.
if (Sender is TDBGrid) then
begin
OddRow := Odd(TDBGrid(Sender).DataSource.DataSet.RecNo);
TDBGrid(Sender).Canvas.Brush.Color := RowColors[OddRow];
TDBGrid(Sender).DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
end;
A couple of notes:
First, you should avoid using TDataSet.RecNo in the first place, because post-BDE datasets don't typically have this value available. Accessing it (particularly on large or query-based datasets) causes a major performance hit to your application. Of course, not using it means that you can't use this solution. A better solution would be to use a handler for the dataset's BeforeScroll or AfterScroll event that toggled a boolean available to this code instead, and use that instead of the test for Odd(RecNo), or if the dataset is only used for displaying in the DBGrid, use the TDataSet.Tag in the AfterScroll event to track the row's odd/even state using
OddRow := Boolean(DataSet.Tag);
DataSet.Tag := Ord(not OddRow);
Add DBGrids to the uses clause of your datamodule, and manually declare the above event in the published section so that it's available to all units that use the datamodule. You can then assign it in the Object Inspector Events tab as usual from those units.
This does not properly handle the TGridDrawState (nor does your initial code). You'll need to add handling for that yourself, as that wasn't what you asked here.
Depending on which color you want for odd and even rows, you may want to reverse the order of the colors in RowColors.
I prefer the repeated typecasts so that it's clear what the code is doing. If it bothers you, you can simply declare a local variable instead:
var
OddRow: Boolean;
Grid: TDBGrid;
begin
if (Sender is TDBGrid) then
begin
Grid := TDBGrid(Sender);
OddRow := Odd(Grid.DataSource.DataSet.RecNo);
...
end;
end;
This works for Delphi XE7
type
TDBGrid=Class(Vcl.DBGrids.TDBGrid)
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
end;
procedure TDBGrid.WMVScroll(var Message: TWMVScroll);
begin
Self.Invalidate;
inherited;
end;
procedure TForm1. DBGrid1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
if Sender is TDBGrid then
(Sender as TDBGrid).Invalidate;
end;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
const
MyRowColors : array[Boolean] of TColor = (clLime, clMoneyGreen);
var
RowNo : Integer;
OddRow : Boolean;
S : string;
begin
if Sender is TDBGrid then begin
with (Sender as TDBGrid) do begin
if (gdSelected in State) then begin
// Farbe für die Zelle mit dem Focus
// color of the focused row
Canvas.Brush.Color := clblue;
end
else begin
// count := trunc((Sender as TDBGrid).Height div (Rect.Bottom - Rect.Top));
// RowNo := (Sender as TDBGrid).Height div Rect.Top;
RowNo := Rect.Top div (Rect.Bottom - Rect.Top);
OddRow := Odd(RowNo);
Canvas.Brush.Color := MyRowColors[OddRow];
// Font-Farbe immer schwarz
// font color always black
Canvas.Font.Color := clBlack;
Canvas.FillRect(Rect);
// Denn Text in der Zelle ausgeben
// manualy output the text
if Column.Field <> nil then begin
S := Column.Field.AsString;
Canvas.TextOut(Rect.Left + 2, Rect.Top + 1, S);
// Canvas.TextOut(Rect.Left + 2, Rect.Top + 1, 'Column.Field.AsString');
end;
end;
end
end;
end;
I've written some code which colours individual cells on my stringgrid, within my delphi application, according to a list of data.
I now need to write some code in the OnDblClick event on my stringgrid which deduces whether or not a cell is coloured and then proceeds according to the result found. For instance:
DOUBLE CLICK CELL
IS CELL COLOURED
YES > PROCEED A
NO > PROCEED B
Store the color at the time you draw it into the predefined TStringGrid.Objects property. When you need to retrieve it, you can get it back from the Column and Row coordinates. Here's a trivial example that stores either clWhite or clBlack in the Objects for the cell based on whether or not it's an odd-numbered column, and simply displays the stored value as a string when the cell is selected. It should get you started.
procedure TForm1.FormCreate(Sender: TObject);
var
r, c: Integer;
const
ColorSel: array[Boolean] of TColor = (clWhite, clBlack);
begin
StringGrid1.RowCount := 10;
StringGrid1.ColCount := 6;
for c := 1 to StringGrid1.ColCount - 1 do
for r := 1 to StringGrid1.RowCount - 1 do
begin
StringGrid1.Cells[c, r] := Format('C: %d R: %d', [c, r]);
StringGrid1.Objects[c, r] := TObject(ColorSel[Odd(c)]);
end;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
begin
ShowMessage(ColorToString(TColor(StringGrid1.Objects[ACol, ARow])));
end;
You can use this in the OnMouseUp event easily to detect what color is in the cell. Remove the StringGrid1SelectCell (using the Object Inspector, just remove the value for the event) and add this as the OnMouseUp event for the grid instead:
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Col, Row: Integer;
begin
StringGrid1.MouseToCell(X, Y, Col, Row);
if (Col > -1) and (Row > -1) then
ShowMessage(ColorToString(TColor(StringGrid1.Objects[Col, Row])));
end;
Handling the double-click then becomes pretty easy (thanks to #TLama for a big assist):
procedure TForm1.StringGrid1DblClick(Sender: TObject);
var
IsDefaultColor: Boolean;
CurrCellColor: TColor;
CurrCol, CurrRow: Integer;
begin
// Save typing by grabbing the currently selected cell col/row
CurrCol := StringGrid1.Col;
CurrRow := StringGrid1.Row;
// Get the stored color for the selected cell
CurrCellColor := TColor(StringGrid1.Objects[CurrCol, CurrRow]);
// See if it's been painted a different color than the default
IsDefaultColor := (CurrCellColor = StringGrid1.Color);
if not IsDefaultColor then
HandleDifferentColorCell
else
HandleNormalColorCell;
end;
Note that if you're choosing not to change the color for a cell, you should still assign the default color of the cell to the Objects[Column, Row] so that there's something meaningful there in order to avoid an improper conversion when retrieving the value.
I know that i can set custom colors to items when i add them to the list using OnDraw Events but i want to change colors of the items at a certain point after they are already in the list.
Is there a way to do this ?
To redraw only certain items use the UpdateItems method. It has two input parameters where you can specify the range of the items to be redrawn. If you are going to redraw only one item, then just specify that one item index as a range.
In this example I'm storing the color of the item into the TListItem.Data property and fading this color in the timer's event. After changing the value I call the UpdateItems function which force the draw item event to fire. And yes, without DoubleBuffered set, it flickers (even when you set the timer's interval e.g. to 500ms).
procedure TForm1.FormCreate(Sender: TObject);
begin
ListView1.AddItem('Item 1', TObject(clWhite));
ListView1.AddItem('Item 2', TObject(clWhite));
ListView1.AddItem('Item 3', TObject(clWhite));
Timer1.Enabled := True;
end;
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
ListView1.Canvas.Brush.Color := TColor(Item.Data);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
C: Byte;
I: TColor;
procedure ChangeItemColor;
begin
I := TColor(ListView1.Items[0].Data);
C := GetRValue(I);
if C < 150 then C := 255 else Dec(C);
I := RGB(C, C, C);
ListView1.Items[0].Data := TObject(I);
end;
begin
// color change
ChangeItemColor;
// repaint of the item with index 1
ListView1.UpdateItems(1, 1);
end;
I have a TStringGrid where the selected row (max 1, no multi-select) should always have a different background colo(u)r.
I set the DefaultDrawing property to false, and provide a method for the OnDrawCell event, shown below - but it is not working. I can't even describe exactly how it is not working; I supect that if I could I would already have solved the problem. Suffice it to say that instead of having complete rows all with the same background colour it is a mish-mash. Muliple rows have some cells of the "Selected" colour and not all cells of the cselected row have the selected colour.
Note that I compare the cell's row with the strnggrid's row; I can't check the cell state for selected since only cell of the selected row is selected.
procedure TForm1.DatabaseNamesStringGridDrawCell(Sender: TObject;
ACol, ARow: Integer;
Rect: TRect;
State: TGridDrawState);
var cellText :String;
begin
if gdFixed in State then
DatabaseNamesStringGrid.Canvas.Brush.Color := clBtnFace
else
if ARow = DatabaseNamesStringGrid.Row then
DatabaseNamesStringGrid.Canvas.Brush.Color := clAqua
else
DatabaseNamesStringGrid.Canvas.Brush.Color := clWhite;
DatabaseNamesStringGrid.Canvas.FillRect(Rect);
cellText := DatabaseNamesStringGrid.Cells[ACol, ARow];
DatabaseNamesStringGrid.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, cellText);
end;
if you are trying of paint the selected row or cell with a different color you must check for the gdSelected value in the state var.
procedure TForm1.DatabaseNamesStringGridDrawCell(Sender: TObject;
ACol, ARow: Integer;
Rect: TRect;
State: TGridDrawState);
var
AGrid : TStringGrid;
begin
AGrid:=TStringGrid(Sender);
if gdFixed in State then //if is fixed use the clBtnFace color
AGrid.Canvas.Brush.Color := clBtnFace
else
if gdSelected in State then //if is selected use the clAqua color
AGrid.Canvas.Brush.Color := clAqua
else
AGrid.Canvas.Brush.Color := clWindow;
AGrid.Canvas.FillRect(Rect);
AGrid.Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, AGrid.Cells[ACol, ARow]);
end;
Do you have run-time themes enabled? Run-time themes override any colour scheme you try to enforce for Windows Vista and up.
When a new cell is selected in a stringgrid only the previous and the new selected cell are invalidated. Thus the remaining cells of the previous and new row are not redrawn, giving the effect you describe.
One workaround would be to call InvalidateRow for both affected rows, but this is a protected method and you have to find a way to reach this method from an OnSelectCell event handler. Depending on your Delphi version there are different ways to accomplish that.
The cleanest way would be to derive from TStringGrid, but in most cases this is not feasible. With a newer Delphi version you can use a class helper to achieve this. Otherwise you have to rely on the usual protected hack.
This works for me
procedure TFmain.yourStringGrid(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
State: TGridDrawState);
var
md: integer;
begin
with yourStringGrid do
begin
if yourStringGrid,Row = ARow then
Canvas.Brush.Color:= clYellow //your highlighted color
else begin
md := Arow mod 2;
if md <> 0 then Canvas.Brush.Color:= $00BADCC1 else //your alternate color
Canvas.Brush.Color:= clwhite;
end;
Canvas.FillRect(Rect);
Canvas.TextOut(L, Rect.top + 4, cells[ACol, ARow]);
end;
end;
Refresh the grid
procedure TFmain.yourStringGridClick(Sender: TObject);
begin
yourStringGrid.Refresh;
end;
Note: Has a little latency, but otherwise works great.
(Used in Delphi XE2)