There are some good examples in StackOverFlow to ownerdraw subitems in a TListView with vsReport style but I could not find any example on how to ownerdraw bitmaps in a TListView with vsIcon Style?
My bitmaps are stored in a third-party list and are resized to 32x32. I do not want to use an ImageList because the bitmaps are available in the third-party list. The code shown below draws the first icon ok, but the remaining items are empty. Should I be doing this in some other event that has access to TRect?
procedure TForm1.cxListView1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
State: TCustomDrawState; var DefaultDraw: Boolean);
var
iBitmap: TBitmap;
iRect: TRect;
begin
{ Create a TBitmap }
iBitmap := TBitmap.Create;
iBitmap.Width := 32;
iBitmap.Height := 32;
if Item.Index <> -1 then
begin
{ Copy a bitmap from the list to iBitmap }
AIEImageList.Image[Item.Index].CopyToTBitmap(iBitmap);
{ Resample the bitmap }
iBitmap.IEResample(32, 32);
{FIX}
iRect := Item.DisplayRect(drBounds);
{ Draw the bitmap }
Sender.Canvas.Draw(iRect.Left, iRect.Top, iBitmap);
end;
iBitmap.Free;
end;
Related
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.
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 custom draw a ListView to make it look like this?
You can draw content of TListView in custom way very eae only if you will read help resources carefully.
Image below is a result of code running. The code attached after this picture.
Component ImageList1 that is attached to TListView has both width and height set to 24 pixels
This one picture is the same TListView but without attached ImageList.
Orange rectangle is a selected item
Now go to the code.
procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var
Bmp: TBitmap;
Image: TBitmap;
R: TRect;
CenterH: Integer;
CenterV: Integer;
ImageIndex: Integer;
begin
R := Item.DisplayRect(drBounds);
Bmp := TBitmap.Create;
try
Image := TBitmap.Create;
try
Bmp.SetSize(R.Width, R.Height);
// Make fill for item
if Item.Selected then
Bmp.Canvas.Brush.Color := clWebOrange
else
Bmp.Canvas.Brush.Color := clMoneyGreen;
Bmp.Canvas.FillRect(Bmp.Canvas.ClipRect);
// Output image associated with current item
if Assigned(TListView(Sender).LargeImages) then
begin
TListView(Sender).LargeImages.GetBitmap(Item.ImageIndex, Image);
CenterH := (R.Width - Image.Width) div 2;
CenterV := (R.Height - Image.Height) div 2;
Bmp.Canvas.Draw(CenterH, CenterV, Image);
end;
// Draw ready item's image onto sender's canvas
Sender.Canvas.Draw(R.Left, R.Top, Bmp);
finally
Image.Free;
end;
finally
Bmp.Free;
end;
end;
You must be informed that size of each item of TListView in vsIcon ViewMode depend on the size of TImageList attached to control via LargeImages property. Than large image - than large item in TListView.
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 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;