balrom
asked on
Listview OwnerDrawItem don't work when columns are resized
hi Experts, i have an urgent question.
I've made some visual change to the appearence of my litsview.
All works great in the code below, but a wrong redraw occurs when i try to resize the columns of the listview.
It seems that during resize, the column on the right of splitter is drawed two times, at the original position and at new position.
Have you any idea?
Best regards
//of course, Ownerdraw is set to true
procedure TF_Import.LV_FilesDrawItem (Sender: TCustomListView;
Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
i: integer;
X: integer;
begin
if odSelected in State then // selected text
begin
Sender.Canvas.Brush.Color := clAqua;
Sender.Canvas.Pen.Color := clGray;
end
else // regular text - not selected
begin
Sender.Canvas.Brush.Color := clWhite;
Sender.Canvas.Pen.Color := clWhite;
end;
// Set font style according the item imageindex
case Item.ImageIndex of
// Messaggio valido
1: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clGreen;
end;
// Messaggio non valido
2: begin
Sender.Canvas.Font.Color := clGray;
end;
// Messaggio in elaborazione/Spedizione
3: begin
Sender.Canvas.Font.Color := $00663333;
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Brush.Color := clAqua;
end;
// Messaggio Inviato
4: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clBlue;
end;
// Invio fallito
5: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clRed;
end;
end;
// draw item and subitems
Sender.Canvas.Rectangle(Re ct);
imagelist1.Draw(Sender.Can vas, Rect.Left + 2, Rect.Top, Item.ImageIndex); // Draw an icon in the current item
if Item.SubItems.Count > 0 then begin
X := 0;
for i := 0 to Item.SubItems.Count - 1 do begin
X := X + (Sender as TListView).Columns.Items[i ].Width;
Sender.Canvas.TextOut(Rect .Left + X , Rect.Top + 1,Item.SubItems[i]);
end;
end;
end;
I've made some visual change to the appearence of my litsview.
All works great in the code below, but a wrong redraw occurs when i try to resize the columns of the listview.
It seems that during resize, the column on the right of splitter is drawed two times, at the original position and at new position.
Have you any idea?
Best regards
//of course, Ownerdraw is set to true
procedure TF_Import.LV_FilesDrawItem
Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
i: integer;
X: integer;
begin
if odSelected in State then // selected text
begin
Sender.Canvas.Brush.Color := clAqua;
Sender.Canvas.Pen.Color := clGray;
end
else // regular text - not selected
begin
Sender.Canvas.Brush.Color := clWhite;
Sender.Canvas.Pen.Color := clWhite;
end;
// Set font style according the item imageindex
case Item.ImageIndex of
// Messaggio valido
1: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clGreen;
end;
// Messaggio non valido
2: begin
Sender.Canvas.Font.Color := clGray;
end;
// Messaggio in elaborazione/Spedizione
3: begin
Sender.Canvas.Font.Color := $00663333;
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Brush.Color := clAqua;
end;
// Messaggio Inviato
4: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clBlue;
end;
// Invio fallito
5: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clRed;
end;
end;
// draw item and subitems
Sender.Canvas.Rectangle(Re
imagelist1.Draw(Sender.Can
if Item.SubItems.Count > 0 then begin
X := 0;
for i := 0 to Item.SubItems.Count - 1 do begin
X := X + (Sender as TListView).Columns.Items[i
Sender.Canvas.TextOut(Rect
end;
end;
end;
1. Set OwnerDraw of the ListView = False.
2. Use OnCustomDrawItem instead of OnDrawItem event.
Here is the code:
----- Code file (Unit1.pas) ------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ImgList, StdCtrls;
type
TForm1 = class(TForm)
LV_Files: TListView;
ImageList1: TImageList;
Button1: TButton;
procedure LV_FilesCustomDrawItem(Sen der: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//of course, Ownerdraw is set to true
procedure TForm1.LV_FilesCustomDrawI tem(Sender : TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
i: integer;
X: integer;
itemRect: TRect;
begin
DefaultDraw := False;
if cdsSelected in State then // selected text
begin
Sender.Canvas.Brush.Color := clAqua;
Sender.Canvas.Pen.Color := clGray;
end
else // regular text - not selected
begin
Sender.Canvas.Brush.Color := clWhite;
Sender.Canvas.Pen.Color := clWhite;
end;
// Set font style according the item imageindex
case Item.ImageIndex of
// Messaggio valido
1: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clGreen;
end;
// Messaggio non valido
2: begin
Sender.Canvas.Font.Color := clGray;
end;
// Messaggio in elaborazione/Spedizione
3: begin
Sender.Canvas.Font.Color := $00663333;
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Brush.Color := clAqua;
end;
// Messaggio Inviato
4: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clBlue;
end;
// Invio fallito
5: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clRed;
end;
end;
// draw item and subitems
itemRect := Item.DisplayRect(drBounds) ;
Sender.Canvas.Rectangle(it emRect);
Form1.imagelist1.Draw(Send er.Canvas, itemRect.Left + 2, itemRect.Top, Item.ImageIndex); // Draw an icon in the current item
if Item.SubItems.Count > 0 then begin
X := 0;
for i := 0 to Item.SubItems.Count - 1 do begin
X := X + (Sender as TListView).Columns.Items[i ].Width;
Sender.Canvas.TextOut(item Rect.Left + X , itemRect.Top + 1,Item.SubItems[i]);
end;
end;
end;
procedure TForm1.Button1Click(Sender : TObject);
var
lvi: TListItem;
begin
LV_Files.Items.BeginUpdate ;
lvi := LV_Files.Items.Add;
lvi.Caption := TimeToStr(Time);
lvi.SubItems.Add('11111');
lvi.SubItems.Add('22222');
LV_Files.Items.EndUpdate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
LV_Files.Clear;
end;
end.
2. Use OnCustomDrawItem instead of OnDrawItem event.
Here is the code:
----- Code file (Unit1.pas) ------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ImgList, StdCtrls;
type
TForm1 = class(TForm)
LV_Files: TListView;
ImageList1: TImageList;
Button1: TButton;
procedure LV_FilesCustomDrawItem(Sen
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//of course, Ownerdraw is set to true
procedure TForm1.LV_FilesCustomDrawI
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
i: integer;
X: integer;
itemRect: TRect;
begin
DefaultDraw := False;
if cdsSelected in State then // selected text
begin
Sender.Canvas.Brush.Color := clAqua;
Sender.Canvas.Pen.Color := clGray;
end
else // regular text - not selected
begin
Sender.Canvas.Brush.Color := clWhite;
Sender.Canvas.Pen.Color := clWhite;
end;
// Set font style according the item imageindex
case Item.ImageIndex of
// Messaggio valido
1: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clGreen;
end;
// Messaggio non valido
2: begin
Sender.Canvas.Font.Color := clGray;
end;
// Messaggio in elaborazione/Spedizione
3: begin
Sender.Canvas.Font.Color := $00663333;
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Brush.Color := clAqua;
end;
// Messaggio Inviato
4: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clBlue;
end;
// Invio fallito
5: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clRed;
end;
end;
// draw item and subitems
itemRect := Item.DisplayRect(drBounds)
Sender.Canvas.Rectangle(it
Form1.imagelist1.Draw(Send
if Item.SubItems.Count > 0 then begin
X := 0;
for i := 0 to Item.SubItems.Count - 1 do begin
X := X + (Sender as TListView).Columns.Items[i
Sender.Canvas.TextOut(item
end;
end;
end;
procedure TForm1.Button1Click(Sender
var
lvi: TListItem;
begin
LV_Files.Items.BeginUpdate
lvi := LV_Files.Items.Add;
lvi.Caption := TimeToStr(Time);
lvi.SubItems.Add('11111');
lvi.SubItems.Add('22222');
LV_Files.Items.EndUpdate;
end;
procedure TForm1.FormDestroy(Sender:
begin
LV_Files.Clear;
end;
end.
ASKER
I've tested yuor code, don't work.
I've got the correct solution on another forum, and works very fine !!!
See the code below.
Best regards
procedure TF_Import.LV_FilesDrawItem (Sender: TCustomListView;
Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
i: integer;
X: integer;
hdr : HWND;
r : TRect;
cols : integer;
begin
if odSelected in State then // selected text
begin
Sender.Canvas.Brush.Color := clAqua;
Sender.Canvas.Pen.Color := clGray;
end
else // regular text - not selected
begin
Sender.Canvas.Brush.Color := clWhite;
Sender.Canvas.Pen.Color := clWhite;
end;
case Item.ImageIndex of
1: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clGreen;
end;
2: begin
Sender.Canvas.Font.Color := clGray;
end;
3: begin
Sender.Canvas.Font.Color := $00663333;
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Brush.Color := clAqua;
end;
4: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clBlue;
end;
5: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clRed;
end;
end;
Sender.Canvas.Rectangle(Re ct);
r := Rect;
Inc(r.Left, 2);
IL_EsitoControllo.Draw(Sen der.Canvas , Rect.Left + 2, Rect.Top, Item.ImageIndex);
DrawText( Sender.Canvas.Handle, PChar(Item.Caption), -1, r,
DT_SINGLELINE OR DT_LEFT OR DT_VCENTER OR DT_NOPREFIX );
cols := TListView(Sender).Columns. Count;
if (Item.SubItems.Count > 0) and (cols > 1) then begin
//LVM_FIRST = $1000
//LVM_GETHEADER = LVM_FIRST + 31
//HDM_FIRST = $1200;
//HDM_GETITEMRECT = HDM_FIRST + 7;
hdr := SendMessage(Sender.Handle, $1000 + 31, 0, 0);
if hdr <> 0 then begin
i := 0;
while (i < Item.SubItems.Count) and (i +1 < cols) do begin
if SendMessage(hdr, $1200 +7, i +1, integer(@r)) <> 0 then begin
//Sender.Canvas.TextOut( r.Left , Rect.Top + 1, Item.SubItems[i]);
Inc(r.Left, 2);
r.Top := Rect.Top;
r.Bottom := Rect.Bottom;
DrawText( Sender.Canvas.Handle, PChar(Item.SubItems[i]), -1, r,
DT_SINGLELINE OR DT_LEFT OR DT_VCENTER OR DT_NOPREFIX );
end;
Inc(i);
end;
end;
end;
end;
I've got the correct solution on another forum, and works very fine !!!
See the code below.
Best regards
procedure TF_Import.LV_FilesDrawItem
Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
i: integer;
X: integer;
hdr : HWND;
r : TRect;
cols : integer;
begin
if odSelected in State then // selected text
begin
Sender.Canvas.Brush.Color := clAqua;
Sender.Canvas.Pen.Color := clGray;
end
else // regular text - not selected
begin
Sender.Canvas.Brush.Color := clWhite;
Sender.Canvas.Pen.Color := clWhite;
end;
case Item.ImageIndex of
1: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clGreen;
end;
2: begin
Sender.Canvas.Font.Color := clGray;
end;
3: begin
Sender.Canvas.Font.Color := $00663333;
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Brush.Color := clAqua;
end;
4: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clBlue;
end;
5: begin
Sender.Canvas.Font.Style := [fsBold];
Sender.Canvas.Font.Color := clRed;
end;
end;
Sender.Canvas.Rectangle(Re
r := Rect;
Inc(r.Left, 2);
IL_EsitoControllo.Draw(Sen
DrawText( Sender.Canvas.Handle, PChar(Item.Caption), -1, r,
DT_SINGLELINE OR DT_LEFT OR DT_VCENTER OR DT_NOPREFIX );
cols := TListView(Sender).Columns.
if (Item.SubItems.Count > 0) and (cols > 1) then begin
//LVM_FIRST = $1000
//LVM_GETHEADER = LVM_FIRST + 31
//HDM_FIRST = $1200;
//HDM_GETITEMRECT = HDM_FIRST + 7;
hdr := SendMessage(Sender.Handle,
if hdr <> 0 then begin
i := 0;
while (i < Item.SubItems.Count) and (i +1 < cols) do begin
if SendMessage(hdr, $1200 +7, i +1, integer(@r)) <> 0 then begin
//Sender.Canvas.TextOut( r.Left , Rect.Top + 1, Item.SubItems[i]);
Inc(r.Left, 2);
r.Top := Rect.Top;
r.Bottom := Rect.Bottom;
DrawText( Sender.Canvas.Handle, PChar(Item.SubItems[i]), -1, r,
DT_SINGLELINE OR DT_LEFT OR DT_VCENTER OR DT_NOPREFIX );
end;
Inc(i);
end;
end;
end;
end;
ASKER
Thank you illusion_chaser:
Also i have tested the code on a custom draw event (setting ownerdraw to false) and was giving the same problem (on conlumn resize),
The solution i posted works.
Best regards
Also i have tested the code on a custom draw event (setting ownerdraw to false) and was giving the same problem (on conlumn resize),
The solution i posted works.
Best regards
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Sorry but.. I cant reproduce the error...
In a blank form, I put a ListView with 3 columns, and one ImageList with an icon loaded
- The Listview have 3 columns
- ListView1.ViewStyle:=vsRep
- ListView1.OwnerDraw:=TRUE;
I Fill the ListView with this code:
procedure TForm1.Button3Click(Sender
var
ListItem :TListItem;
n : integer;
begin
for n:=0 to 10 do begin
ListItem:=ListView1.Items.
with ListItem do
begin
ImageIndex:=0;
Caption:='aaaa';
SubItems.Add('bbbbbbbbbbb'
SubItems.Add('ccccccccccc'
end;
end;
end;
and, in the OnDraw Item, this code:
procedure TForm1.ListView1DrawItem(S
Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
i: integer;
X: integer;
begin
if odSelected in State then // selected text
begin
Sender.Canvas.Brush.Color := clAqua;
Sender.Canvas.Pen.Color := clGray;
end
else // regular text - not selected
begin
Sender.Canvas.Brush.Color := clWhite;
Sender.Canvas.Pen.Color := clWhite;
end;
// draw item and subitems
Sender.Canvas.Rectangle(Re
imagelist1.Draw(Sender.Can
if Item.SubItems.Count > 0 then begin
X := 0;
for i := 0 to Item.SubItems.Count - 1 do begin
X := X + (Sender as TListView).Columns.Items[i
Sender.Canvas.TextOut(Rect
end;
end;
end;
and works perfectly... no extrange redraws... normal.
Maybe the bug is in other part of your application... test it in a new application first...
This was tested on Win2K with Delphi7