mmbmpbtn.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  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