mmswitch.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: 09.07.98 - 15:28:53 $                                        =}
{========================================================================}
unit MMSwitch;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils, 
    Messages, 
    Classes, 
    Graphics, 
    Controls,
    Buttons,
    MMUtils,
    MMString,
    MMObj;

type
  TMMSwitchKind = (skHorizontal, skVertical);

  {-- TMMSwitch ----------------------------------------------------------}
  TMMSwitch = class(TMMCustomControl)
  private
    FStandardBit : Boolean;          { True if the standard bitmap is used}    
    FGlyph       : TBitmap;          { this our glyph                     }
    FNumGlyphs   : TNumGlyphs;       { number of glyphs in the bitmap     }
    FSwitchRect  : TRect;            { current switch position            }
    FCapture     : Boolean;          { Whether it's currently being moved }
    FCapturePoint: TPoint;           { Position at start of capture.      }
    FCaptureValue: Integer;          { Value at start of capture.         }
    FKind        : TMMSwitchKind;    { skVertical or skHorizontal         }
    FNumPositions: Integer;          { number of switch positions         }
    FPosition    : Integer;          { current switch position            }
    FOnChange    : TNotifyEvent;

    procedure SetKind(aValue : TMMSwitchKind);
    procedure SetNumPositions(aValue: integer);
    procedure SetPosition(aValue: integer);
    procedure SetGlyph(aValue: TBitmap);
    procedure SetNumGlyphs(aValue: TNumGlyphs);
    procedure LoadNewResource;
    procedure AdjustSize(var W, H: Integer);
    procedure AdjustBounds;
    procedure DrawSwitch;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    {$IFDEF BUILD_ACTIVEX}
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    {$ENDIF}

  protected
    procedure Change; dynamic;
    procedure Paint; override;
    procedure Loaded; override;
    procedure SetBounds(aLeft, aTop, aWidth, aHeight: Integer); override;
    procedure Changed; override;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove (Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

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

  published
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;

    property Bevel;
    property Color;
    property Enabled;
    property HelpContext;
    property Hint;
    property ParentColor;
    property ParentShowHint;
    property ShowHint;
    property TabStop default True;
    property TabOrder;
    property Tag;
    property Visible;
    property Width default 1;
    property Height default 1;
    property Kind: TMMSwitchKind read FKind write SetKind;
    property NumPositions: integer read FNumPositions write SetNumPositions;
    property Position: Integer read FPosition write SetPosition;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs;
  end;

implementation

{$IFDEF WIN32}
  {$R MMSWITCH.D32}
{$ELSE}
  {$R MMSWITCH.D16}
{$ENDIF}

{ these resources are available: }
{ 'H_SWITCH' }
{ 'V_SWITCH' }

{-- TMMSwitch ------------------------------------------------------------}
constructor TMMSwitch.Create (AOwner : TComponent);
begin
   inherited Create (AOwner);

   FGlyph := TBitmap.Create;
   FNumGlyphs := 1;
   Width := 1;
   Height := 1;

   FKind := skVertical;
   FNumPositions := 2;
   FPosition := 0;
   FOnChange := Nil;
   FCapture := False;
   TabStop := True;

   LoadNewResource;

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

{-- TMMSwitch ------------------------------------------------------------}
destructor TMMSwitch.Destroy;
begin
   FGlyph.Free;
   inherited Destroy
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.Change;
begin
   if not (csLoading in ComponentState) and 
      not (csReading in ComponentState) then
      if Assigned(FOnChange) then FOnChange(self);
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.LoadNewResource;
var
   Str1: array[0..80] of Char;

begin
   if (FKind = skVertical) then 
      StrCopy(str1, 'V_SWITCH')
   else 
      StrCopy(str1, 'H_SWITCH');
                                                      { load the resource }
   FGlyph.Handle := LoadBitmap(HInstance, Str1);
   FNumGlyphs := 3;

   AdjustBounds;
   FStandardBit := True;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.SetGlyph(aValue: TBitmap);
begin
   if (aValue <> FGlyph) then
   begin
      if aValue <> Nil then
      begin
         FGlyph.Assign(aValue);
         FStandardBit := False;
         AdjustBounds;
      end
      else LoadNewResource;

      Invalidate;
   end;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.SetNumGlyphs(aValue: TNumGlyphs);
begin
     if (aValue <> FNumGlyphs) then
     begin
        FNumGlyphs := aValue;
        AdjustBounds;
        Invalidate;
     end;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.CMEnabledChanged(var Message: TMessage);
begin
   Invalidate;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.WMSetFocus(var Message: TWMSetFocus);
begin
     Invalidate;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.WMKillFocus(var Message: TWMKillFocus);
begin
     Invalidate;
end;

{$IFDEF BUILD_ACTIVEX}
{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.WMSize(var Message: TWMSize);