一个完整的控件(临时写的, 未测试过):
type
TMySpeedButton = class(SpeedButton)
private
FOrignBmp: TBitmap;
FMonoBmp: TBitmap;
procedure GlyphChange(Sender: TObject);
procedure MouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
protected
procedure MonoBitmap(bmp: TBitmap; TransColor, MaskColor: TColor);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
implimentation
procedure TMySpeedButton.GlyphChange(Sender: TObject);
var
n, l: Integer;
begin
if glyph.empty then
begin
NumGlyphs := 1;
exit;
end;
glyph.OnChange := nil;
l := glyph.width;
if glyph.width mod glyph.height = 0 then
begin
n := glyph.width div glyph.height;
if (n <1) or (n > 4) then n := 1;
l := glyph.width div n;
end;
forignbmp.width := l;
forignbmp.height := glyph.height;
forignbmp.canvas.draw(0,0,glyph);
fmonobmp.assign(forignbmp);
monobitmap(fmonobmp, fmonobmp.transparentcolor, clWhite);
glyph.assign(fmonobmp);
glyph.Onchange := GlyphChange;
NumGlyphs := 1;
invalidate;
end;
procedure TMySpeedButton.MouseEnter(var Msg: TMessage);
begin
inherited;
if enabled then
begin
glyph.onchange := nil;
glyph.assign(forignbmp);
glyph.onchange := glyphchange;
invalidate;
end;
end;
procedure TMySpeedButton.MouseLeave(var Msg: TMessage);
begin
inherited;
glyph.Onchange := nil;
glyph.assign(fmonobmp);
glyph.onchange := glyphChange;
invalidate;
end;
procedure MonoBitmap(bmp: TBitmap; TransColor, MaskColor: TColor);
var
i, j, c1, c2, r, g, b: LongInt;
p: Pchar;
pf:TPixelFormat;
begin
c1 := ColorToRGB(transcolor);
r := getrvalue(colortorgb(maskcolor));
g := getgvalue(colortorgb(maskcolor));
b := getbvalue(colortorgb(maskcolor));
bmp.PixelFormat := pf24bit;
for i := 0 to bmp.height-1 do
begin
p := bmp.scanline;
for j := 0 to bmp.width - 1 do
begin
if not comparemem(@c1, p, 3) then // not transparent color
begin
c2 := (byte(p^)*b + byte((p+1)^)*g + byte((p+2)^)*r) div (r+g+b);
c2 := byte(c2) + (c2 and $ff) shl 8 + (c2 and $ff) shl 16;
move(c2, p^, 3);
end;
p := p + 3;
end;
end;
bmp.pixelformat := pf;
end;
constructor TMySpeedButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fOrignBmp := TBitmap.Create;
forignbmp.pixelformat := pf24bit;
FMonoBmp := TBitmap.Create;
fmonobmp.pixelformat := pf24bit;
end;
destructor TMySpeedButton.Destroy;
begin
forignbmp.free;
fmonobmp.free;
inherited;
end;
end.