How to change background color of an TListview item? - delphi

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;

Related

Firemonkey TListBox changing background color of item rows at runtime

Is there a way, at runtime, other than using styles, to change the background color of item rows of a TListBox? Can I use the OnPaint event?
"Can I use the OnPaint event?"
Yes, you can. But maybe it is not considered the orthodox way, as it isn't made available and may fall apart in future Delphi releases. Anyway, if you want to try it, here goes:
You want to use the OnPaint event of the TListBoxItem class. However, OnPaint event of the item is not made available in the designer, so you will need to add it manually to your form class.
type
TForm1 = class(TForm)
Label1: TLabel;
ListBox1: TListBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
// add following manually (copy & paste)
procedure ListBoxItemPaint(Sender: TObject; Canvas: TCanvas;
const ARect: TRectF);
private
{ Private declarations }
procedure PopulateListBox;
public
{ Public declarations }
end;
Then, when you add items to ListBox1, it is important to assign ListBoxItemPaint to each items OnPaint event (see end of procedure):
procedure TForm1.PopulateListBox;
var
i: integer;
item: TListBoxItem;
begin
// Set default item height
// Individual heights are not possible
ListBox1.ItemHeight := 48;
// Set nr of columns, items arranged horizontally first, then vertically
ListBox1.Columns := 1; // 3;
// Add items
for i := 0 to 7 do
begin
item := TListBoxItem.Create(nil);
item.Parent := ListBox1;
item.Width := Listbox1.Width;
item.StyledSettings := []; // You are now responsible for corresponding
// item.TextSettings, e.g. font, style, color etc.
item.tag := i;
item.Text := 'Item ' + IntToStr(i);
item.OnPaint := ListBoxItemPaint; // This links the OnPaint event to your code
end;
end;
And this is the ListBoxItemPaint() procedure:
procedure TForm1.ListBoxItemPaint(Sender: TObject; Canvas: TCanvas;
const ARect: TRectF);
var
Brush: TBrush;
Color: TAlphaColor;
Txt: string;
LocRect: TRectF;
begin
begin
Txt := (Sender as TListBoxItem).Text;
case (Sender as TListBoxItem).Tag of
0: Color := TAlphaColors.Aliceblue;
1: Color := TAlphaColors.Antiquewhite;
2: Color := TAlphaColors.Aqua;
3: Color := TAlphaColors.Aquamarine;
4: Color := TAlphaColors.Azure;
5: Color := TAlphaColors.Beige;
6: Color := TAlphaColors.Bisque;
else
Color := TAlphaColorRec.Chocolate;
end;
// Item background, color and shape
Brush := TBrush.Create(TBrushKind.Solid, Color);
try
Canvas.FillRect(ARect, 1, Brush); // rectangular item band
// alternatively use rounded corners
// Canvas.FillRect(ARect,11, 11, AllCorners, 1, Brush); // rounded corners
finally
Brush.Free;
end;
// Text color, font, style and size
Canvas.Fill.Color := TAlphaColors.Red;
Canvas.Font.Family := 'Segoe UI';
Canvas.Font.Style := [TFontStyle.fsBold, TFontStyle.fsItalic];
Canvas.Font.Size := 16;
// Item text location and drawing
LocRect := ARect;
LocRect.Left := LocRect.Left + 10;
Canvas.FillText(LocRect, Txt, False, 1, [], TTextAlign.Leading, TTextAlign.Leading);
end;
end;
Code is written and tested with Delphi 10.4 and demonstrates how you can have different bg colors for each item in a TListBox.
To change the color of the items at run time you need to move the color selection out from the OnPaint to a lookup function with selection logic you want to use.

How do I properly display a combined image in a Delphi `tstringgrid` component

I have a game program that requires the user to select from 50+ images to place on a 9x9 game board grid with a timage in each position. For the user to place the images, I am providing a tstringgrid which displays various images from a timagelist. The actual images are graphic symbols created in .png format with transparent regions to allow the background color of the image's parent to show through when displayed. The image selected from the tstringgrid displays correctly on the game board timage components, but not in the 'tstringgrid'. The tstringgrid displays an image's transparent areas as black which is unsightly and makes many of the symbols unreadable.
I have used the following code to load the tstringgrid:
procedure TImageForm.FormCreate(Sender: TObject);
var
r, c, n : Integer;
img:TImage;
begin
//assign a value to each cell to connect with imagelist.
//see StringGrid1DrawCell
img := timage.Create(nil);
try
n := -1;
with StringGrid1 do begin
for r := 0 to RowCount - 1 do begin
for c:= 0 to ColCount - 1 do begin
inc(n);
Cells[c,r] := IntToStr(n);
ImageList1.GetBitmap(n, img.Picture.Bitmap);
// ImageList1.AddMasked(Img.Picture.Bitmap, clBlack);
end;
end;
end;
finally
img.Free;
end;
end;
What I need to do is revise the bitmap retrieved from the list before it is displayed.
I am attempting to do this as follows:
procedure TForm1.FillBkgd (bmp : tbitmap;clr : tcolor);
//which is the imagelist index for the image
var
bmp1 : tbitmap;
begin
bmp1 := tbitmap.create;
try
bmp1.Width := 50;
bmp1.Height := 50;
with Bmp1.Canvas do begin
Brush.Color := clr; //stringgrid1.color;
Brush.Style := bsSolid;
FillRect(rect(0,0,50, 50));
end;
bmp1.Canvas.Draw(0,0, bmp);
bmp:= bmp1;
finally
bmp1.free;
end;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
{https://www.youtube.com/watch?v=LOEP312NzsE}
var
bmp : tbitmap;
s : string;
aCanvas: TCanvas;
n : integer;
begin
inherited;
if not Assigned (Imagelist1) then //or (Arow = 0) or (aCol in [0,5])
exit;
bmp := tbitmap.create;
try
s := (Sender as TStringGrid).Cells [aCol, ARow];
// Draw ImageX.Picture.Bitmap in all Rows in Col 1
aCanvas := (Sender as TStringGrid).Canvas;
// Clear current cell rect
aCanvas.FillRect(Rect);
// Draw the image in the cell
n := strtoInt (s);
ImageList1.GetBitmap(n, Bmp);
FillBkgd (bmp,clRed); //stringgrid.color
aCanvas.StretchDraw(Rect,bmp);
finally
end;
end;
My attempts to combine the symbol image with a colored background before placing it in the stringgrid have failed. It is unclear to me whether I am failing to create a solid colored bitmap or am not successfully joining the image to the background.
Function FillBkgd has big problems with the quality of the code.
bmp:= bmp1;
finally
bmp1.free;
end;
All object variables are pointers. bmp and bmp1 objects point to one area of ​​memory that you are freeing. This leads to Access Violation. You are lucky that the pointer is not returned from the function. Function FillBkgd does not work. To get the result, you could use bmp.Assign(bmp1);.
I see a lot of redrawing the picture of ImageList (draw to Bmp, draw to Bmp1, draw ACanvas). After the first transformation transparency information is lost. Therefore at this moment it is necessary to change the background color.
s := (Sender as TStringGrid).Cells [aCol, ARow];
// Draw ImageX.Picture.Bitmap in all Rows in Col 1
aCanvas := (Sender as TStringGrid).Canvas;
// Clear current cell rect
aCanvas.FillRect(Rect);
// Draw the image in the cell
n := strtoInt (s);
//new lines
bmp.Canvas.Brush.Color := clRed;
bmp.Canvas.FillRect(TRect.Create(0, 0, ImageList1.Width, ImageList1.Height));
//new lines
ImageList1.GetBitmap(n, Bmp);
//deleted lines
//FillBkgd (bmp,clRed); //stringgrid.color
aCanvas.StretchDraw(Rect,bmp);
And do not forget to fill out finally to free bmp.

How can I change the icon/item size of a TListView in vsIcon ViewStyle?

I need a control which can display thumbnails, for this I thought TListView with the ViewStyle set as vsIcon would be good enough for my purposes, unfortunately I realised that TImageList only supports images up to 256x256 in size. I know there are 3rd party solutions for this but I had hoped to work with the standard TListView.
The images I need to display are approximately 348x480 so I cannot add them to a imagelist and assign it to a listview.
So then I thought maybe I could store my images in a TList and then ownerdraw the listview, it is quite simple really just by using the CustomDrawItem method and working with the Item.DisplayRect to know exactly where to draw to, something like this (quick example):
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
ItemRect: TRect;
IconRect: TRect;
CaptionRect: TRect;
begin
DefaultDraw := False;
ItemRect := Item.DisplayRect(drBounds);
IconRect := Item.DisplayRect(drIcon);
CaptionRect := Item.DisplayRect(drLabel);
with ListView1 do
begin
if cdsHot in State then
begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clSkyBlue;
Canvas.FillRect(ItemRect);
end;
if cdsSelected in State then
begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clBlue;
Canvas.FillRect(ItemRect);
end;
{ my picture list is a custom control that holds bitmaps in a TList }
if MyPictureList1.Items.Count > 0 then
MyPictureList1.Draw(Canvas, IconRect.Left + 348 div 4, IconRect.Top + 2, Item.ImageIndex);
// commented out old code drawing from imagelist
{ if LargeImages <> nil then
begin
LargeImages.Draw(Canvas, IconRect.Left + LargeImages.Width div 4, 2, Item.ImageIndex);
end; }
// draw text etc
end;
end;
The problem is how to change the size of each listview item? Typically setting the imagelist will change the size of the items, but I cannot use an imagelist because of the size limitations.
I had tried ListView_SetIconSpacing(ListView1.Handle, 348, 480); which did not seem to do anything, I also tried inflating the local rects I assigned but no luck there.
Is it possible to manually set the icon/item size of a listview to be greater than 256px and if so, how could I achieve this?

How do I color a cxgrid based on table value?

I would like all rows where in particular field name 'hello' is present to get colored
green. I tried this on customdrawcell:
if abstable1.fieldbyname('somename').asstring = 'Hello' then
cxgrid.canvas.brush.color:=clGreen
But it wont work... what am I missing here ?
Use the OnGetContentStyle event for either individual columns or the grid object. Styles are much easier to work with than messing with the canvas.
You need to look at the internal data for each view row rather that the data of the current position in the table. Also make use of the canvas provided in the OnCustomDrawCell() event.
procedure TForm1.YourViewCustomDrawCell(
Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;
AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
begin
if(AViewInfo.GridRecord.Values[YourColumn.Index] = 'Hello') then
ACanvas.Brush.Color := clGreen;
end;
Don't try to change canvas colors in the Grid. Rather--and I find this to always be true--change colors in the View's OnDrawCell handler, as in this example:
procedure T_fmTabSnapList.View1CustomDrawCell(Sender: TcxCustomGridTableView;
ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
begin
if abstable1.fieldbyname('somename').asstring = 'Hello' then
ACanvas.Brush.Color := clGreen
end;
The cxGrid is just a container for Views. Views are where all the painting occurs.
s
procedure Tfm1.Grid1StylesGetContentStyle(Sender: TcxCustomGridTableView;
ARecord: TcxCustomGridRecord; AItem: TcxCustomGridTableItem;
out AStyle: TcxStyle);
Var
Style1: TcxStyle;
begin
if AItem = nil then exit;
if ARecord.Values[Grid1Med.Index] = true then
AStyle := cxStyleMed;
if ARecord.Values[Grid1CP.Index] = true then
AStyle := cxStyleHost;
if (ARecord.Values[Grid1Med.Index] = true) and
(ARecord.Values[Grid1CP.Index] = true) then
AStyle := cxStyleHostAndCP;
if not VarIsNull(ARecord.Values[colColor.Index]) then
begin
if not Assigned(AStyle) then
AStyle := TcxStyle.Create(Sender);
AStyle.Color := ARecord.Values[colColor.Index];
end;
end;
Here's some working code from a program of mine which does something similar.
procedure TDoDockets.grDocketsDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
with grDockets do
begin
if (qDocketsOpenCost.asinteger > 1) and (datacol = 5)
then canvas.font.color:= clRed;
if datacol = 9 then // status
if qDocketsColour.Value <> 0
then Canvas.font.color:= tcolor (qDocketsColour.Value);
if datacol = 10 then // attention
if qDocketsAttention.asinteger = 1
then canvas.brush.color:= clRed;
if qDocketsUrgent.asinteger = 1 then canvas.brush.color:= 10092543;
// light yellow
DefaultDrawColumnCell (Rect, DataCol, Column, State);
end
end;
grDockets is the grid, and qDockets is the query being displayed within the grid. Certain columns may be drawn in a different colour depending on the value being displayed, and in one case (qDocketsUrgent = 1), the entire line's background colour is changed.

Setting background color of selected row on TStringGrid

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)

Resources