Delphi控件源码

开发平台：
Delphi

MMBmpBtn.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: +49(0)351-8037944               =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 04.01.99 - 16:56:24 $                                        =}
{========================================================================}
unit MMBmpBtn;
{$I COMPILER.INC}
interface
uses
    Windows,
    SysUtils,
    Messages,
    Classes,
    Graphics,
    Controls,
    CommCtrl,
    ExtCtrls,
    Menus,
    Forms,
    Buttons,
    MMObj,
    MMUtils,
    MMBmpLst,
    MMObsrv;
type
    TMMButtonStyle   = (bsRegular,bsIndent,bsLight,bsDark,bsMono,bsExplorer,bsHighLight,bsNone);
    TMMButtonState   = (bsUp,bsDown,bsExclusive);
    TMMTextAlign     = (ttaTopLeft,ttaTop,ttaTopRight,ttaRight,ttaBottomRight,
                        ttaBottom,ttaBottomLeft,ttaLeft,ttaCenter);
    TMMGetGylphIndex = procedure(Sender: TObject; IsDown: Boolean; var Index: integer) of object;
    {-- TMMBitmapButton -------------------------------------------------------}
    TMMBitmapButton = class(TMMCustomBitmapListControl)
    private
       FAutoSize       : Boolean;
       FIsDown         : Boolean;
       FTextAlign      : TMMTextAlign;
       FCaption        : TCaption;
       FAutoGray       : Boolean;
       FShowDisabled   : Boolean;
       FMouseDown      : Boolean;
       FMouseInside    : Boolean;
       FShowPressed    : Boolean;
       FSpacing        : integer;
       FTempGlyph      : TBitmap;
       FFreeTempGlyph  : Boolean;
       FSaveBitmap     : TBitmap;
       FState          : TMMButtonState;
       FBorderSize     : Cardinal;
       FNumGlyphs      : integer;
       FStyle          : TMMButtonStyle;
       FInButton       : Boolean;
       FWordWrap       : Boolean;
       FStayDown       : Boolean;
       FDownIndentH    : integer;
       FDownIndentV    : integer;
       FSwitch         : Boolean;
       FDoubleBuffer   : Boolean;
       FAllowRightMouse: Boolean;
       {$IFDEF BUILD_ACTIVEX}
       FTimer          : TTimer;
       {$ENDIF}
       FOnGetGlyphIndex: TMMGetGylphIndex;
       FOnMouseEnter   : TNotifyEvent;
       FOnMouseExit    : TNotifyEvent;
       procedure SetDoubleBuffer(Value: Boolean);
       procedure SetAutoSize(Value: Boolean);
       procedure SetAutoGray(aValue: Boolean);
       procedure SetShowDisabled(aValue: Boolean);
       procedure SetStayDown(aValue: Boolean);
       procedure SetWordWrap(aValue: Boolean);
       procedure SetSpacing(aValue: integer);
       procedure SetTextAlign(aValue: TMMTextAlign);
       procedure SetCaption(aValue: TCaption);
       procedure SetNumGlyphs(aValue: integer);
       procedure SetButtonStyle(aValue: TMMButtonStyle);
       procedure SetBorderWidth(aValue: Cardinal);
       procedure SetDownIndent(index, aValue: integer);
       procedure DetectNumGlyphs;
       function  GetSrcRect(index: integer): TRect;
       procedure PrepareGlyphs;
       {$IFDEF BUILD_ACTIVEX}
       procedure DoMouseTimer(Sender: TObject);
       {$ENDIF}
       function  InBtn(X,Y: Integer): Boolean;
       procedure DrawTheText(Canvas: TCanvas; aRect: TRect);
       procedure DrawTheBitmap(Canvas: TCanvas; aRect:TRect);
       procedure DrawTheButton(Canvas: TCanvas);
       procedure PaintButton(Canvas: TCanvas);
       procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
       procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
       procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
       procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
       procedure CMTransColorChanged(var Message: TMessage); message CM_TRANSCOLORCHANGED;
    protected
       procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
       procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
       procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
       procedure Paint; override;
       procedure Loaded; override;
       procedure BitmapChanged; override;
    public
       constructor Create(AOwner: TComponent); override;
       destructor  Destroy; override;
       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
       procedure RedrawButton;
       property State: TMMButtonState read FState;
    published
       property OnClick;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnDragDrop;
       property OnDragOver;
       property OnEndDrag;
       property OnStartDrag;
       property OnGetGlyphIndex: TMMGetGylphIndex read FOnGetGlyphIndex write FOnGetGlyphIndex;
       property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
       property OnMouseExit:  TNotifyEvent read FOnMouseExit  write FOnMouseExit;
       property Enabled;
       property Font;
       property ParentFont;
       property ParentShowHint;
       property ShowHint;
       property Visible;
       property Color;
       property DragCursor;
       property ParentColor;
       property PopupMenu;
       property Transparent default True;
       property TransparentColor;
       property TransparentMode;
       property BitmapList;
       property BitmapIndex;
       property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
       property AutoGray: Boolean read FAutoGray write SetAutoGray default True;
       property ShowDisabled: Boolean read FShowDisabled write SetShowDisabled default True;
       property BorderWidth: Cardinal read FBorderSize write SetBorderWidth default 1;
       property Caption: TCaption read FCaption write SetCaption;
       property Down: Boolean read FStayDown write SetStayDown default False;
       property DownIndentHoriz: integer index 0 read FDownIndentH write SetDownIndent default 1;
       property DownIndentVert: integer index 1 read FDownIndentV write SetDownIndent default 1;
       property ButtonStyle: TMMButtonStyle read FStyle write SetButtonStyle default bsExplorer;
       property NumGlyphs: integer read FNumGlyphs write SetNumGlyphs default 1;
       property ShowPressed: Boolean read FShowPressed write FShowPressed default True;
       property Switch: Boolean read FSwitch write FSwitch default False;
       property Spacing: integer read FSpacing write SetSpacing default 2;
       property TextAlign: TMMTextAlign read FTextAlign write SetTextAlign default ttaCenter;
       property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
       property DoubleBuffer: Boolean read FDoubleBuffer write SetDoubleBuffer default False;
       property AllowRightMouse: Boolean read FAllowRightMouse write FAllowRightMouse default False;
  end;
implementation
{------------------------------------------------------------------------------}
procedure CreateMonoBitmap(Bitmap: TBitmap; R,G,B: integer);
var
   i,j: integer;
   Clr: Longint;
begin
   { create a grayed version of a color bitmap }
   if not Bitmap.Empty then
   with Bitmap do
   for i := 0 to Width do
   begin
      for j := 0 to Height do
      begin
         Clr := Canvas.Pixels[i,j];
         Clr := (GetRValue(Clr)*R + GetGValue(Clr)*G + GetBValue(Clr)*B) div (R+G+B);
         Canvas.Pixels[i,j] := RGB(Clr,Clr,Clr);
      end;
   end;
end;
{------------------------------------------------------------------------------}
procedure CreateDisabledBitmap(Bitmap: TBitmap);
const
     ROP_DSPDxax = $00E20746;
var
   MonoBmp,TmpImage: TBitmap;
   W,H: integer;
begin
   { create a disabled bitmap from a regular one, works best when bitmap  }
   { has been reduced to a few colors.                                    }
   if not Bitmap.Empty then
   begin
      MonoBmp  := TBitmap.Create;
      TmpImage := TBitmap.Create;
      try
         W := Bitmap.Width;
         H := Bitmap.Height;
         with TmpImage do
         begin
            Width := W;
            Height := H;
            Canvas.Brush.Color := clBtnFace;
         end;
         with MonoBmp do
         begin
            Assign(Bitmap);
            Canvas.Font.Color := clWhite;
            Canvas.Brush.Color := clBlack;
            Monochrome := True;
         end;
         with TmpImage.Canvas do
         begin
            Brush.Color := clBtnFace;
            FillRect(Rect(0,0,W,H));
            Brush.Color := clBtnHighLight;
            SetTextColor(Handle, clBlack);
            SetBkColor(Handle, clWhite);
            BitBlt(Handle, 1, 1, W+1, H+1,MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
            Brush.Color := clBtnShadow;
            SetTextColor(Handle, clBlack);
            SetBkColor(Handle, clWhite);
            BitBlt(Handle, 0, 0, W, H,MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
         end;
         Bitmap.Assign(TmpImage);
      finally
         MonoBmp.Free;
         TmpImage.Free;
      end;
   end;
end;
{------------------------------------------------------------------------------}
procedure CreateBWBitmap(Bitmap: TBitmap);
var
   i,j,W,H: integer;
   Clr: TColor; Col: Longint;
begin
   { create a disabled bitmap by changing all colors to either black or }
   { Clr and then running it through DisabledBitmap                     }
   if not Bitmap.Empty then
   begin
      W   := Bitmap.Width;
      H   := Bitmap.Height;
      Clr := Bitmap.Canvas.Pixels[0,0];// TODO: ev. hier unterstes Pixel nehmen
      for i := 0 to W do
      begin
         for j := 0 to H do
         begin
            Col := Bitmap.Canvas.Pixels[i,j];
            if (Col <> clWhite) and (Col <> Clr) then
                Col := clBlack
            else
                Col := Clr;
            Bitmap.Canvas.Pixels[i,j] := Col;
         end;
      end;
      CreateDisabledBitmap(Bitmap);
   end;
end;
{== TMMBitmapButton ===========================================================}
constructor TMMBitmapButton.Create(AOwner: TComponent);
begin
   FTempGlyph      := nil;
   FFreeTempGlyph  := False;
   FSaveBitmap     := nil;
   inherited Create(AOwner);
   ControlStyle    := ControlStyle - [csOpaque,csDoubleClicks,csClickEvents];
   FNumGlyphs      := 1;
   FState          := bsUp;
   FMouseInside    := False;
   FAutoGray       := True;
   FShowDisabled   := True;
   FShowPressed    := True;
   FBorderSize     := 1;
   FStayDown       := False;
   FSpacing        := 2;
   FMouseDown      := False;
   FTextAlign      := ttaCenter;
   FInButton       := False;
   FWordwrap       := False;
   FStyle          := bsExplorer;
   FIsDown         := False;
   FDownIndentH    := 1;
   FDownIndentV    := 1;
   FSwitch         := False;
   FDoubleBuffer   := False;
   FAllowRightMouse:= False;
   Transparent   := True;
   SetBounds(0,0,40,40);
end;
{-- TMMBitmapButton -----------------------------------------------------------}
destructor TMMBitmapButton.Destroy;
begin
   if (FSaveBitmap <> nil) then
   begin
      FSaveBitmap.Free;
      FSaveBitmap := nil;
   end;
   if FFreeTempGlyph and (FTempGlyph <> nil) then
   begin
      FTempGlyph.Free;
      FTempGlyph := nil;
      FFreeTempGlyph := False;
   end;
   {$IFDEF BUILD_ACTIVEX}
   if (FTimer <> nil) then
   begin
      FTimer.Free;
      FTimer := nil;
   end;
   {$ENDIF}
   inherited Destroy;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.BitmapChanged;
begin
   if BitmapValid then DetectNumGlyphs;
   PrepareGlyphs;
   inherited BitmapChanged;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
begin
   if ((Width <> aWidth) or (Height <> aHeight)) and (FSaveBitmap <> nil) then
   begin
      FSaveBitmap.Width  := aWidth;
      FSaveBitmap.Height := 2*aHeight;
   end;
   inherited SetBounds(aLeft, aTop, aWidth, aHeight);
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetDoubleBuffer(Value: Boolean);
begin
   if (Value <> FDoubleBuffer) or (Value and (FSaveBitmap = nil)) then
   begin
      FDoubleBuffer := Value;
      if not FDoubleBuffer then
      begin
         if (FSaveBitmap <> nil) then
         begin
            FSaveBitmap.Free;
            FSaveBitmap := nil;
            Repaint;
         end;
      end
      else if not (csDesigning in ComponentState) and
              not (csReading in ComponentState) and
              not (csLoading in ComponentState) then
      begin
         if (FSaveBitmap = nil) then
         begin
            FSaveBitmap := TBitmap.Create;
            FSaveBitmap.Width  := Width;
            FSaveBitmap.Height := 2*Height;
            Repaint;
         end;
      end;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.PrepareGlyphs;
var
   Bmp,Glyph: TBitmap;
   TmpWidth,Cnt: integer;
   Dest,Source: TRect;
begin
   if (csLoading in ComponentState) or
      (csReading in ComponentState) or
      (csDestroying in ComponentState) then exit;
   if (Bitmap <> nil) and not Bitmap.Empty then
   begin
      Glyph := Bitmap;
      TmpWidth := Glyph.Width div FNumGlyphs;
      if AutoSize and (TmpWidth > 0) and (Glyph.Height > 0) then
         SetBounds(Left, Top, TmpWidth, Glyph.Height);
      Cnt := FNumGlyphs;
      if (FNumGlyphs = 1) or
         (((ButtonStyle = bsExplorer) or (ButtonStyle = bsHighLight)) and FAutoGray) then
            inc(Cnt,2);
      if (Cnt > FNumGlyphs) then
      begin
         if (FTempGlyph = nil) or not FFreeTempGlyph then
         begin
            FTempGlyph := TBitmap.Create;
            FFreeTempGlyph := True;
         end;
         FTempGlyph.Width := Cnt*TmpWidth;
         FTempGlyph.Height := Glyph.Height;
         FTempGlyph.HandleType := Bitmap.HandleType;
         { create the Temp Glyph }
         FTempGlyph.Canvas.Draw(0,0,Glyph);
         Bmp := TBitmap.Create;
         try
            Bmp.Width := TmpWidth;
            Bmp.Height := Glyph.Height;
            Dest := GetSrcRect(FNumGlyphs);
            Source := GetSrcRect(0);
            Bmp.Canvas.CopyRect(Source,Glyph.Canvas,Source);
            { create the disabled and grayed bitmaps too }
            CreateMonoBitmap(Bmp,11,59,30);
            FTempGlyph.Canvas.CopyRect(Dest,Bmp.Canvas,Source);
            Dest := GetSrcRect(FNumGlyphs+1);
            Bmp.Canvas.CopyRect(Source,Glyph.Canvas,Source);
            CreateBWBitmap(Bmp);
            FTempGlyph.Canvas.CopyRect(Dest,Bmp.Canvas,Source);
         finally
            Bmp.Free;
         end;
      end
      else
      begin
         if (FTempGlyph <> nil) and FFreeTempGlyph then
         begin
            FTempGlyph.Free;
            FTempGlyph := nil;
         end;
         FFreeTempGlyph := False;
         FTempGlyph := Glyph;
      end;
      Invalidate;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.Loaded;
begin
   inherited Loaded;
   PrepareGlyphs;
   SetDoubleBuffer(FDoubleBuffer);
end;
{-- TMMBitmapButton -----------------------------------------------------------}
function TMMBitmapButton.GetSrcRect(index: integer): TRect;
begin
   Result.Left := index * (Bitmap.Width div FNumGlyphs);
   Result.Top := 0;
   Result.Right := (index+1) * (Bitmap.Width div FNumGlyphs);
   Result.Bottom := Bitmap.Height;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.DetectNumGlyphs;
begin
   if (csLoading in ComponentState) or
      (csReading in ComponentState) or
      (csDestroying in ComponentState) then exit;
   if BitmapValid and (Bitmap.Height > 0) and (FNumGlyphs = 1) then
   with Bitmap do
   begin
      if Width mod Height = 0 then
      begin
         FNumGlyphs := Min(Width div Height,4);
      end;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetNumGlyphs(aValue: integer);
begin
   if (FNumGlyphs <> aValue) then
   begin
      FNumGlyphs := Max(aValue,1);
      PrepareGlyphs;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetAutoSize(Value: Boolean);
begin
   FAutoSize := Value;
   PrepareGlyphs;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetAutoGray(aValue: Boolean);
begin
   if (aValue <> FAutoGray) then
   begin
      FAutoGray := aValue;
      PrepareGlyphs;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetShowDisabled(aValue: Boolean);
begin
   if (aValue <> FShowDisabled) then
   begin
      FShowDisabled := aValue;
      Invalidate;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetButtonStyle(aValue: TMMButtonStyle);
begin
   if (FStyle <> aValue) then
   begin
      FStyle := aValue;
      PrepareGlyphs;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetCaption(aValue: TCaption);
begin
   if (FCaption <> aValue) then
   begin
      FCaption := aValue;
      Invalidate;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetBorderWidth(aValue: Cardinal);
begin
   if (FBorderSize <> aValue) then
   begin
      FBorderSize := aValue;
      Invalidate;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetStayDown(aValue: Boolean);
begin
   if (FStayDown <> aValue) then
   begin
      FStayDown := aValue;
      if FStayDown then
      begin
         FMouseDown := True;
         FState := bsDown;
      end
      else
      begin
         FMouseDown := False;
         FState := bsUp;
      end;
      Refresh;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetWordWrap(aValue: Boolean);
begin
   if (FWordWrap <> aValue) then
   begin
      FWordwrap := aValue;
      Invalidate;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetSpacing(aValue: integer);
begin
   if (aValue <> FSpacing) then
   begin
      FSpacing := aValue;
      Invalidate;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetTextAlign(aValue: TMMTextAlign);
begin
   if (FTextAlign <> aValue) then
   begin
      FTextAlign := aValue;
      Invalidate;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.SetDownIndent(index, aValue: integer);
begin
   aValue := Max(aValue,0);
   case index of
       0: if FDownIndentH = aValue then exit else FDownIndentH := aValue;
       1: if FDownIndentV = aValue then exit else FDownIndentV := aValue;
   end;
   Invalidate;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.CMDialogChar(var Message: TCMDialogChar);
begin
   { Handle speedkeys (Alt + key) }
   with Message do
   if IsAccel(CharCode, FCaption) and Enabled then
   begin
      Click;
      Result := 1;
   end
   else inherited;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.CMTransColorChanged(var message: TMessage);
begin
   PrepareGlyphs;
   inherited;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.CMEnabledChanged(var Message: TMessage);
begin
   if not Enabled then
   begin
      FState     := bsUp;
      FMousedown := False;
      FIsDown    := False;
      FInButton  := False;
   end;
   Repaint;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.CMMouseEnter(var Msg: TMessage);
begin
   if Enabled and not FStayDown then
   begin
      FInButton := True;
      if (ButtonStyle = bsExplorer) or (ButtonStyle = bsHighLight) then RedrawButton;
      if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.CMMouseLeave(var msg: TMessage);
begin
   if Enabled and not FStayDown then
   begin
      FInButton := False;
      if (ButtonStyle = bsExplorer) or (ButtonStyle = bsHighLight) then RedrawButton;
      if Assigned(FOnMouseExit) then FOnMouseExit(Self);
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
function TMMBitmapButton.InBtn(X, Y: Integer): Boolean;
begin
   Result := PtInRect(ClientRect,Point(X,Y));
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
   Pt: TPoint;
   Msg: TMsg;
begin
   if (Button = mbLeft) or (AllowRightMouse and (Button = mbRight)) then
   begin
      if not Enabled or FIsDown then exit;
      MouseCapture := True;
      FIsDown := True;
      if InBtn(X,Y) then
      begin
         FMouseDown := True;
         FState := bsDown;
         RedrawButton;
      end;
      inherited MouseDown(Button,Shift,X,Y);
      if Assigned(PopUpMenu) and PopupMenu.AutoPopup then
      begin
         { calc where to put menu }
         Pt := ClientToScreen(Point(0, Height+2));
         PopupMenu.PopupComponent := Self;
         PopUpMenu.Popup(Pt.X, Pt.Y);
         { wait 'til menu is done }
         while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do;
         { release button }
         MouseUp(Button,Shift,X,Y);
         MouseCapture := False;
      end;
   end
   else inherited MouseDown(Button,Shift,X,Y);
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if (Button = mbLeft) or (AllowRightMouse and (Button = mbRight)) then
   begin
      if not Enabled or not FIsDown then exit;
      FIsDown := False;
      FMouseDown := False;
      if not FStayDown then FState := bsUp;
      FInButton := InBtn(X,Y);
      if not Switch then
      begin
         RedrawButton;
      end
      else if FInButton then
      begin
         SetStayDown(not FStayDown);
      end;
      inherited MouseUp(Button,Shift,X,Y);
      MouseCapture := False;
      if FInButton then Click;
   end
   else inherited MouseUp(Button,Shift,X,Y);
end;
{$IFDEF BUILD_ACTIVEX}
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.DoMouseTimer(Sender: TObject);
var
   P: TPoint;
begin
  GetCursorPos(P);
  if (FindDragTarget(P, True) <> Self) then
  begin
     FTimer.Free;
     FTimer := nil;
     Perform(CM_MOUSELEAVE, 0, 0);
  end;
end;
{$ENDIF}
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
   {$IFDEF BUILD_ACTIVEX}
   if InBtn(X,Y) then
   begin
      if (FTimer = nil) then
      begin
         FTimer := TTimer.Create(Self);
         FTimer.Interval := 50;
         FTimer.OnTimer := DoMouseTimer;
         Perform(CM_MOUSEENTER, 0, 0);
      end;
   end;
   {$ENDIF}
   inherited MouseMove(Shift,X,Y);
   if FMouseDown and not FStayDown then
   begin
      if not InBtn(X,Y) then
      begin
         if FState = bsDown then { mouse has slid off, so release }
         begin
            FState := bsUp;
            RedrawButton;
         end;
      end
      else
      begin
         if FState = bsUp then { mouse has slid back on, so push }
         begin
            FState := bsDown;
            RedrawButton;
         end;
      end;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.RedrawButton;
begin
   if not Visible then exit;
   if (csDesigning in ComponentState) then Repaint
   else
   begin
      if (FSaveBitmap <> nil) then
      begin
         { first copy the background to our bitmap }
         FSaveBitmap.Canvas.CopyRect(Rect(0,0,Width,Height),
                                     FSaveBitmap.Canvas,
                                     Rect(0,Height,Width,2*Height));
         { now draw the button to the bitmap }
         PaintButton(FSaveBitmap.Canvas);
         { copy to screen }
         Canvas.Draw(0,0,FSaveBitmap);
      end
      else PaintButton(Canvas);
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.DrawTheText(Canvas: TCanvas; aRect: TRect);
var
   Flags,MidX,MidY: Integer;
   DC: THandle;
   TmpRect:TRect;
begin
   Canvas.Font := Self.Font;
   DC := Canvas.Handle; { reduce calls to GetHandle }
   if FWordWrap then
      Flags := DT_WORDBREAK or DT_END_ELLIPSIS
   else
      Flags := DT_SINGLELINE or DT_END_ELLIPSIS;
   TmpRect := Rect(0,0,Width,Height);
   { calculate width and height of text: }
   DrawText(DC, PChar(FCaption), Length(FCaption), TmpRect, Flags or DT_CALCRECT);
   MidY := TmpRect.Bottom - TmpRect.Top;
   MidX := TmpRect.Right-TmpRect.Left;
   Flags := DT_CENTER or DT_END_ELLIPSIS;
   case TextAlign of
      ttaTop        : OffsetRect(TmpRect,Width div 2-MidX div 2,aRect.Top - MidY - Spacing);
      ttaTopLeft    : OffsetRect(TmpRect,Spacing,aRect.Top - MidY - Spacing);
      ttaTopRight   : OffsetRect(TmpRect,Width - TmpRect.Right - Spacing,aRect.Top - MidY - Spacing);
      ttaBottom     : OffsetRect(TmpRect,Width div 2-MidX div 2,aRect.Bottom + Spacing);
      ttaBottomLeft : OffsetRect(TmpRect,Spacing,aRect.Bottom + Spacing);
      ttaBottomRight: OffsetRect(TmpRect,Width - MidX - Spacing,aRect.Bottom + Spacing);
      ttaCenter     : OffsetRect(TmpRect,Width div 2 - MidX div 2,Height div 2 - MidY div 2);
      ttaRight      : OffsetRect(TmpRect,Width  - MidX - Spacing,Height div 2 - MidY div 2);
      ttaLeft       : OffsetRect(TmpRect,Spacing,Height div 2 - MidY div 2);
   end;
   if FWordWrap then
      Flags := Flags or DT_WORDBREAK or DT_NOCLIP
   else
      Flags := Flags or DT_SINGLELINE or DT_NOCLIP;
   if ((FState = bsDown) and FShowPressed) then
       OffsetRect(TmpRect,FDownIndentH,FDownIndentV);
   SetBkMode(DC,Windows.TRANSPARENT);
   if not Enabled then
   begin
      { draw disabled text }
      SetTextColor(DC,ColorToRGB(clBtnHighLight));
      OffsetRect(TmpRect,1,1);
      DrawText(DC, PChar(FCaption), Length(FCaption), TmpRect, Flags);
      OffsetRect(TmpRect,-1,-1);
      SetTextColor(DC,ColorToRGB(clBtnShadow));
   end
   else SetTextColor(DC,Self.Font.Color);
   DrawText(DC, PChar(FCaption), Length(FCaption), TmpRect, Flags);
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.DrawTheBitmap(Canvas: TCanvas; aRect:TRect);
var
   index: integer;
   SrcRect: TRect;
begin
   if BitmapValid and (FTempGlyph <> nil) then
   begin
     Index := -1;
     if assigned(FOnGetGlyphIndex) then
     begin
        FOnGetGlyphIndex(Self, FState = bsDown, Index);
     end;
     if (Index = -1) then
     begin
        Index := 0;
        case FNumGlyphs of   {normal,disabled,down,down }
           2: if not Enabled then Index := 1;
           3: if not Enabled then
                 Index := 1
              else if (FState = bsDown) then
                 Index := 2;
           4: if not Enabled then
                 Index := 1
              else if FStayDown then
                 Index := 3
              else if (FState = bsDown) then
                 Index := 2;
        end;
        { do we need the grayed bitmap ? }
        if ((ButtonStyle = bsExplorer) or (ButtonStyle = bsHighLight)) and Enabled then
        begin
           if not FStayDown and not FInButton and FShowDisabled then
           begin
              if FAutoGray then
                 Index := FNumGlyphs
              else if (FNumGlyphs > 1) then
                 Index := 1;
           end;
        end;
        { do we need the disabled bitmap ? }
        if not Enabled and (FNumGlyphs = 1) then Index := FNumGlyphs+1;
     end;
     SrcRect := GetSrcRect(index);
     if ((FState = bsDown) and FShowPressed) then
          OffsetRect(aRect,FDownIndentH,FDownIndentV);
     if Transparent then
     begin
        DrawTransparentBitmapEx(Canvas.Handle, FTempGlyph.Handle,
                                aRect.Left, aRect.Top,
                                SrcRect,
                                GetTransparentColor);
     end
     else
     begin
        DrawTransparentBitmapEx(Canvas.Handle, FTempGlyph.Handle,
                                aRect.Left, aRect.Top,
                                SrcRect,
                                GetTransparentColorEx(FTempGlyph.Handle,Point(Index*Bitmap.Width div FNumGlyphs,FTempGlyph.Height)));
     end;
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.DrawTheButton(Canvas: TCanvas);
var
   Dest: TRect;
   TmpWidth,TmpHeight: integer;
begin
   with Canvas do
   begin
      TmpWidth := 0;
      TmpHeight := 0;
      { find glyph bounding rect - adjust according to textalignment}
      if BitmapValid then
      begin
         TmpWidth := Bitmap.Width div NumGlyphs;
         if TmpWidth <= 0 then TmpWidth := Bitmap.Width;
         TmpHeight := Bitmap.Height;
      end;
      { do top }
      if TextAlign in [ttaBottomLeft,ttaBottom,ttaBottomRight] then
         Dest.Top := Spacing
      else if TextAlign in [ttaTopLeft,ttaTop,ttaTopRight] then
         Dest.Top := Height - TmpHeight - Spacing
      else
         Dest.Top :=  (Height - TmpHeight) div 2;
      if (TextAlign = ttaLeft) then               { left }
          Dest.Left := Width - TmpWidth- Spacing
      else if TextAlign = ttaRight then           { right }
          Dest.Left := Spacing
      else                                        { center }
          Dest.Left := (Width - TmpWidth) div 2;
      Dest.Bottom:= Dest.Top + TmpHeight;
      Dest.Right := Dest.Left + TmpWidth;
      if BitmapValid then DrawTheBitmap(Canvas,Dest);
      { finally, do the caption }
      if Length(FCaption) > 0 then DrawTheText(Canvas,Dest);
   end;
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.PaintButton(Canvas: TCanvas);
var
   TmpRect: TRect;
begin
   TmpRect := Rect(0,0,Width,Height);
   { draw the outline }
   with Canvas do
   begin
      Brush.Color := Color;
      Pen.Color   := clBlack;
      Pen.Width   := BorderWidth;
      case ButtonStyle of
        bsNone,
        bsHighLight:
        begin
           if not Transparent then
              FillRect(Rect(0,0,Width,Height));
           if (csDesigning in ComponentState) then
           begin
              Brush.Style := bsClear;
              Pen.Style   := psDot;
              Pen.Width   := 1;
              Rectangle(TmpRect.Left,TmpRect.Top,TmpRect.Right,TmpRect.Bottom);
              Pen.Style := psSolid;
              Brush.Style := bsSolid;
           end;
        end;
        bsExplorer:
        begin
           if not Transparent then
              FillRect(Rect(0,0,Width,Height));
           if (csDesigning in ComponentState) then
              Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnShadow,1);
        end;
        bsRegular:
        begin
           { draw outline }
           Pen.Color := clBlack;
           if not Transparent then
              Rectangle(1,1,Width,Height)
           else
           begin
              TmpRect := Rect(1,1,Width,Height);
              Frame3D(Canvas,TmpRect,clBlack,clBlack,BorderWidth);
           end;
        end;
        bsIndent:
        begin
           { draw outline }
           Pen.Color := clBtnShadow;
           if not Transparent then
              Rectangle(0,0,Width-1,Height-1)
           else
           begin
              TmpRect := Rect(0,0,Width-1,Height-1);
              Frame3D(Canvas,TmpRect,clBtnShadow,clBtnShadow,BorderWidth)
           end;
           TmpRect := Rect(1,1,Width,Height);
           Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnHighLight,BorderWidth);
        end;
        bsLight:
        begin
           if not Transparent then
              FillRect(Rect(0,0,Width,Height));
           if (csDesigning in ComponentState) then
              Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnShadow,1);
        end;
        bsDark:
        begin
           if not Transparent then
              FillRect(Rect(0,0,Width,Height));
           if (csDesigning in ComponentState) then
              Frame3D(Canvas,TmpRect,clBtnFace,cl3DDkShadow,1);
        end;
        bsMono:
        begin
           if not Transparent then
              FillRect(Rect(0,0,Width,Height));
           if (csDesigning in ComponentState) then
              Frame3D(Canvas,TmpRect,clBtnHighLight,cl3DDkShadow,1);
        end;
      end;
      TmpRect := Rect(1,1,Width-1,Height-1);
      if (FState = bsDown) then
      begin
         if not (ButtonStyle = bsNone) or (ButtonStyle = bsHighLight) then
         begin
            InflateRect(TmpRect,1,1);
            case ButtonStyle of
                bsRegular : if ShowPressed then
                            begin
                               Frame3D(Canvas,TmpRect,clBlack,clBtnHighLight,BorderWidth);
                               Frame3D(Canvas,TmpRect,clBtnShadow,clBtnFace,BorderWidth);
                            end;
                bsExplorer: if FInButton or FStayDown then
                            begin
                               if ShowPressed then
                                  Frame3D(Canvas,TmpRect,clBtnShadow,clBtnHighLight,BorderWidth)
                               else
                                  Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnShadow,BorderWidth);
                            end;
                bsIndent  : if ShowPressed then
                            begin
                               Frame3D(Canvas,TmpRect,clBlack,clBtnHighLight,BorderWidth);
                               Frame3D(Canvas,TmpRect,clBtnShadow,clBtnFace,BorderWidth);
                            end;
                bsLight   : if ShowPressed then
                               Frame3D(Canvas,TmpRect,clBtnShadow,clBtnHighLight,1);
                bsDark    : if ShowPressed then
                               Frame3D(Canvas,TmpRect,cl3DDkShadow,clBtnFace,1);
                bsMono    : if ShowPressed then
                               Frame3D(Canvas,TmpRect,cl3DDkShadow,clBtnHighLight,1);
            end;
         end;
      end;
      if (FState = bsUp) then
      begin
         InflateRect(TmpRect,1,1);
         case ButtonStyle of
             bsRegular :
             begin
                Frame3D(Canvas,TmpRect,clBtnHighLight,clBlack,BorderWidth);
                Frame3D(Canvas,TmpRect,clBtnFace,clBtnShadow,BorderWidth);
             end;
             bsExplorer: if FInButton then
                            Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnShadow,BorderWidth);
             bsIndent  : Frame3D(Canvas,TmpRect,clBtnShadow,clBtnHighLight,BorderWidth);
             bsLight   : Frame3D(Canvas,TmpRect,clBtnHighLight,clBtnShadow,1);
             bsDark    : Frame3D(Canvas,TmpRect,clBtnFace,cl3DDkShadow,1);
             bsMono    : Frame3D(Canvas,TmpRect,clBtnHighLight,cl3DDkShadow,1);
         end;
      end;
   end;
   { repaint rest }
   IntersectClipRect(Canvas.Handle,0,0,Width,Height);
   DrawTheButton(Canvas);
   //ExcludeClipRect(Canvas.Handle,0,0,Width,Height);
end;
{-- TMMBitmapButton -----------------------------------------------------------}
procedure TMMBitmapButton.Paint;
begin
   if not (csDesigning in ComponentState) and (FSaveBitmap <> nil) then
   begin
      { save the actual background }
      FSaveBitmap.Canvas.CopyRect(Rect(0,Height,Width,2*Height),Canvas,ClientRect);
   end;
   PaintButton(Canvas);
end;
end.

						