- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
- 68
- 69
- 70
- 71
- 72
- 73
- 74
- 75
- 76
- 77
- 78
- 79
- 80
- 81
- 82
- 83
Попытка внедрить контрол TCheckBox в заголовок 1 колонки TListView:
type
TForm1 = class(TForm)
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FListHeaderWnd: HWND;
FListHeaderChk: TCheckBox;
FSaveListHeaderWndProc, FListHeaderWndProc: Pointer;
procedure ListHeaderWndProc(var Msg: TMessage);
end;
var
Form1: TForm1;
implementation
uses
commctrl;
{$R *.dfm}
function GetCheckSize: TPoint;
begin
with TBitmap.Create do
try
Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
Result.X := Width div 4;
Result.Y := Height div 3;
finally
Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
CheckSize: TPoint;
HeaderSize: TRect;
begin
ListView1.HandleNeeded;
FListHeaderWnd := ListView_GetHeader(ListView1.Handle);
FListHeaderChk := TCheckBox.Create(nil);
CheckSize := GetCheckSize;
FListHeaderChk.Height := CheckSize.X;
FListHeaderChk.Width := CheckSize.Y;
// the below won't show anything since the form is not visible yet
ShowWindow(ListView1.Handle, SW_SHOWNORMAL); // otherwise header is not sized
windows.GetClientRect(FListHeaderWnd, HeaderSize);
FListHeaderChk.Top := (HeaderSize.Bottom - FListHeaderChk.Height) div 2;
FListHeaderChk.Left := FListHeaderChk.Top;
FListHeaderChk.Parent := Self;
windows.SetParent(FListHeaderChk.Handle, FListHeaderWnd);
FListHeaderWndProc := classes.MakeObjectInstance(ListHeaderWndProc);
FSaveListHeaderWndProc := Pointer(GetWindowLong(FListHeaderWnd, GWL_WNDPROC));
SetWindowLong(FListHeaderWnd, GWL_WNDPROC, NativeInt(FListHeaderWndProc));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SetWindowLong(FListHeaderWnd, GWL_WNDPROC, NativeInt(FSaveListHeaderWndProc));
classes.FreeObjectInstance(FListHeaderWndProc);
FListHeaderChk.Free;
end;
procedure TForm1.ListHeaderWndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_COMMAND) and (HWND(Msg.LParam) = FListHeaderChk.Handle)
and (Msg.WParamHi = BN_CLICKED) then begin
FListHeaderChk.Checked := not FListHeaderChk.Checked;
// code that checks/clears all items
end;
Msg.Result := CallWindowProc(FSaveListHeaderWndProc, FListHeaderWnd,
Msg.Msg, Msg.WParam, Msg.LParam);
end;
Follow us!