به هم ریختن ظاهر کامپوننت در محیط طراحی

[mbshareat]

سلام
من یه کامپوننت مثل لیست باکس دارم که مثل لیستهای کنار صفحه های اینترنتیه!
عملکردش درسته فقط وقتی روی فرم میذارم Items رو براش مقدار دهی می کنم و بعدش اندازه های کامپوننت رو تغییر میدم یا مثلا فرم رو جابجا می کنم و کامپوننتم دوباره ترسیم میشه ظاهرش در محیط طراحی بهم میریزه.این تصویر رو ملاحظه کنین:

94644

این هم کدش:

unit LinkListUnit;

interface

uses
Windows, Messages, SysUtils, Classes
,Forms,Controls, StdCtrls,Graphics,Math,dialogs,ExtCtrls,GraphUtil, StrUtils;
Type
TLinkList = class(TCustomListBox)
private
BulletBmp:TBitmap;
LastItem:Integer;
FSelItemFontClr: TColor;
FBulletColor: TColor;
FBulletMode: TBulletMode;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
//نیاز نیست!
// property Style;
// property IntegralHeight;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);override;
procedure SetLc(C:TColor);
procedure SetBulletColor(C:TColor);
procedure SetBulletMode(B:TBulletMode);
protected
{ Public declarations }
constructor Create(AOwner:Tcomponent); override;
destructor Destroy(); Override;
published
property SelItemFontClr:TColor read FSelItemFontClr write SetLc;
property Anchors;
property BulletMode:TBulletMode read FBulletMode write SetBulletMode;
property BulletColor:TColor read FBulletColor write SetBulletColor;
property Color;
property BorderStyle;
property Ctl3d;
property Items;
property Font;
property ItemHeight;
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;

procedure Register;
procedure TextDraw(Can:TCanvas;R:TRect;S:String;C:TColor);
procedure SmoothDraw(Var B:TBitmap;Can:TCanvas;XY:Array Of Integer;Shape,Mode:String;BorderColor,FillColor:TC olor;DecPixel:Integer=1);OverLoad;

implementation
{TLinkList}

procedure Register;
begin
RegisterComponents('Bagher',[TLinkList]);
end;
procedure TextDraw(Can:TCanvas;R:TRect;S:String;C:TColor);
begin
can.Brush.Style:=bsClear;
Can.Font.Color:=C;
DrawText(Can.Handle,PChar(S),-1,R,DT_RIGHT);
Can.Font.Color:=clBlack;
Can.TextOut(R.Left,R.Top,'');
end;
procedure SmoothDraw(Var B:TBitmap;Can:TCanvas;XY:Array Of Integer;Shape,Mode:String;BorderColor,FillColor:TC olor;DecPixel:Integer=1);OverLoad;
function WMul(N:Real):Integer ;
begin
Result:=Round(B.Width*N);
end;
function HMul(N:Real):Integer ;
begin
Result:=Round(B.Height*N);
end;
Var
X,Y,I,N,W,H:Word;
X1,Y1,X2,Y2,X3,Y3:Word;
Pnt:Array Of TPoint;
Rct:TRect;
begin
B.PixelFormat:=pf24Bit;
X1:=XY[0];
Y1:=XY[1];
X2:=XY[2];
Y2:=XY[3];
X3:=XY[4];
Y3:=XY[5];
W:=X2-X1;
H:=Y2-Y1;
B.Width:=W*3;
B.Height:=H*3;
B.Canvas.CopyRect(Rect(0,0,B.Width,B.Height),Can,R ect(X1,Y1,X2,Y2));
B.Canvas.Pen.Color:=BorderColor;
B.Canvas.Brush.Color:=FillColor;
If UpperCase(Mode)='B' then
B.Canvas.Brush.Style:=bsClear;
If UpperCase(Mode)='F' then
B.Canvas.Pen.Style:=psClear;
B.Canvas.Pen.Width:=3;
Shape:=UpperCase(Shape);
Case Ord(Shape[1]) Of
Ord('L'):
If Shape='L' then
Begin
B.Canvas.MoveTo(DecPixel,DecPixel);
B.Canvas.LineTo(B.Width-DecPixel,B.Height-DecPixel);
End
Else//'L2'
Begin
B.Canvas.MoveTo(DecPixel,B.Height-DecPixel);
B.Canvas.LineTo(B.Width-DecPixel,DecPixel);
End;
Ord('R'):
If UpperCase(Shape)='RR' then
B.Canvas.RoundRect(DecPixel,DecPixel,B.Width-DecPixel,B.Height-DecPixel,X3*3,Y3*3)
Else//'R'
B.Canvas.Rectangle(DecPixel,DecPixel,B.Width-DecPixel,B.Height-DecPixel);
Ord('E'):
B.Canvas.Ellipse(DecPixel,DecPixel,B.Width-DecPixel,B.Height-DecPixel);
Ord('P'):
Begin
Rct:=Rect(2000,2000,-2000,-2000);
For I:=0 to ((High(XY)-1) Div 2) Do
Begin
Rct.Left:=Min(XY[I*2],Rct.Left);
Rct.Top:=Min(XY[I*2+1],Rct.Top);
Rct.Right:=Max(XY[I*2],Rct.Right);
Rct.Bottom:=Max(XY[I*2+1],Rct.Bottom);
End;
//ÊÚííä ãæÞÚíÊ ÇáÕÇÞ ÈíÊ ã
X1:=Rct.Left;
Y1:=Rct.Top;
//+1:äÏ ÎØí ÈÇ ÊÑÓíãÇÊ ÏíÑ ÝÑÞ ÏÇÑÏ
//äÞØÇÊ æÔå ÎØæØ åãí ÏÇÎá ãÍÏæÏå ÇäÏ
//!ÈÑ ÎáÇÝ äÞØå Ïæã ÊÑÓíãÇÊ ÏíÑ
X2:=Rct.Right+1;
Y2:=Rct.Bottom+1;
W:=X2-X1;
H:=Y2-Y1;
B.Width:=W*3;
B.Height:=H*3;
B.Canvas.CopyRect(Rect(0,0,B.Width,B.Height),Can,R ect(X1,Y1,X2,Y2));
SetLength(Pnt,(High(XY)-1) Div 2+1);
For I:=0 to ((High(XY)-1) Div 2) Do
Begin
Pnt[I].X:=(XY[I*2]-X1)*3;
Pnt[I].X:=Max(Pnt[I].X,1);
Pnt[I].X:=Min(Pnt[I].X,B.Width-1);
Pnt[I].Y:=(XY[I*2+1]-Y1)*3;
Pnt[I].Y:=Max(Pnt[I].Y,1);
Pnt[I].Y:=Min(Pnt[I].Y,B.Height-1);
End;
B.Canvas.Polygon(Pnt);
End;
Ord('V')://TrueTick!
Begin
B.Canvas.PolyBezier([Point(0,HMul(0.5))
,Point(WMul(0.4),HMul(0.9))
,Point(WMul(0.7),HMul(-0.1))
,Point(B.Width,3)]);
B.Canvas.PolyBezier([Point(0,HMul(0.5))
,Point(WMul(0.4),HMul(1.7))
,Point(WMul(0.6),HMul(0.3))
,Point(B.Width,3)]);
B.Canvas.FloodFill(WMul(0.4),HMul(0.7)
,B.Canvas.Pen.Color,fsBorder);
End;
Ord('X'),Ord('-')://CloseBut & MinimizeBut!
Begin
B.Canvas.Pen.Width:=12;
N:=6;
B.Canvas.Ellipse(N,N
,B.Width-N-2,B.Height-N-2);
If Shape[1]='X' then
Begin
B.Canvas.MoveTo(WMul(0.35),HMul(0.35));
B.Canvas.LineTo(WMul(0.65)-1,HMul(0.65)-1);
B.Canvas.MoveTo(WMul(0.35),HMul(0.65));
B.Canvas.LineTo(WMul(0.65),HMul(0.35));
End
Else
Begin
B.Canvas.MoveTo(WMul(0.35),HMul(0.5));
B.Canvas.LineTo(WMul(0.65)-1,HMul(0.5));
End;
B.Canvas.Pen.Width:=6;
B.Canvas.Pen.Color:=clWhite;
B.Canvas.Brush.Style:=bsClear;
B.Canvas.Ellipse(N,N
,B.Width-N-2,B.Height-N-2);
If Shape[1]='X' then
Begin
B.Canvas.MoveTo(WMul(0.35),HMul(0.35));
B.Canvas.LineTo(WMul(0.65)-1,HMul(0.65)-1);
B.Canvas.MoveTo(WMul(0.35),HMul(0.65));
B.Canvas.LineTo(WMul(0.65),HMul(0.35));
End
Else
Begin
B.Canvas.MoveTo(WMul(0.35),HMul(0.5));
B.Canvas.LineTo(WMul(0.65)-1,HMul(0.5));
End;
End;
End;
Average3In3Pixels(B);
Can.CopyRect(Rect(X1,Y1,X2,Y2),B.Canvas,Rect(0,0,W ,H));
end;
constructor TLinkList.Create(AOwner: Tcomponent);
begin
inherited;
BulletBmp:=TBitmap.Create;
BulletColor:=clRed;
BulletMode:=bmEllipse;
Style:=lbOwnerDrawFixed;
//IntegralHeight:=True;
SelItemFontClr:=clBlue;
LastItem:=-1;
end;
destructor TLinkList.Destroy;
begin
BulletBmp.Free;
inherited;
end;
procedure TLinkList.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
Var
C,C1,C2:TColor;
X,Y:Integer;
R:TRect;
begin
Canvas.Brush.Color:=Color;
If (LastItem<>-1) And (LastItem<>ItemIndex) then
Begin
R:=ItemRect(LastItem);
Canvas.FillRect(R);
If BulletMode<>bmNone then
Dec(R.Right,18);
TextDraw(Canvas,R,items[LastItem],Font.Color);
End;
Canvas.FillRect(Rect);
If BulletMode<>bmNone then
Dec(Rect.Right,18);
If ItemIndex=Index then
Begin
C:=SelItemFontClr;
If BulletMode<>bmNone then
Begin
X:=Rect.Right+10;
Y:=Rect.Top+(Rect.Bottom-Rect.Top) Div 2+2;
C1:=BulletColor;
C2:=LumC(BulletColor,0.7);
If BulletMode=bmEllipse then
SmoothDraw(BulletBmp,Canvas
,[X-4,Y-4,X+4,Y+4],'E','BF',C1,C2)
Else If BulletMode=bmRect then
SmoothDraw(BulletBmp,Canvas
,[X-4,Y-4,X+4,Y+4],'R','BF',C1,C2)
Else//bmTriangle
SmoothDraw(BulletBmp,Canvas
,[X+3,Y-5,X-5,Y,X+3,Y+5],'P','BF',C1,C2);
End;
End
Else
C:=Font.Color;
SetFontToClearType(Canvas.Font);
TextDraw(Canvas,Rect,items[index],C);
LastItem:=Index;
end;
procedure TLinkList.SetBulletMode(B: TBulletMode);
begin
FBulletMode:=B;
Invalidate;
end;
procedure TLinkList.SetBulletColor(C: TColor);
begin
FBulletColor:=C;
Invalidate;
end;
procedure TLinkList.SetLc(C: TColor);
begin
FSelItemFontClr:=C;
Invalidate;
end;
procedure TLinkList.CMFontChanged(var Message: TMessage);
begin
Canvas.Font:=Font;
ItemHeight:=Canvas.TextHeight('hgsd');
Invalidate;
end;

end.

[mbshareat]

جواب:
این کدها رو اضافه کنید:
private
...
procedure WMSize(var Message: TWMSize); message WM_SIZE;
..




...
procedure TLinkList.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
end;

[Felony]

تو کجای کد تو حالت Design کامپوننتو رو فرم طراحی میکنی ؟!

برای چندمین بار ، برو بشین Delphi Component Writer's Guide رو بخون .

[mbshareat]

تو کجای کد تو حالت Design کامپوننتو رو فرم طراحی میکنی ؟!
منظورتون بررسی If csDesigning in ComponentState هستش؟
من توی DrawItem طراحی می کنم. میشه بفرمایید کد باید چطور بشه؟

برو بشین Delphi Component Writer's Guide رو بخون .
انگلسی بلد نیستم. اما ان شاء الله اون راهنمای فارسی رو میخونم.