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(Rect);
  imagelist1.Draw(Sender.Canvas, 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;
balromAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RadikalQ3Commented:
Hi!,  balrom

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:=vsReport;
- ListView1.OwnerDraw:=TRUE;

I Fill the ListView with this code:

procedure TForm1.Button3Click(Sender: TObject);
var
  ListItem        :TListItem;
  n  : integer;
begin
  for n:=0 to 10 do begin
    ListItem:=ListView1.Items.Add;
    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(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;

  // draw item and subitems
  Sender.Canvas.Rectangle(Rect);
  imagelist1.Draw(Sender.Canvas, 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;

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
illusion_chaserCommented:
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(Sender: 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_FilesCustomDrawItem(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(itemRect);
  Form1.imagelist1.Draw(Sender.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(itemRect.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.
balromAuthor Commented:
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(Rect);

   r := Rect;
   Inc(r.Left, 2);
   IL_EsitoControllo.Draw(Sender.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;

balromAuthor Commented:
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
moduloCommented:
Closed, 500 points refunded.

modulo
Community Support Moderator

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.