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

[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;