300分求一控件，如有源代码再加200分！(50分)

如题！现在描述一下此控件的需求：
该控件是一个按钮类控件，并具有如下功能：
1、可以加入图片（BMP形式既可，要是能够支持多种格式更好）；
2、要能够根据图片边缘进行裁剪（如：若该按钮载入图片为一个◎符号，则按钮相应显示为该符号形状，其余部分裁剪掉）；
3、具有TButton类所有属性及方法。
主要是现在等用而且没有时间编写，所以来这里求助，不知哪位富翁能够提供，不胜感谢！：）酬谢方法如题！

顶一下,
裁减要求有些困难

是啊！主要就是这个问题...
这个控件应该可以实现这样的功能：
比如我加三个该控件在Form上，然后载入两个同心圆环和一个同心圆（与两个圆环同心），然后这三个按钮应该可以套叠在一起，而不互相干扰。呵呵：）就要想是一组靶心形状的按钮一样，各自响应各自的事件。

哈哈，你这么高手的人都没有，估计不好找了哦！

楼上取笑了，我和大家一样也都是一个参与“游戏”的“奴隶”

看的人不多，答的人更少...

Raize里的RzShapeButton

楼上的你说的控件能够满足我所说的所有需求吗？要是可以的话发一个到我的邮箱里，如果可以马上会放分给你的：）Johnny_dm@tom.com
这个控件应该可以实现这样的功能：
比如我加三个该控件在Form上，然后载入两个同心圆环和一个同心圆（与两个圆环同心），然后这三个按钮应该可以套叠在一起，而不互相干扰。呵呵：）就要想是一组靶心形状的按钮一样，各自响应各自的事件。
以上这个要求能够满足吗？

加大力度！200改300，有源码由加100改加200！呵呵◎_◎

我有! 加Q 530678000 给你.

不可能实现自动裁减，任何一副图片都是方的，没标准程序根本没可能处理千差万别的图片，即使是人对同一图片中的主体形状认识也不一致。 手工定义形状倒是可以实现。 重载 Tbutton 的paint 方法。添加几个新的定义用的属性
画不规则窗口我以前做过 ，现在在网吧，我回去睡一觉 在上来看了。

to Miros:
我一般不用QQ的，请发到我的邮箱：Johnny_dm@tom.com 如果我看了符合我的要求，我会立即放分的（根据你是否有源码会放300分或500分），绝不食言！如果没有放分我会在这里说明没有放分的原因（如：无法在Delphi的IDE中安装或者不合我的要求（不会有附加的要求，要求都写在本帖中了！）），决不会让你糊里糊涂的拿不到分数的。谢谢！期待你的回复！thx

imageeh

to:jieking
哪里有的下载？

还是没人回答：（
看来忙完这一段工作要自己写了...
想要这个控件的先来报个名！

俺报名 zwz_good@sohu.com

用BitBtn结合异型窗体的技术好像可以达到你的要求

界面上放3个Image，里面放入3个大小一样的图片，图案在图形中间，再依次叠放三个和图片一样大小的BitBtn，设置BitBtn的Caption为空，具体代码如下：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ToolWin, ComCtrls, ExtCtrls, Buttons;

type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Image3: TImage;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function CreateRegion(wMask: TBitmap; wColor: TColor; hControl: THandle): HRGN;
end;

var
Form1: TForm1;
implementation

{$R *.dfm}

{ TForm1 }

function TForm1.CreateRegion(wMask: TBitmap; wColor: TColor;
hControl: THandle): HRGN;
var
dc, dc_c: HDC;
rgn: HRGN;
x, y: integer;
coord: TPoint;
line: boolean;
color: TColor;
begin
dc := GetWindowDC(hControl);
dc_c := CreateCompatibleDC(dc);
SelectObject(dc_c, wMask.Handle);
BeginPath(dc);
for x := 0 to wMask.Width - 1 do
begin
line := false;
for y := 0 to wMask.Height - 1 do
begin
color := GetPixel(dc_c, x, y);
if not (color = wColor) then
begin
if not line then
begin
line := true;
coord.x := x;
coord.y := y;
end;
end;
if (color = wColor) or (y = wMask.Height - 1) then
begin
if line then
begin
line := false;
MoveToEx(dc, coord.x, coord.y, nil);
LineTo(dc, coord.x, y);
LineTo(dc, coord.x + 1, y);
LineTo(dc, coord.x + 1, coord.y);
CloseFigure(dc);
end;
end;
end;
end;
EndPath(dc);
rgn := PathToRegion(dc);
ReleaseDC(hControl, dc);
Result := rgn;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
w1: TBitmap;
w2: TColor;
rgn: HRGN;
begin
w1 := TBitmap.Create;
w1.Assign(image1.Picture.Bitmap);
w2 := w1.Canvas.Pixels[0, 0];
rgn := CreateRegion(w1, w2, Handle);
if rgn <> 0 then
SetWindowRgn(BitBtn1.Handle, rgn, true);
BitBtn1.Glyph.Assign(Image1.Picture.Bitmap);

w1.Assign(image2.Picture.Bitmap);
w2 := w1.Canvas.Pixels[0, 0];
rgn := CreateRegion(w1, w2, Handle);
if rgn <> 0 then
SetWindowRgn(BitBtn2.Handle, rgn, true);
BitBtn2.Glyph.Assign(Image2.Picture.Bitmap);

w1.Assign(image3.Picture.Bitmap);
w2 := w1.Canvas.Pixels[0, 0];
rgn := CreateRegion(w1, w2, Handle);
if rgn <> 0 then
SetWindowRgn(BitBtn3.Handle, rgn, true);
BitBtn3.Glyph.Assign(Image3.Picture.Bitmap);

end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Caption:='1';
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Caption:='2';
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
Caption:='3';
end;

end.

有现成的,上面已经有人说了,楼主还没拿到的话我发给你.

邮件太大了,发不出去,请加MSN:z_y_lian@hotmail.com

unit MirosImageButton;

interface

uses
Windows,SysUtils,Classes,Graphics,Controls,Messages;


const
VNormal = 0;
VMouseOn = 1;
VMouseDown= 2;

type
bStyle = (bFFStyle, bGlyph);
TRectModle = (rRect, rRoundRect);
TJustStyle = (jsNormal, jsMouseOn, jsMouseDown);


TCustomMirosImageButton = class(TCustomControl)
private
MNormalGlyph, MMouseOnGlyph, MMouseDownGlyph : TBitmap;
MCaption : string;
MStyle : bStyle;
MJustStyle: byte;
MRectModle: TRectModle;
MRoundColor, MInnerColor, MOutColor, MThirdColor,
MFourColor, MFaceColor, MMouseOnColor, MOldColor : TColor;
MMouseDowning, MShowARound, MShowCaption, MouseOnSeted : Boolean;
FTransParent: Boolean;
FTransparentColor: TColor;
procedure CMFocusChanged(var Msg: TCMFocusChanged); message CM_FOCUSCHANGED;
public
constructor Create(AOwner : TComponent);override;
destructor Destroy;override;
procedure DrawAround();
procedure DrawSecond();
procedure DrawThird();
procedure DrawCaption;
procedure SetCaption(Cap : String);
procedure SetInnerColor(Value : TColor);
procedure SetOutColor(Value : TColor);
procedure SetThirdColor(Value : TColor);
procedure SetFourColor(Value : TColor);
procedure SetFaceColor(Value : TColor);
procedure SetRoundColor(Value : TColor);
procedure SetAround(B : Boolean);
procedure SetShowCaption(B : Boolean);
procedure SetNormalGlyph(Bmp : TBitmap);
procedure SetMouseOnGlyph(Bmp : TBitmap);
procedure SetMouseDownGlyph(Bmp : TBitmap);
procedure SetStyle(aStyle : bStyle);
procedure SetMouseOnColor(Value : TColor);
procedure CopyCanvas(Source : TBitmap);
procedure SetGlyphModle(Value : Byte);
protected
procedure Paint;override; //WM_KILLFOCUS //WM_SEFOCUS
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
procedure WMKeyDown (var Message: TWMKeyDown); message WM_KEYDOWN;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
published
property OnClick;
property Caption : string read MCaption write SetCaption;
property InnerColor : TColor read MInnerColor write SetInnerColor default $00E7EBED;
property InnerOutColor : TColor read MOutColor write SetOutColor default $00959899;
property SInnerColor : TColor read MThirdColor write SetThirdColor default $00DBE0E3;
property SInnerOutColor : TColor read MFourColor write SetFourColor default $00ADB2B4;
property FaceColor : TColor read MFaceColor write SetFaceColor default $00C9D1D5;
property ARoundColor : TColor read MRoundColor write SetRoundColor default $00000000;
property ShowAround : Boolean read MShowAround write SetARound default true;
property ShowCaption : Boolean read MShowCaption write SetShowCaption default true;
property NormalGlyph : TBitmap read MNormalGlyph write SetNormalGlyph;
property MouseOnGlyph : TBitmap read MMouseOnGlyph write SetMouseOnGlyph;
property MouseDownGlyph : TBitmap read MMouseDownGlyph write SetMouseDownGlyph;
property Style : bStyle read MStyle write SetStyle default bFFStyle;
property MouseOnColor : TColor read MMouseOnColor write SetMouseOnColor default $00000000;
property TransParent: Boolean read FTransparent write FTransparent default False;
property TransParentColor: TColor read FTransParentColor Write FTransParentColor default clFuchsia;
property Font;
property ShowHint;
property Align;
property Cursor;
property PopupMenu;
property Visible;

property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDrag;
property OnMouseLeave;//如果编译不过 请把这个注解了 D7好象不支持
property OnMouseEnter;//如果编译不过 请把这个注解了 D7好象不支持
property OnEnter; ;//如果编译不过 请把这个注解了 D7好象不支持
end;

TMirosButton = class(TCustomMirosImageButton)

public
constructor Create(AOwner : TComponent);override;
destructor Destroy;override;
published
property OnClick;
property Caption;
property InnerColor;
property InnerOutColor;
property SInnerColor;
property SInnerOutColor;
property FaceColor;
property ARoundColor;
property ShowAround;
property ShowCaption;
property NormalGlyph;
property MouseOnGlyph;
property MouseDownGlyph;
property Style;
property MouseOnColor;
property Font;
property ShowHint;
property Align;
property Cursor;
property PopupMenu;
property Visible;
property Transparent;
property TransparentColor;

property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDrag;
property OnMouseLeave;
property OnMouseEnter;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MirosButton', [TMirosButton]);
end;

constructor TCustomMirosImageButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
MNormalGlyph := TBitmap.Create;
MMouseOnGlyph := TBitmap.Create;
MMouseDownGlyph := TBitmap.Create;
MStyle := bFFStyle;
MJustStyle := 0;
MCaption := 'MirosButton';
MRectModle := rRect;
MShowARound := true;
MShowCaption := true;
MMouseDowning := false;
MMouseOnColor := $00000000;
MRoundColor := $00000000;
MInnerColor := $00E7EBED;
MOutColor := $00959899;
MThirdColor := $00DBE0E3;
MFourColor := $00ADB2B4;
MFaceColor := $00C9D1D5;
DoubleBuffered := true;
FTransParent:= False;
FTransParentColor := Graphics.clFuchsia;
end;

destructor TCustomMirosImageButton.Destroy;
begin
MNormalGlyph.Destroy;
MMouseOnGlyph.Destroy;
MMouseDownGlyph.Destroy;
inherited Destroy;
end;

constructor TMirosButton.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
end;

destructor TMirosButton.Destroy;
begin
inherited Destroy;
end;

procedure TCustomMirosImageButton.DrawAround();
begin
with Canvas do
begin
Brush.Style := bsClear;
Pen.Style := psClear;
Brush.Color := MFaceColor;
Rectangle(0,0,Width,Height);
Pen.Style := psSolid;
Brush.Style := bsSolid;
Brush.Color := MFaceColor;
Pen.Color := MRoundColor;
end;
if MShowARound then
case MRectModle of
rRect:
begin
Canvas.Rectangle(Rect(0,0 ,Width ,Height))
end;
rRoundRect:
begin
Canvas.Brush.Color := MFaceColor;
Canvas.Pen.Color := MRoundColor;
Canvas.RoundRect(0,0,Width,Height,5,5);
end;
end;
end;

procedure TCustomMirosImageButton.DrawSecond();
begin
if MMouseDowning then
Canvas.Pen.Color := MOutColor
else
Canvas.Pen.Color := MInnerColor;
case MRectModle of
rRect:
begin
Canvas.Rectangle(Rect(1,1,Width - 1,Height - 1));
if MMouseDowning then
Canvas.Pen.Color := MInnerColor
else
Canvas.Pen.Color := MOutColor;
Canvas.MoveTo(2,Height - 2);
Canvas.LineTo(Width - 2,Height - 2);
Canvas.LineTo(Width - 2, 1);
end;
rRoundRect:
begin
Canvas.Brush.Color := MFaceColor;
Canvas.Pen.Color := MInnerColor;
Canvas.RoundRect(1,1,Width - 1,Height - 1,5,5);
end;
end;
end;

procedure TCustomMirosImageButton.DrawThird();
begin
if MMouseDowning then
Canvas.Pen.Color := MFourColor
else
Canvas.Pen.Color := MThirdColor;
case MRectModle of
rRect:
begin
Canvas.Rectangle(Rect(2,2,Width - 2,Height - 2));
if MMouseDowning then
Canvas.Pen.Color := MThirdColor
else
Canvas.Pen.Color := MFourColor;
Canvas.MoveTo(3,Height - 3);
Canvas.LineTo(Width - 3,Height - 3);
Canvas.LineTo(Width - 3,2);
end;
rRoundRect:
begin
Canvas.Brush.Color := MFaceColor;
Canvas.Pen.Color := MThirdColor;
Canvas.RoundRect(2,2,Width - 2,Height - 2,5,5);
end;
end;
end;

procedure TCustomMirosImageButton.DrawCaption;
var
x, y : Integer;
begin
x := Canvas.TextWidth(MCaption);
y := Canvas.TextHeight(MCaption);
Canvas.Font.Color := Font.Color;
Canvas.Brush.Style := bsClear;
if MMouseDowning then
Canvas.TextOut((Width - x) div 2 + 1,(Height - y) div 2 + 1,MCaption)
else
Canvas.TextOut((Width - x) div 2,(Height - y) div 2,MCaption);
Canvas.Brush.Style := bsSolid;
end;

procedure TCustomMirosImageButton.Paint;
begin
DrawAround;
case MStyle of
bFFStyle:
begin
DrawSecond;
DrawThird;
end;
bGlyph:SetGlyphModle(MJustStyle);
end;
if MShowCaption then
DrawCaption;
end;

procedure TCustomMirosImageButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
case MStyle of
bFFStyle:
begin
MMouseDowning := true;
invalidate;
end;
bGlyph:
if MJustStyle <> 2 then
begin
MJustStyle := 2;
invalidate;
end;
end;
end;

procedure TCustomMirosImageButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
case MStyle of
bFFStyle:
begin
MMouseDowning := false;
invalidate;
end;
bGlyph:
if MJustStyle <> 0 then
begin
MJustStyle := 0;
invalidate;
end;
end;
end;

procedure TCustomMirosImageButton.CMFocusChanged(var Msg: TCMFocusChanged);
begin

end;

procedure TCustomMirosImageButton.WMKeyDown(var Message: TWMKey);
begin
if csDesigning in ComponentState then Exit;
if Message.CharCode = VK_SPACE then
MouseDown(mbLeft,[],0,0);
end;

procedure TCustomMirosImageButton.SetCaption(Cap: string);
begin
MCaption := Cap;
invalidate;
end;

procedure TCustomMirosImageButton.SetInnerColor(Value: TColor);
begin
MInnerColor := Value;
invalidate;
end;

procedure TCustomMirosImageButton.SetOutColor(Value: TColor);
begin
MOutColor := Value;
invalidate;
end;

procedure TCustomMirosImageButton.SetThirdColor(Value: TColor);
begin
MThirdColor := Value;
invalidate;
end;

procedure TCustomMirosImageButton.SetFourColor(Value: TColor);
begin
MFourColor := Value;
invalidate;
end;

procedure TCustomMirosImageButton.SetFaceColor(Value: TColor);
begin
MFaceColor := Value;
invalidate;
end;

procedure TCustomMirosImageButton.SetRoundColor(Value: TColor);
begin
MRoundColor := Value;
invalidate;
end;

procedure TCustomMirosImageButton.SetAround(B: Boolean);
begin
MShowAround := B;
invalidate;
end;

procedure TCustomMirosImageButton.SetShowCaption(B: Boolean);
begin
MShowCaption := B;
invalidate;
end;

procedure TCustomMirosImageButton.SetNormalGlyph(Bmp: TBitmap);
begin
MStyle := bGlyph;
MJustStyle := 0;
MNormalGlyph.Assign(Bmp);
Width := Bmp.Width;
Height := Bmp.Height;
invalidate;
end;

procedure TCustomMirosImageButton.SetMouseOnGlyph(Bmp: TBitmap);
begin
MStyle := bGlyph;
MJustStyle := 0;
MMouseOnGlyph.Assign(Bmp);
Width := Bmp.Width;
Height := Bmp.Height;
invalidate;
end;

procedure TCustomMirosImageButton.SetMouseDownGlyph(Bmp: TBitmap);
begin
MStyle := bGlyph;
MJustStyle := 0;
MMouseDownGlyph.Assign(Bmp);
Width := Bmp.Width;
Height := Bmp.Height;
invalidate;
end;

procedure TCustomMirosImageButton.SetStyle(aStyle: bStyle);
begin
MStyle := aStyle;
invalidate;
end;

procedure TCustomMirosImageButton.CMMouseEnter(var Message: TMessage);
begin
if csDesigning in ComponentState then Exit;
case MStyle of
bFFStyle:
begin
if not MouseOnSeted then
begin
MOldColor := Font.Color;
Font.Color := MMouseOnColor;
MouseOnSeted := true;
invalidate;
end;
end;
bGlyph:
if MJustStyle <> 1 then
begin
MJustStyle := 1;
invalidate;
end;
end;
end;

procedure TCustomMirosImageButton.CMMouseLeave(var Message: TMessage);
begin
if csDesigning in ComponentState then Exit;
case MStyle of
bFFStyle:
begin
if MouseOnSeted then
begin
Font.Color := MOldColor;
MouseOnSeted := false;
invalidate;
end;
end;
bGlyph:
if MJustStyle <> 0 then
begin
MJustStyle := 0;
invalidate;
end;
end;
end;

procedure TCustomMirosImageButton.SetMouseOnColor(Value: TColor);
begin
MMouseOnColor := Value;
invalidate;
end;

procedure TCustomMirosImageButton.CopyCanvas(Source: TBitmap);
var
Rec: TRect;
begin
if MShowAround then
Rec := Rect(1,1,Width - 1, Height - 1)
else Rec := ClientRect;

if FTransparent then
Canvas.BrushCopy(Rec, Source, rect(0,0,Source.Width,Source.Height), FTransparentColor)
else Canvas.CopyRect(Rec,
Source.Canvas,
rect(0,0,Source.Width,Source.Height));
end;

procedure TCustomMirosImageButton.SetGlyphModle(Value: Byte);
begin
case Value of
0:CopyCanvas(MNormalGlyph);
1:CopyCanvas(MMouseOnGlyph);
2:CopyCanvas(MMouseDownGlyph);
end;
// invalidate;
end;

end.

很久以前写了 那时还是Delphi Newer 代码有点烂 参考一下吧！