mmcheck.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/mmtools.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: 31.03.98 - 17:56:55 $                                        =}
{========================================================================}
unit MMCheck;

{$I COMPILER.INC}

interface

uses
    Windows,
    Messages,
    SysUtils,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    StdCtrls,
    Buttons,
    MMObj,
    MMUtils,
    MMBmpLst,
    MMObsrv;

type
  TMargin = 1..25;

  TMMFontStyle = class(TPersistent)
  private
    FColor : TColor;
    FStyle : TFontStyles;
    FParent: TControl;

    procedure SetColor(Value: TColor);
    procedure SetStyle(Value: TFontStyles);

  public
    property Parent: TControl read FParent write FParent;

  published
    property Color: TColor read FColor write SetColor;
    property Style: TFontStyles read FStyle write SetStyle;
  end;

  {-- TMMBitmapRadioButton ----------------------------------------------------}
  TMMBitmapRadioButton = class(TMMCustomBitmapListControl)
  private
    FFontActive       : TMMFontStyle;
    FFontInActive     : TMMFontStyle;
    FAlignment        : TLeftRight;

    FSaveBitmap       : TBitmap;
    FNumGlyphs        : TNumGlyphs;
    FMargin           : TMargin;

    FChecked          : Boolean;
    FHasMouse         : Boolean;
    FMouseIsDown      : Boolean;
    FMouseOver        : Boolean;

    procedure SetAlignment(aValue: TLeftRight);
    procedure SetChecked(aValue: boolean);
    procedure SetMargin(aValue: TMargin);
    procedure SetNumGlyphs(aValue: TNumGlyphs);
    function  GetSrcRect(index: integer): TRect;
    procedure DetectNumGlyphs;
    procedure PaintControl(Canvas: TCanvas);
    procedure Redraw;

    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMEnabledChanged(var Message: TWMNoParams); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMTextChanged(var Message: TWMNoParams); message CM_TEXTCHANGED;
    procedure CMVisibleChanged(var Message: TWMNoParams); message CM_VISIBLECHANGED;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;

  protected
    procedure Click; override;
    procedure DblClick; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure Paint; override;
    procedure BitmapChanged; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;

    property Caption;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;

    property Transparent default True;
    property TransparentColor;
    property TransparentMode;
    property BitmapList;
    property BitmapIndex;

    property AllowMouseOver: Boolean read FMouseOver write FMouseOver default False;
    property FontActive: TMMFontStyle read FFontActive write FFontActive;
    property FontInactive: TMMFontStyle read FFontInactive write FFontInactive;
    property Alignment: TLeftRight read FAlignment write SetAlignment default taLeftJustify;
    property Checked: boolean read FChecked write SetChecked default false;
    property Margin: TMargin read FMargin write SetMargin default 7;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 4;
  end;

  {-- TMMBitmapCheckBox -------------------------------------------------------}
  TMMBitmapCheckBox = class(TMMCustomBitmapListControl)
  private
    FFontActive       : TMMFontStyle;
    FFontInActive     : TMMFontStyle;
    FAlignment        : TLeftRight;
    FAllowGrayed      : Boolean;
    FState            : TCheckBoxState;
    FSaveBitmap       : TBitmap;

    FNumGlyphs        : TNumGlyphs;
    FMargin           : TMargin;

    FChecked          : Boolean;
    FHasMouse         : Boolean;
    FMouseIsDown      : Boolean;
    FMouseOver        : Boolean;

    procedure SetAlignment(aValue: TLeftRight);
    procedure SetAllowGrayed(aValue: Boolean);
    procedure SetChecked(aValue: Boolean);
    procedure SetState(aValue: TCheckBoxState);

    procedure SetMargin(aValue: TMargin);
    procedure SetNumGlyphs(aValue: TNumGlyphs);
    function  GetSrcRect(index: integer): TRect;
    procedure DetectNumGlyphs;
    procedure PaintControl(Canvas: TCanvas);
    procedure Redraw;

    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMEnabledChanged(var Message: TWMNoParams); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMTextChanged(var Message: TWMNoParams); message CM_TEXTCHANGED;
    procedure CMVisibleChanged(var Message: TWMNoParams); message CM_VISIBLECHANGED;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;

  protected
    procedure Click; override;
    procedure DblClick; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure Paint; override;
    procedure BitmapChanged; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;

    property Caption;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Hint;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;

    property Transparent default True;
    property TransparentColor;
    property TransparentMode;
    property BitmapList;
    property BitmapIndex;

    property AllowMouseOver: Boolean read FMouseOver write FMouseOver default False;
    property FontActive: TMMFontStyle read FFontActive write FFontActive;
    property FontInactive: TMMFontStyle read FFontInactive write FFontInactive;
    property Alignment: TLeftRight read FAlignment write SetAlignment default taLeftJustify;
    property AllowGrayed: Boolean read FAllowGrayed write SetAllowGrayed default False;
    property Checked: Boolean read FChecked write SetChecked default False;
    property State: TCheckBoxState read FState write SetState default cbUnchecked;
    property Margin: TMargin read FMargin write SetMargin default 7;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 4;
  end;

implementation

{$IFDEF BUILD_ACTIVEX}
uses AxCtrls, AxCtrlsUtil;
{$ENDIF}

{== TMMFontStyle ==============================================================}
procedure TMMFontStyle.SetColor(value: TColor);
begin
  if (Value <> FColor) then
  begin
    FColor := Value;
    Parent.Repaint;
  end;
end;

{-- TMMFontStyle --------------------------------------------------------}
procedure TMMFontStyle.SetStyle(Value: TFontStyles);
begin
   if (Value <> FStyle) then
   begin
      FStyle := Value;
      Parent.Repaint;
   end;
end;

{== TMMBitmapRadioButton ======================================================}
constructor TMMBitmapRadioButton.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   if not (csDesigning in ComponentState) then
     ControlStyle := ControlStyle + [csSetCaption];

   ControlStyle   := ControlStyle - [csOpaque];

   FFontActive          := TMMFontStyle.Create;
   FFontActive.Parent   := Self;
   FFontActive.Color    := clRed;
   FFontActive.Style    := [];

   FFontInactive        := TMMFontStyle.Create;
   FFontInactive.Parent := Self;
   FFontInactive.Color  := clBlack;
   FFontInactive.Style  := [];

   FSaveBitmap          := TBitmap.Create;
   FAlignment           := taLeftJustify;
   FChecked             := False;
   FMargin              := 7;
   FNumGlyphs           := 4;
   FMouseOver           := False;
   Transparent          := True;

   SetBounds(0,0,100,17);

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMBitmapRadioButton ------------------------------------------------------}
destructor TMMBitmapRadioButton.Destroy;
begin
   FSaveBitmap.Free;
   FSaveBitmap := nil;

   FFontActive.Free;
   FFontInActive.Free;

   inherited Destroy;
end;

{-- TMMBitmapRadioButton ------------------------------------------------------}
procedure TMMBitmapRadioButton.BitmapChanged;
begin
   DetectNumGlyphs;
end;

{-- TMMBitmapRadioButton ------------------------------------------------------}
procedure TMMBitmapRadioButton.DetectNumGlyphs;
begin
   if (csLoading in ComponentState) or
      (csReading in ComponentState) or
      (csDestroying in ComponentState) then exit;

   if BitmapValid then
   with Bitmap do
   begin
      if (FNumGlyphs = 1) and (Width mod Height = 0) then
      begin
         FNumGlyphs := Width div Height;
         if FNumGlyphs > 4 then FNumGlyphs := 1;
      end;
   end;
   Repaint;
end;

{-- TMMBitmapRadioButton ------------------------------------------------------}
procedure TMMBitmapRadioButton.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;

{-- TMMBitmapRadioButton ------------------------------------------------------}
procedure TMMBitmapRadioButton.Redraw;
begin
   if (csDesigning in ComponentState) then Repaint
   else
   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 }
      PaintControl(FSaveBitmap.Canvas);
      { copy to screen }
      Canvas.Draw(0,0,FSaveBitmap);
   end;