轻松制作“速达软件“的列表框控件（简易版） (0分)

用法：

设置Items的属性为：
DisplayGrid=0
SnapToGrid=1
GridSizeX=2
GridSizeY=3
-=$00DBECE1
DisplayGrid=4
SnapToGrid=5
GridSizeX=6
GridSizeY=20
-=$00CAD5BF
DisplayGrid=8
SnapToGrid=9
GridSizeX=10
GridSizeY=11
-=$00DCFCFA
DisplayGrid=21
SnapToGrid=13
GridSizeX=22
GridSizeY=23
-=$00CFB790
DisplayGrid=16
SnapToGrid=17
GridSizeX=18
GridSizeY=19
-=$00F4CCEF
说明：GridSizeX=18，GridSizeX为标题，18为ImageList属性的图形索引
-=$00F4CCEF，-为分割符，$00F4CCEF为颜色值，此项表示以上项目的颜色
大家试一试就知道了！

unit ToolListBox;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ImgList;

type
TToolListBox = class(TCustomListBox)
private
{ Private declarations }
PriorIDX: Integer;
PriorClkIDX: Integer;
iMin, iMax: Integer;
FImageList: TCustomImageList;
procedure SetImageList(Value: TCustomImageList);
protected
{ Protected declarations }
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure MeasureItem(Index: Integer; var Height: Integer); override;
procedure Click; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property Color;
property Columns;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ExtendedSelect;
property Font;
property ImeMode;
property ImeName;
property IntegralHeight;
property ItemHeight;
property Items;
property MultiSelect;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
//property Style;
property TabOrder;
property TabStop;
property TabWidth;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property ImageList: TCustomImageList read FImageList write SetImageList;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TToolListBox]);
end;

{ TToolListBox }

procedure TToolListBox.Click;
var
i, iPriorMin, iPriorMax: Integer;
PriorRt, Rt: TRect;
P: TPoint;
ClickIDX: Integer;
begin
inherited;
if PriorClkIDX = ItemIndex then Exit;
P := ScreenToClient(Mouse.CursorPos);
ClickIDX := ItemAtPos(P, True);
if (ClickIDX = -1) or (Items.Names[ClickIDX] = '-') then Exit;
iMin := -1; iMax := -1;
iPriorMin := -1; iPriorMax := -1;
for i := 0 to Items.Count - 1 do
begin
if Items.Names <> '-' then Continue;
if i < ItemIndex then iMin := i;
if (iMax = -1) and (i > ItemIndex) then iMax := i;
if i < PriorClkIDX then iPriorMin := i;
if (iPriorMax = -1) and (i > PriorClkIDX) then iPriorMax := i;
end;
if iMin = -1 then iMin := 0 else Inc(iMin, 1);
if iMax = -1 then iMax := Items.Count - 1 else Dec(iMax, 1);
if iPriorMin = -1 then iPriorMin := 0 else Inc(iPriorMin, 1);
if iPriorMax = -1 then iPriorMax := Items.Count - 1 else Dec(iPriorMax, 1);
Rt := Rect(ItemRect(iMin).Left, ItemRect(iMin).Top,
ItemRect(iMin).Right, ItemRect(iMax).Bottom);
PriorRt := Rect(ItemRect(iPriorMin).Left, ItemRect(iPriorMin).Top,
ItemRect(iPriorMin).Right, ItemRect(iPriorMax).Bottom);
InvalidateRect(Handle, @PriorRt, False);
InvalidateRect(Handle, @Rt, False);
PriorClkIDX := ItemIndex;
end;

procedure TToolListBox.CMMouseEnter(var Msg: TMessage);
begin
inherited;
Cursor := crHandPoint;
end;

procedure TToolListBox.CMMouseLeave(var Msg: TMessage);
begin
inherited;
Cursor := crDefault;
end;

procedure TToolListBox.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
begin
inherited;
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
if odFocused in State then DrawFocusRect(hDC, rcItem);
end;
end;

constructor TToolListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := lbOwnerDrawVariable;
PriorIDX := -1;
PriorClkIDX := -1;
iMin := -1;
iMax := -1;
end;

procedure TToolListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var Flags: LongInt;
Rt: TRect;
ImgIDX: Integer;
begin
with Canvas do
begin
Rt := Rect;
Brush.Color := Color;
FillRect(Rect);
if Items.Names[Index] = '-' then
begin
Pen.Color := clNavy;
MoveTo(Rect.Left, Rect.Top);
LineTo(Rect.Right, Rect.Top);
end
else if Index < Items.Count then
begin
if (Index <= iMax) and (Index >= iMin) then
begin
Brush.Color := StrToInt(Copy(Items[iMax + 1], 3, 9)); //$00CFB790;
FillRect(Rt);
if odSelected in State then
begin
Brush.Color := $008396A0;
InflateRect(Rt, -1, -1);
FillRect(Rt);
end
end;
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
if not UseRightToLeftAlignment then
Inc(Rect.Left, 2)
else
Dec(Rect.Right, 2);
InflateRect(Rect, 0, -1);
if Assigned(FImageList) then
begin
Inc(Rect.Left, FImageList.Width + 5);
try
ImgIDX := StrToInt(Copy(Items[Index], Pos('=', Items[Index]) + 1, 2));
except
ImgIDX := -1;
end;
if (ImgIDX < FImageList.Count) and (ImgIDX >= 0) then
FImageList.Draw(Canvas, Rt.Left + 2, Rect.Top + 2, ImgIDX);
end;
DrawText(Canvas.Handle, PChar(Items.Names[Index]), Length(Items.Names[Index]), Rect,
Flags);
end;
end;
end;

procedure TToolListBox.MeasureItem(Index: Integer; var Height: Integer);
var TM: tagTEXTMETRICA;
begin
if Items.Names[Index] = '-' then
Height := 1
else if Assigned(ImageList) then
Height := FImageList.Height + 4
else begin
GetTextMetrics(Canvas.Handle, TM);
Height := TM.tmHeight + TM.tmInternalLeading + 4;
end;
end;

procedure TToolListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
var PriorRt, Rt: Trect;
IDX: integer;
begin
IDX := ItemAtPos(Point(X, Y), True);
if (PriorIDX <> -1) and (PriorIDX <> IDX) then
begin
PriorRt := ItemRect(PriorIDX);
InvalidateRect(Handle, @PriorRt, False);
end;
if (IDX <> -1) and (Items.Names[IDX] <> '-') and (IDX <> ItemIndex) then
begin
Rt := ItemRect(IDX);
InflateRect(Rt, -1, -1);
Canvas.Brush.Color := clBlack;
Canvas.FrameRect(Rt);
PriorIDX := IDX;
end;
inherited;
end;

procedure TToolListBox.SetImageList(Value: TCustomImageList);
begin
if FImageList <> Value then
begin
FImageList := Value;
Invalidate;
end;
end;

end.

欢迎大家与我交流，如果有什么好的想法可要贴出来哟！

我在D6上面没实现。
DisplayGrid=0
SnapToGrid=1
GridSizeX=2
GridSizeY=3
这些东东是什么？属性吗？
问题是Items没有这些属性