Re: Capturing what happens (Component Building)

Posted by Rbrrneck on March 04, 2004 at 10:32:40:

In Reply to: Capturing what happens (Component Building) posted by Joey on February 29, 2004 at 19:33:51:

here's some of delphi's original code..
use it wisely

procedure TCustomListBox.WndProc(var Message: TMessage);
begin
{for auto drag mode, let listbox handle itself, instead of TControl}
if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
(Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
begin
if DragMode = dmAutomatic then
begin
if IsControlMouseMsg(TWMMouse(Message)) then
Exit;
ControlState := ControlState + [csLButtonDown];
Dispatch(Message); {overrides TControl's BeginDrag}
Exit;
end;
end;
inherited WndProc(Message);
end;

procedure TCustomListBox.WMLButtonDown(var Message: TWMLButtonDown);
var
ItemNo : Integer;
ShiftState: TShiftState;
begin
ShiftState := KeysToShiftState(Message.Keys);
if (DragMode = dmAutomatic) and FMultiSelect then
begin
if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then
begin
ItemNo := ItemAtPos(SmallPointToPoint(Message.Pos), True);
if (ItemNo >= 0) and (Selected[ItemNo]) then
begin
BeginDrag (False);
Exit;
end;
end;
end;
inherited;
if (DragMode = dmAutomatic) and not (FMultiSelect and
((ssCtrl in ShiftState) or (ssShift in ShiftState))) then
BeginDrag(False);
end;

procedure TCustomListBox.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
LBN_SELCHANGE:
begin
inherited Changed;
Click;
end;
LBN_DBLCLK: DblClick;
end;
end;

procedure TCustomListBox.WMPaint(var Message: TWMPaint);

procedure PaintListBox;
var
DrawItemMsg: TWMDrawItem;
MeasureItemMsg: TWMMeasureItem;
DrawItemStruct: TDrawItemStruct;
MeasureItemStruct: TMeasureItemStruct;
R: TRect;
Y, I, H, W: Integer;
begin
{ Initialize drawing records }
DrawItemMsg.Msg := CN_DRAWITEM;
DrawItemMsg.DrawItemStruct := @DrawItemStruct;
DrawItemMsg.Ctl := Handle;
DrawItemStruct.CtlType := ODT_LISTBOX;
DrawItemStruct.itemAction := ODA_DRAWENTIRE;
DrawItemStruct.itemState := 0;
DrawItemStruct.hDC := Message.DC;
DrawItemStruct.CtlID := Handle;
DrawItemStruct.hwndItem := Handle;

{ Intialize measure records }
MeasureItemMsg.Msg := CN_MEASUREITEM;
MeasureItemMsg.IDCtl := Handle;
MeasureItemMsg.MeasureItemStruct := @MeasureItemStruct;
MeasureItemStruct.CtlType := ODT_LISTBOX;
MeasureItemStruct.CtlID := Handle;

{ Draw the listbox }
Y := 0;
I := TopIndex;
GetClipBox(Message.DC, R);
H := Height;
W := Width;
while Y = Items.Count then break;
end;
end;

begin
if Message.DC 0 then
{ Listboxes don't allow paint "sub-classing" like the other windows controls
so we have to do it ourselves. }
PaintListBox
else inherited;
end;

procedure TCustomListBox.WMSize(var Message: TWMSize);
begin
inherited;
SetColumnWidth;
end;

procedure TCustomListBox.DragCanceled;
var
M: TWMMouse;
MousePos: TPoint;
begin
with M do
begin
Msg := WM_LBUTTONDOWN;
GetCursorPos(MousePos);
Pos := PointToSmallPoint(ScreenToClient(MousePos));
Keys := 0;
Result := 0;
end;
DefaultHandler(M);
M.Msg := WM_LBUTTONUP;
DefaultHandler(M);
end;