لیست باکس سفارشی؟

[mbshareat]

سلام
من میخوام یه کامپوننت لیست باکس داشته باشم که متن داخلش رو خودم به شیوه دلخواهم بنویسم و کاربر هم نتونه در نوشتن متن داخل اون دخالت کنه.
میخوام همیشه Style در این لیست باکس lbOwnerDrawFixed باشه و آیتمها در این لیست باکس کادر نقطه چین نگیرند و فقط آیتم کلیک شده رنگی بشه (تقریبا یه چیزی مثل لینکهای لیست شده در منوی اصلی سمت راست صفحه اینترنتی!)
در حال حاضر نمی دونم چطور میتونم یه لیست باکس داشته باشم که با کد من ترسیم متن رو انجام بده.
از کد زیر انتظار داشتم متن رو با رنگ آبی نشون بده اما وقتی کامپوننت رو نصب می کنم و یه نمونه روی فرم میذارم متوجه میشم اصلا کاری به پروسیجر من نداره و خود دلفی متن درون لیست باکس رو ترسیم می کنه.ممکنه راهنماییم کنید؟

unit LBoxUnit;

interface

uses
Windows, Messages, SysUtils, Classes
,Forms,Controls, StdCtrls,Graphics,Math,dialogs,ExtCtrls,GraphUtil;

type
TLBox = class(TCustomListBox)
private
procedure CMFontChanged(var Message: TMessage);
constructor Create(AOwner: TComponent);
Protected
PromptMemo:TMemo;
property OnDrawItem;
property Style;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); virtual;
published
property Anchors;
property Color;
property Enabled;
property Font;
property Items;
property ItemHeight;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;

procedure Register;

implementation

{ TLBox }

constructor TLBox.Create(AOwner: TComponent);
begin
inherited;
Style:=lbOwnerDrawFixed;
Canvas.Font:=Font;
ItemHeight:=Canvas.TextHeight('hgsd');
end;
procedure TLBox.CMFontChanged(var Message: TMessage);
begin
Canvas.Font:=Font;
Invalidate;
end;
procedure TLBox.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
Canvas.Handle := hDC;
Canvas.Font := Font;
Canvas.Brush := Brush;
if (Integer(itemID) >= 0) and (odSelected in State) then
Canvas.Brush.Color :=Color ;
if Integer(itemID) >= 0 then
Begin
Canvas.Font.Color:=clblue;
Canvas.TextRect(rcItem,rcItem.Left,rcItem.Right,It ems[itemID]);
End;
end;
end;
procedure TLBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
begin
Canvas.FillRect(Rect);
Canvas.Font.Color:=clblue;
Canvas.TextRect(Rect,Rect.Left,Rect.Right,Items[Index]);
end;
//------
procedure Register;
begin
RegisterComponents('Test', [TLBox]);
End;
end.

[mbshareat]

سلام به همگی
من یه کامپوننت به اسم TjanColorListBox از اینترنت گرفته بودم کدش رو یه تغییری دادم بدک نشد اما هنوز دو تا مشکل بزرگ دارم:
1.هنوز نتونستم از شر کادر نقطه چین آیتم انتخاب شده خلاص شم.
2.هنوز پروپرتی Style توی Object Inspector لیست شده!
اگه ممکنه یه نگاهی به کد بیندازید:
unit ColorListBoxUnit;

interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Buttons, StdCtrls;
type
TColorListBox = class(TListBox)
protected
{ Protected declarations }
procedure click; override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);override;
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public declarations }
constructor Create(AOwner:Tcomponent); override;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Test', [TColorListBox]);
end;

{ TColorListBox }

procedure TColorListBox.click;
var
s:string;
p:integer;
begin
if assigned(onClick) then
onclick(self);
end;


constructor TColorListBox.Create(AOwner: Tcomponent);
begin
inherited;
showhint:=true;
style:=lbOwnerDrawFixed;

end;

procedure TColorListBox.CreateParams(var Params: TCreateParams);
begin
inherited;
with params do
Style := Style and not WS_VScroll;
end;


procedure TColorListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
begin
Canvas.Pen.Color:=Color;
Canvas.Brush.Color:=Color;
Canvas.FillRect(Rect);
canvas.Font.Color:=clBlue;
Canvas.Brush.Style:=bsClear;
SetBkMode(Canvas.Handle,TRANSPARENT);
canvas.TextOut(Rect.Left,Rect.Top,items[index]);
Canvas.FrameRect(Rect);
end;


end.

[mbshareat]

سلام
من یه پروسیجر داشتم که وقتی با اون متن رو روی کانواس ترسیم می کردم این مشکل رو نداشت. بررسیش کردم یه موضوع مضحک رو فهمیدم.
کد کامپوننت رو که دو مشکل بالا رو نداره نگاه کنین:
unit ColorListBoxUnit;

interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Buttons, StdCtrls;
type
TColorListBox = class(TCustomListBox)
private
LastItem:Integer;
FLC: TColor;
procedure click; override;
protected
{ Protected declarations }
property Style;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);override;
procedure CreateParams(var Params: TCreateParams); override;
procedure SetLc(C:TColor);
public
{ Public declarations }
constructor Create(AOwner:Tcomponent); override;
published
property SelItemFontClr:TColor read FLC write SetLc;
property Color;
property Items;
property Font;
property ItemHeight;
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Test', [TColorListBox]);
end;

{ TColorListBox }

procedure TColorListBox.click;
begin
if assigned(onClick) then
onclick(self);
end;

constructor TColorListBox.Create(AOwner: Tcomponent);
begin
inherited;
Style:=lbOwnerDrawFixed;
SelItemFontClr:=clBlue;
LastItem:=-1;
end;

procedure TColorListBox.CreateParams(var Params: TCreateParams);
begin
inherited;
with params do
Style := Style and not WS_VScroll;
end;
procedure DrawText(Can:TCanvas;R:TRect;S:String;C:TColor);
begin
can.FillRect(R);
can.Brush.Style:=bsClear;
SetBkMode(Can.Handle,Transparent);
Can.Font.Color:=C;
Can.TextOut(R.Left,R.Top,S);
Can.Font.Color:=clBlack;
Can.TextOut(R.Left,R.Top,'');
end;
procedure TColorListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
Var
C:TColor;
begin
Canvas.Brush.Color:=Color;
If (LastItem<>-1) And (LastItem<>ItemIndex) then
DrawText(Canvas,ItemRect(LastItem),items[LastItem],Font.Color);
If ItemIndex=Index then
C:=SelItemFontClr
Else
C:=Font.Color;
DrawText(Canvas,Rect,items[index],C);
LastItem:=Index;
end;
procedure TColorListBox.SetLc(C: TColor);
begin
FLC:=C;
Invalidate;
end;

end.

حالا اگر دو سطر زیر رو برداریم مشکل نقطه چین دور آیتم انتخاب شده بر می گرده!!:

Can.Font.Color:=clBlack;
Can.TextOut(R.Left,R.Top,'');