خلاص شدن از نقطه چین فوکوس در لیست باکس

[mbshareat]

سلام و درود
من یه لیست باکس دارم که میخوام برای متن داخلش افکت گرافیکی داشته باشم
بنابر این Style لیست باکس رو برابر lbOwnerDrawFixed قرار دادم و ترسیم متن رو داخل بیت مپ انجام میدم و بعد که روی بیت مپ افکت رو اعمال کردم با Canvas.Draw میریزم توی لیست باکس.
اما من میخوام لیست باکس آیتم جاری رو مشخص نکنه (چیزی شبیه Memo!)
چطور میتونم از شر کادر فوکوس که با عملیات بالا دیگه نقطه چین هم نیست و مستطیل معمولی شده خلاص بشم؟
این هم کد من (افکت رو فعلا نیاز نبود توی کد بیارم!):
unit Unit1;

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
ItemBmp:TBitmap;
implementation

{$R *.dfm}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
ItemBmp.Canvas.FillRect(ItemBmp.Canvas.ClipRect);
ItemBmp.Canvas.TextOut(0,0,ListBox1.Items[Index]);
//اميدوار بورم دو سطر زير
//!کمک کنه
//بدون این دو سطر نقطه چین میشه مستطیل
ListBox1.Canvas.Brush.Color:=clBlack;
ListBox1.Canvas.Brush.Style:=bsClear;
ListBox1.Canvas.Draw(Rect.Left,Rect.Top,ItemBmp);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ItemBmp:=TBitmap.Create;
ItemBmp.PixelFormat:=pf24Bit;
ItemBmp.Width:=ListBox1.ClientWidth;
ItemBmp.Height:=ListBox1.ItemHeight;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ItemBmp.Free;
end;

end.

[mbshareat]

من تغییر State رو امتحان کردم جواب نداد
کد OnDrawItem رو اینطور کردم ناقص جواب میده(وقتی ماوس رو روی لیست باکس پایین نگه داریم و به منظور پیمایش روی آیتمهای لیست باکس بالا پایین بریم گاهی نقطه چین فوکوس رو نشون میده!):

ItemBmp.Canvas.Font:=ListBox1.Font;
ItemBmp.Canvas.FillRect(ItemBmp.Canvas.ClipRect);
ItemBmp.Canvas.TextOut(0,0,ListBox1.Items[Index]);
ListBox1.Canvas.Brush.Style:=bsClear;
ListBox1.Canvas.Draw(Rect.Left,Rect.Top,ItemBmp);
ListBox1.Canvas.DrawFocusRect(Rect);

[BORHAN TEC]

سلام
کنترل TListBox یک متد به نام CanFocus داره که باید اون رو override کنید(ای کاش سازندگان VCL این مورد رو به صورت یک پروپرتی پیاده سازی می کردند :ناراحت:). مثال:
// ...

type
TMyListBox = class(TListBox)
public
function CanFocus: Boolean; Override;
end;

// ...
implementation

{ TMyListBox }

function TMyListBox.CanFocus: Boolean;
begin
Result := False;
end;

// ...
اگر از نسخه های جدیدتر دلفی استفاده می کنید می توانید این کار را با Class Helper ها که قبلاً آقا ماهان مقاله ای رو در مورد اون نوشته بودند انجام دهید:
http://barnamenevis.org/showthread.php?351076
فقط توجه داشته باشید که هر کلاس فقط می تواند یک Class Helper فعال داشته باشد ولی در کل به نظر من ساختن یک کامپوننت جدید از بسیاری جهات بهتر است.
موفق باشید...

[mbshareat]

آقای عشایری من این روش رو هم تو کامپوننتم استفاده کردم.نمی دونم چرا اصلا تاثیر نداشت(احتمالا کدم مشکل داره) هم با یه نمونه ساده از همون کد که فرمودید امتحان کردم تاثیری نداشت.
این کد رو اجرا کردم باز نقطه چین به صورت لحظه ای نمایش داده میشه:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
LinkList1: TLinkList;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TMyListBox = class(TCustomListBox)
public
function CanFocus: Boolean; Override;
procedure DrawItem(Index: Integer;Rect: TRect;
State: TOwnerDrawState);Override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}


{ TMyListBox }

function TMyListBox.CanFocus: Boolean;
begin
Result := False;
end;
procedure TMyListBox.DrawItem( Index: Integer;
Rect: TRect; State: TOwnerDrawState);
Var
ItemBmp:TBitmap;
begin
ItemBmp:=TBitmap.Create;
ItemBmp.PixelFormat:=pf24Bit;
ItemBmp.Width:=ClientWidth;
ItemBmp.Height:=ItemHeight;
ItemBmp.Canvas.Font:=Font;
ItemBmp.Canvas.FillRect(ItemBmp.Canvas.ClipRect);
ItemBmp.Canvas.TextOut(0,0,Items[Index]);
Canvas.Brush.Style:=bsClear;
Canvas.Draw(Rect.Left,Rect.Top,ItemBmp);
Canvas.DrawFocusRect(Rect);
ItemBmp.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
L:TMyListBox;
begin
L:=TMyListBox.Create(Self);
L.Parent:=Self;
L.Style:=lbOwnerDrawFixed;
L.Font.Name:='Tahoma';
L.Font.Size:=12;
L.Height:=100;
L.Items.Text:='asd'+#13+'dhjghd'+#13+'asd'+#13+'dh jghd'+#13+'asd'+#13+'dhjghd'+#13+'asd'+#13+'dhjghd ';
end;
end.

[mbshareat]

سلام
من روشهای دیگه ای مثل ترسیم مستطیل و DrawFocusRect رو امتحان کردم باز در کامپوننتم جواب نداد
از این پروسیجر استفاده کردم مشکل حل شد فقط با درگ کردن روی آیتمها دیگه نمیشه توی لیست پیمایش کرد اما هنوز با کلید بالا و پایین میشه میشه.

TLinkList = class(TCustomListBox)
private
procedure SetFocus(var Message: TMessage); message WM_SetFocus;
...
procedure TLinkList.SetFocus(var Message: TMessage);
begin
Parent.SetFocus;
end;