Delphi 7的ListView自画CheckBox

    Delphi 7下的ListView其中有个ViewStyle风格是vsReport，我们大多也是使用这个风格。在此风格下可以设置首列前面有个CheckBox复选框，但是我们更多时候，需要的是在最后一列显示CheckBox复选框。于是，我们得自己重画子项为CheckBox，然而画完之后，在调整列宽时，不会触发ListView刷新，导致影像残留，于是接着禁止用户调整列宽。

示例源码如下：

001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020 021 022 023 024 025 026 027 028 029 030 031 032 033 034 035 036 037 038 039 040 041 042 043 044 045 046 047 048 049 050 051 052 053 054 055 056 057 058 059 060 061 062 063 064 065 066 067 068 069 070 071 072 073 074 075 076 077 078 079 080 081 082 083 084 085 086 087 088 089 090 091 092 093 094 095 096 097 098 099 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157

unit Unit1;      interface      uses     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,     Dialogs, Grids, ValEdit, StdCtrls, CheckLst, ComCtrls, CommCtrl, Math,     XPMan;      type     TForm1 = class(TForm)       lv1: TListView;       xpmnfst1: TXPManifest;       procedure lv1CustomDrawSubItem(Sender: TCustomListView;         Item: TListItem; SubItem: Integer; State: TCustomDrawState;         var DefaultDraw: Boolean);       procedure lv1MouseDown(Sender: TObject; Button: TMouseButton;         Shift: TShiftState; X, Y: Integer);       procedure FormCreate(Sender: TObject);       procedure FormDestroy(Sender: TObject);     private       FListViewOldWndProc: TWndMethod;       procedure ListViewNewWndProc(var Msg: TMessage);     public       { Public declarations }     end;      var     Form1: TForm1;      implementation      {$R *.dfm}      procedure TForm1.FormCreate(Sender: TObject);   begin     FListViewOldWndProc := lv1.WindowProc;     lv1.WindowProc := ListViewNewWndProc;     with lv1 do     begin       RowSelect := True;       ReadOnly := True;     end;   end;      procedure TForm1.FormDestroy(Sender: TObject);   begin     lv1.WindowProc := FlistViewOldWndProc;     FListViewOldWndProc  := nil;   end;   {-------------------------------------------------------------------------------    Description: 禁止ListView调整列宽   -------------------------------------------------------------------------------}   procedure TForm1.ListViewNewWndProc(var Msg: TMessage);   var     hdn: ^THDNotify;   begin     if Msg.Msg = WM_NOTIFY then     begin       hdn := Pointer(Msg.lParam);       if (hdn.hdr.code = HDN_BeginTrackW) or (hdn.hdr.code = HDN_BeginTrackA) then         Msg.Result := 1       else         FListViewOldWndProc(Msg);     end     else       FListViewOldWndProc(Msg);   end;      {-------------------------------------------------------------------------------    Description: 定义第几个子项为复选框，True值为选中   -------------------------------------------------------------------------------}   const     SubItemCheck = 2;   {-------------------------------------------------------------------------------    Description: TListView中画出复选框事件   -------------------------------------------------------------------------------}   procedure TForm1.lv1CustomDrawSubItem(Sender: TCustomListView;     Item: TListItem; SubItem: Integer; State: TCustomDrawState;     var DefaultDraw: Boolean);   var     s    : TSize;     r    : TRect;     rc   : TRect;     i    : Integer;     Dx   : Integer;     cr   : TColor;   begin     if (SubItem = SubItemCheck) then     begin       DefaultDraw := False;       rc  := Item.DisplayRect(drBounds);       Dx  := 0;       for i := 0 to SubItem - 1 do         Inc(Dx,Sender.Column[i].Width);       rc.Left  := rc.Left + Dx;       rc.Right := rc.Left + Sender.Column[SubItem].Width;       cr := Sender.Canvas.Brush.Color;       if Item.Selected and Sender.RowSelect and Sender.Focused then         Sender.Canvas.Brush.Color := clHighlight       else         Sender.Canvas.Brush.Color := clWindow;       Sender.Canvas.FillRect(rc);       if cdsFocused in State then       begin         DrawFocusRect(Sender.Canvas.Handle,rc);         Sender.Canvas.FillRect(Rect(rc.Left,rc.Top + 1,rc.Left + 1,rc.Bottom - 1));       end;       Sender.Canvas.Brush.Color := cr;       s.cx := GetSystemMetrics(SM_CXMENUCHECK);       s.cy := GetSystemMetrics(SM_CYMENUCHECK);       Dx   := (Sender.Column[SubItem].Width-GetSystemMetrics(SM_CXMENUCHECK)) div 2;       r.Top    := rc.Top + (rc.Bottom - rc.Top - s.cy) div 2;       r.Bottom := r.Top + s.cy;       r.Left   := rc.Left + Dx;       r.Right  := r.Left + s.cx;       DrawFrameControl(Sender.Canvas.Handle, r, DFC_BUTTON, IfThen(         CompareText(Item.SubItems[SubItem-1],'True')=0, DFCS_CHECKED, DFCS_BUTTONCHECK));     end;   end;   {-------------------------------------------------------------------------------    Description: TListView中子项复选框单击选中事件   -------------------------------------------------------------------------------}   procedure TForm1.lv1MouseDown(Sender: TObject; Button: TMouseButton;     Shift: TShiftState; X, Y: Integer);   var     s    : TSize;     r    : TRect;     Rect : TRect;     i    : Integer;     Dx   : Integer;   begin     if (lv1.ItemIndex > -1) and (Shift = [ssleft]) then     //左键点击时     begin       Rect  :=lv1.Items[lv1.ItemIndex].DisplayRect(drBounds);       Dx := 0;       for i := 0 to SubItemCheck - 1 do         Inc(Dx,lv1.Column[i].Width);       Rect.Left  :=Rect.Left + Dx;       Rect.Right :=Rect.Left + lv1.Column[SubItemCheck].Width;       s.cx := GetSystemMetrics(SM_CXMENUCHECK);       s.cy := GetSystemMetrics(SM_CYMENUCHECK);       Dx   := (lv1.Column[SubItemCheck].Width - GetSystemMetrics(SM_CXMENUCHECK)) div 2;       r.Top    := Rect.Top + (Rect.Bottom - Rect.Top - s.cy) div 2;       r.Bottom := r.Top + s.cy;       r.Left   := Rect.Left + Dx;       r.Right  := r.Left + s.cx;       if (x >= r.Left) and (y >= r.Top) and (x <= r.Right) and (y <= r.Bottom)then       begin   //判断是否点中复选框         if lv1.Items[lv1.ItemIndex].SubItems.Strings[SubItemCheck - 1] = 'true' then           lv1.Items[lv1.ItemIndex].SubItems.Strings[SubItemCheck - 1] := 'false'         else           lv1.Items[lv1.ItemIndex].SubItems.Strings[SubItemCheck - 1] := 'true';       end;     end;   end;   end.

运行结果如下所示：