مشکل در انتساب بیت مپ به پراپرتی کامپوننت؟

[mbshareat]

سلام
(مثال این تاپیک رو جایگزین و یک کم ساده تر کردم)
من دارم یه کامپوننت دکمه طراحی می کنم که یه بیت مپ بهش میدم که بیت مپ رو دو تکه میکنه و مثل دکمه Play/Pause برای دو حالت استفاده می کنه.
وقتی کامپوننت ساخته میشه هم یه ترسیم توی Canvas بیت مپ انجام میده.
نمی دونم چرا وقتی در زمان طراحی بیت مپ رو بهش آدرس میدم، درست عمل می کنه؛ اما در زمان اجرا اینگار هیچ بیت مپی به پراپرتی پاس داده نشده و همون تصویر اولیه رو نشون میده!
لطفا شما هم یه نگاهی بکنین:

TTwoStatusBut= class(TGraphicControl)
Private
FBmp : TBitmap;
Bmp1,Bmp2:TBitmap;
Status:Byte;//0=Up;1=Over;2=Down;
procedure SetBmp(B:TBitmap);
procedure Click;OverRide;
public
constructor Create(AOwner: TComponent);Override;
procedure Paint;OverRide;
Published
property ShowHint;
property Anchors;
property Bmp:TBitmap read FBmp write SetBmp;
property OnClick;
end;
.
.
implementation
.
.
{ T2StatusBmpBut }

procedure TTwoStatusBut.Click;
begin
Status:=1-Status;
Invalidate;
inherited;
end;
constructor TTwoStatusBut.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetParent(TWinControl(AOwner));
Status:=0;
FBmp:=TBitmap.Create;
FBmp.PixelFormat:=pf24Bit;
FBmp.Width:=40;
FBmp.Height:=20;
FBmp.Canvas.Brush.Color:=clBlack;
FBmp.Canvas.FillRect(FBmp.Canvas.ClipRect);
FBmp.Canvas.Pen.Color:=clBlue;
FBmp.Canvas.Brush.Color:=clWhite;
FBmp.Canvas.Ellipse(0,0,20,20);
FBmp.Canvas.Ellipse(20,0,40,20);
FBmp.Canvas.Pen.Color:=clGreen;
FBmp.Canvas.Brush.Color:=clLime;
FBmp.Canvas.Polygon([Point(7,5),Point(14,10),Point(7,15)]);
FBmp.Canvas.Pen.Color:=clBlue;
FBmp.Canvas.Brush.Color:=clAqua;
FBmp.Canvas.Rectangle(25,5,29,15);
FBmp.Canvas.Rectangle(31,5,35,15);
Bmp1:=TBitmap.Create;
Bmp2:=TBitmap.Create;
SetBmp(FBmp);
end;
procedure TTwoStatusBut.Paint;
begin
If Status=0 then
Canvas.Draw(0,0,Bmp1)
Else If Status=1 then
Canvas.Draw(0,0,Bmp2);
inherited;
end;
procedure TTwoStatusBut.SetBmp(B: TBitmap);
Var
W2:Word;
begin
FBmp.Assign(B);
W2:=B.Width Div 2;
Width:=W2;
Height:=B.Height;
Bmp1.Width:=W2;
Bmp1.Height:=B.Height;
Bmp1.PixelFormat:=pf24Bit;
Bmp1.Transparent := True;
Bmp1.TransparentMode:= tmAuto;
Bmp2.Assign(Bmp1);
Bmp1.Canvas.CopyRect(Bmp1.Canvas.ClipRect
,B.Canvas,Rect(0,0,W2,B.Height));
Bmp2.Canvas.CopyRect(Bmp2.Canvas.ClipRect
,B.Canvas,Rect(W2,0,W2*2,B.Height));
Invalidate;
end;


در ابتدای پروسیجر SetBmp با SaveToFile بررسی کردم در زمان اجرا چیزی که به پراپرتی میده همون تصویر اولیه هستش نه بیت مپی که در زمان طراحی بهش مسیر دادم!

[BORHAN TEC]

سلام:قلب:
شکل درست این کامپوننت در حالت کلی به شکل زیر است:
unit CustomControl1;

interface

uses
Winapi.Windows, System.SysUtils, System.Classes, Vcl.Forms, Vcl.Controls,
messages, graphics, Vcl.Buttons;

type
TRGBArray = array [0 .. 32767] of TRGBTriple;
PRGBArray = ^TRGBArray;

type
TFlashBut = class(TCustomControl)
Private
FBmp: TBitmap;
BmpUp, BmpOver, BmpDown: TBitmap;
Status: Byte; // 0=Up;1=Over;2=Down;
IsOnBut: Boolean;
BitmapChanged: Boolean;
procedure SetBmp(B: TBitmap);
procedure MouseLeave(var Message: TMessage); message CM_MouseLeave;
procedure MouseEnter(var Message: TMessage); message CM_MouseEnter;
procedure MouseDown(var Message: TMessage); message WM_LButtonDown;
procedure MouseUp(var Message: TMessage); message WM_LButtonUp;
procedure SplitBitmap;
function GetBmp: TBitmap;
public
constructor Create(AOwner: TComponent); Override;
procedure Paint; OverRide;
Published
property ShowHint;
property Anchors;
property Bmp: TBitmap read GetBmp write SetBmp Stored True;
property OnClick;
end;

procedure Register;

implementation

function CreateRegion(Bmp: TBitmap): THandle;
var
X, Y, StartX: Integer;
Excl: THandle;
Row: PRGBArray;
TransparentColor: TRGBTriple;
begin
Bmp.PixelFormat := pf24Bit;

Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);

for Y := 0 to Bmp.Height - 1 do
begin
Row := Bmp.Scanline[Y];

StartX := -1;

if Y = 0 then
TransparentColor := Row[0];

for X := 0 to Bmp.Width - 1 do
begin
if (Row[X].rgbtRed = TransparentColor.rgbtRed) and
(Row[X].rgbtGreen = TransparentColor.rgbtGreen) and
(Row[X].rgbtBlue = TransparentColor.rgbtBlue) then
begin
if StartX = -1 then
StartX := X;
end
else
begin
if StartX > -1 then
begin
Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1);
try
CombineRGN(Result, Result, Excl, RGN_DIFF);
StartX := -1;
finally
DeleteObject(Excl);
end;
end;
end;
end;

if StartX > -1 then
begin
Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1);
try
CombineRGN(Result, Result, Excl, RGN_DIFF);
finally
DeleteObject(Excl);
end;
end;
end;
end;

constructor TFlashBut.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetParent(TWinControl(AOwner));
Status := 0;
Width := 40;
Height := 50;
FBmp := TBitmap.Create;
BmpUp := TBitmap.Create;
BmpOver := TBitmap.Create;
BmpDown := TBitmap.Create;
BitmapChanged := False;
SetBmp(FBmp);
end;

procedure TFlashBut.SplitBitmap;
Var
W3: Word;
H: HRGN;
begin
W3 := FBmp.Width Div 3;
Width := W3;
Height := FBmp.Height;
BmpUp.Width := W3;
BmpUp.Height := FBmp.Height;
BmpUp.PixelFormat := pf24Bit;
BmpUp.Transparent := True;
BmpUp.TransparentMode := tmAuto;
BmpOver.Assign(BmpUp);
BmpDown.Assign(BmpUp);
BmpUp.Canvas.CopyRect(BmpUp.Canvas.ClipRect, FBmp.Canvas,
Rect(0, 0, FBmp.Width Div 3, FBmp.Height));
BmpOver.Canvas.CopyRect(BmpOver.Canvas.ClipRect, FBmp.Canvas,
Rect(W3, 0, W3 * 2, FBmp.Height));
BmpDown.Canvas.CopyRect(BmpDown.Canvas.ClipRect, FBmp.Canvas,
Rect(W3 * 2, 0, W3 * 3, FBmp.Height));
H := CreateRegion(BmpUp);
SetWindowRgn(Handle, H, True);
end;

function TFlashBut.GetBmp: TBitmap;
begin
Result := FBmp;
end;

procedure TFlashBut.MouseDown(var Message: TMessage);
begin
Status := 2;
Invalidate;
Inherited;
end;

procedure TFlashBut.MouseEnter(var Message: TMessage);
begin
Status := 1;
IsOnBut := True;
Invalidate;
Inherited;
end;

procedure TFlashBut.MouseLeave(var Message: TMessage);
begin
Status := 0;
IsOnBut := False;
Invalidate;
Inherited;
end;

procedure TFlashBut.MouseUp(var Message: TMessage);
begin
If IsOnBut = True then
Status := 1
Else
Status := 0;
Invalidate;
Inherited;
end;

procedure TFlashBut.Paint;
begin
inherited;
if BitmapChanged then
begin
SplitBitmap;
BitmapChanged := False;
end;

If Status = 0 then
Canvas.Draw(0, 0, BmpUp)
Else If Status = 1 then
Canvas.Draw(0, 0, BmpOver)
Else
Canvas.Draw(0, 0, BmpDown);
end;

procedure TFlashBut.SetBmp(B: TBitmap);
begin
FBmp.Assign(B);
Invalidate;
BitmapChanged := True;
end;

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

end.

[mbshareat]

سلام استاد عشایری
ممکنه بفرمایین چرا کد شما کار می کنه اما مال من نه؟
من یه دکمه دیگه هم دارم که توی اون در Paint تقطیع رو انجام میدم توی اون کامپوننت دکمه هم مشکلی ندارم!
چه اشکالی داره توی همون SetBmp بیت مپ رو سه تکه کنیم؟ فقط به خاطر اینکه معمولا در پروسیجر دریافت مقدار عملیات اضافه انجام نمیشه؟
یه سوال دیگه هم دارم که نمی دونم نیازه بپرسم(تنها سوال اول رو جواب بدین کافیمه!):
من در نمونه کدی که بار اول گذاشتم که برای کلید سه وضعیته بود و شما اصلاح شده اش رو گذاشتین پروسیجر CreateRegion رو نذاشته بودم که شما لطف کردین گذاشتین.آیا تعیین ناحیه (RGN) برای کامپوننت موجب میشه که وقت ترسیم در Canvas فقط در همون ناحیه ترسیم انجام بشه؟من امتحان کردم اینطور به نظر می رسید.یه بیت مپ که در اون یه متن نوشته شده بود به عنوان پراپرتی BMP انتساب دادم؛ نتیجه این شد که در MouseOver ترسیم تکه دم متن درست دیده نمیشه!
یه فضولی هم اگه اجازه بدین:من پروسیجر CreateRegion رو به این شکل دارم ناحیه رو دقیقتر تشخیص داد:

function CreateRegion(Bmp: TBitmap): HRGN;
type
TRGBArray = array[0..32767] of TRGBTriple;
pRGBArray = ^TRGBArray;
var
X, Y, StartX:Integer;
Excl: THandle;
Row: PRGBArray;
TransparentColor: TRGBTriple;
begin
Bmp.PixelFormat := pf24Bit;
Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);
for Y := 0 to Bmp.Height - 1 do
begin
Row := Bmp.Scanline[Y];
if Y = 0 then
TransparentColor := Row[0];
StartX := -1;
for X := 0 to Bmp.Width do
begin
if(X <> Bmp.Width) and
(Row[X].rgbtRed = TransparentColor.rgbtRed) and
(Row[X].rgbtGreen = TransparentColor.rgbtGreen) and
(Row[X].rgbtBlue = TransparentColor.rgbtBlue) then
begin
if StartX = -1 then
StartX := X;
end
else
begin
if StartX > -1 then
begin
Excl := CreateRectRGN(StartX, Y, X, Y + 1);
try
CombineRGN(Result, Result, Excl, RGN_DIFF);
StartX := -1;
finally
DeleteObject(Excl);
end;
end;
end;
end;
end;
end;


برای امتحان این کد رو امتحان کنین(به نظر من کامپوننت یه ظاهری باید داشته باشه و نباید خالی باشه!):

constructor TFlash2But.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetParent(TWinControl(AOwner));
Status := 0;
Width := 40;
Height := 50;
FBmp := TBitmap.Create;
FBmp.Width:=60;
FBmp.Height:=20;
FBmp.Canvas.Pen.Color:=clRed;
FBmp.Canvas.Brush.Color:=clYellow;
FBmp.Canvas.Ellipse(0,0,20,20);
FBmp.Canvas.Pen.Color:=clBlue;
FBmp.Canvas.Brush.Color:=clAqua;
FBmp.Canvas.Rectangle(23,3,37,17);
FBmp.Canvas.Pen.Color:=clGreen;
FBmp.Canvas.Brush.Color:=clLime;
FBmp.Canvas.Polygon([Point(43,3),Point(57,10),Point(43,17)]);
BmpUp := TBitmap.Create;
BmpOver := TBitmap.Create;
BmpDown := TBitmap.Create;
BitmapChanged := False;
SetBmp(FBmp);
end;