mmleds.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: 22.10.98 - 17:51:31 $                                        =}
{========================================================================}
Unit MMLEDS;

{$I COMPILER.INC}

interface

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

type
    TMMLEDType =(ltDigit, ltPeriod, ltColon, ltMinus);
    TMMLEDSize =(ls06x07,ls07x11,ls08x13,ls11x19,ls13x20,ls13x21,ls15x24,
                 ls15x25,ls17x29,ls18x25,ls19x33,ls21x37,ls23x41);
    TMMPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; R: TRect) of object;
    
    {-- TMMLED -----------------------------------------------------------}
    TMMLED = class(TMMGraphicControl)
    private
       FEnabled    : Boolean;           { Enable or disable LED           }
       FLEDColor   : TColor;            { foreground color                }
       FBeveledRect: TRect;             { the real LED area               }
       FOnPaint    : TMMPaintEvent;

       procedure SetEnabled(aValue: Boolean);
       procedure SetLEDColor(aValue: TColor);
       procedure DrawLED;
       procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    protected
       procedure Paint; override;
       procedure Changed; override;
       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
    public
       constructor Create(AOwner: TComponent); override;
    published
       { Events }
       property OnClick;
       property OnDblClick;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnDragDrop;
       property OnDragOver;
       property OnEndDrag;
       property OnStartDrag;
       property OnPaint: TMMPaintEvent read FOnPaint write FOnPaint;

       property Bevel;
       property Color default clGreen;
       property ParentShowHint;
       property ShowHint;
       property Visible;
       property Font;
       property Caption;
       property DragCursor;
       property Enabled: Boolean read FEnabled write SetEnabled default True;
       property Height default 8;
       property Width default 16;
       property LEDColor: TColor read FLEDColor write setLEDColor default clLime;
    end;

    {-- TMMLEDMode -------------------------------------------------------}
    TMMLEDMode = class(TMMGraphicControl)
    private
       FMode          : TMMMode;
       FEnabled       : Boolean;
       FLEDColor      : TColor;
       FInactiveColor : TColor;
       FDrawInactive  : Boolean;
       FBitmap        : TBitmap;

       procedure LoadNewResource;
       procedure SetMode(aValue: TMMMode);
       procedure SetLEDColor(aColor: TColor);
       procedure SetInactiveColor(aColor: TColor);
       procedure SetDrawInactive(aValue: Boolean);
       procedure SetEnabled(aValue: Boolean);
       function  GetEnabled: Boolean;
       procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    protected
       procedure Paint; override;
    public
       constructor Create (AOwner: TComponent); override;
       destructor  Destroy; override;
    published
       { Events }
       property OnClick;
       property OnDblClick;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnDragDrop;
       property OnDragOver;
       property OnEndDrag;
       property OnStartDrag;

       property ParentShowHint;
       property ParentColor;
       property ShowHint;
       property Visible;
       property Color;
       property DragCursor;
       property Width default 27;
       property Height default 11;
       property DrawInactive: Boolean read FDrawInactive write SetDrawInactive default True;
       property Enabled: Boolean read GetEnabled write SetEnabled default True;
       property Mode: TMMMode read FMode write SetMode default mMono;
       property LEDColor: TColor read FLEDColor write SetLEDColor default clLime;
       property InactiveColor: TColor read FInactiveColor write SetInactiveColor default clGreen;
    end;

    {-- TMMCustomLEDDigit ------------------------------------------------}
    TMMCustomLEDDigit = class(TMMGraphicControl);

    {-- TMMLEDDigit ------------------------------------------------------}
    TMMLEDDigit = class(TMMCustomLEDDigit)
    private
       FMinValue      : integer;
       FMaxValue      : integer;
       FValue         : Longint;
       FDrawInactive  : Boolean;
       FZeroBlank     : Boolean;
       FInactiveColor : TColor;
       FLEDColor      : TColor;
       FEnabled       : Boolean;
       FSize          : TMMLEDSize;
       FType          : TMMLEDType;
       FCascade       : Boolean;
       FConnect       : TMMCustomLEDDigit;
       FBitmap        : TBitmap;
       FOnRollForward : TNotifyEvent;
       FOnRollBackward: TNotifyEvent;

       procedure LoadNewResource;
       procedure SetEnabled(aValue: Boolean);
       function  GetEnabled: Boolean;
       procedure SetMinValue(aValue: integer);
       procedure SetMaxValue(aValue: integer);
       procedure SetValue(aValue: Longint);
       procedure SetDrawInactive(aValue: Boolean);
       procedure SetZeroBlank(aValue: Boolean);
       procedure SetType(aType: TMMLEDType);
       procedure SetSize(aValue: TMMLEDSize);
       procedure SetLEDColor(aColor: TColor);
       procedure SetInactiveColor(aColor: TColor);
       procedure SetCascade(aValue: Boolean);
       procedure SetConnect(aControl: TMMCustomLEDDigit);
       procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
       {$IFDEF BUILD_ACTIVEX}
       procedure WMSize(var Message: TWMSize); message WM_SIZE;
       {$ENDIF}
    protected
       procedure Loaded; override;
       procedure Paint; override;
       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
       procedure Notification(AComponent: TComponent; Operation: TOperation); override;
       procedure RollForward; dynamic;
       procedure RollBackward; dynamic;
    public
       constructor Create (AOwner: TComponent); override;
       destructor  Destroy; override;
       procedure   Increase;
       procedure   Decrease;
    published
       { Events }
       property OnClick;
       property OnDblClick;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnRollForward: TNotifyEvent read FOnRollForward write FOnRollForward;
       property OnRollBackward: TNotifyEvent read FOnRollBackward write FOnRollBackward;

       property ParentShowHint;
       property ParentColor;
       property ShowHint;
       property Visible;
       property Color;
       property Width default 11;
       property Height default 21;
       property Enabled: Boolean read GetEnabled write SetEnabled default True;
       property MinValue: integer read FMinValue write SetMinValue default 0;
       property MaxValue: integer read FMaxValue write SetMaxValue default 9;
       property Value: Longint read FValue write SetValue default 0;
       property DrawInactive: Boolean read FDrawInactive write SetDrawInactive default True;
       property ZeroBlank: Boolean read FZeroBlank write SetZeroBlank default False;
       property InactiveColor: TColor read FInactiveColor write SetInactiveColor default clGreen;
       property LEDColor: TColor read FLEDColor write SetLEDColor default clLime;
       property DigitSize: TMMLEDSize read FSize write SetSize default ls13X21;
       property DisplayType: TMMLEDType read FType write SetType default ltDigit;
       property CascadeValues: Boolean read FCascade write SetCascade default False;
       property Connect: TMMCustomLEDDigit read FConnect write SetConnect;
    end;

    {-- TMMLEDPanel ------------------------------------------------------}
    TMMLEDPanel = class(TMMCustomPanel)
    private
       FMinValue     : LongInt;
       FMaxValue     : LongInt;
       FValue        : Longint;
       FSize         : TMMLEDSize;
       FLEDSpace     : integer;
       FLEDColor     : TColor;
       FInactiveColor: TColor;
       FDrawInactive : Boolean;
       FZeroBlank    : Boolean;
       FNumDigits    : integer;
       FDigits       : array[0..8] of TMMLedDigit;
       FOnChange     : TNotifyEvent;

       function  CreateDigit: TMMLedDigit;
       procedure CreateAllDigits;
       procedure AdjustSize (var W, H: integer);
       procedure AdjustBounds;
       procedure DestroyAllDigits;
       procedure SetMaxValue(aValue: Longint);
       procedure SetMinValue(aValue: Longint);
       procedure SetNumDigits(aValue: integer);
       procedure SetLEDSpace(aValue: integer);
       procedure SetLEDColor(aValue: TColor);
       procedure SetInactiveColor(aValue: TColor);
       procedure SetDrawInactive(aValue: Boolean);
       procedure SetEnabled(aValue: Boolean);
       function  GetEnabled: Boolean;
       procedure SetSize(aValue: TMMLEDSize);
       procedure SetZeroBlank(aValue: Boolean);
       procedure SetValue(aValue: Longint);
       procedure WMSize(var Message: TWMSize);  message WM_SIZE;
       procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
       procedure BtnClick(Sender: TObject);
       procedure BtnDblClick(Sender: TObject);
       procedure MsDown(Sender: TObject; Button: TMouseButton;
                        Shift: TShiftState; X, Y: Integer);
       procedure MsUp(Sender: TObject; Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
       procedure MsMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    protected
       procedure Loaded; override;
       procedure Change; dynamic;
       procedure Changed; override;
       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
       {$IFDEF WIN32}
       {$IFDEF DELPHI3}
       procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
       {$ELSE}
       procedure GetChildren(Proc: TGetChildProc); override;
       {$ENDIF}
       {$ENDIF}
    public
       constructor Create (aOwner: TComponent); override;
       destructor  Destroy; override;
    published
       { Events }
       property OnClick;
       property OnDblClick;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnResize;
       property OnChange: TNotifyEvent read FOnChange write FOnChange;

       property Bevel;
       property ParentShowHint;
       property ParentColor;
       property ShowHint;
       property Visible;
       property Color default clBlack;
       property DrawInactive: Boolean read FDrawInactive write SetDrawInactive default True;
       property Enabled: Boolean read GetEnabled write SetEnabled default True;
       property LEDColor: TColor read FLEDColor write SetLEDColor default clLime;
       property InactiveColor: TColor read FInactiveColor write SetInactiveColor default clGreen;
       property NumDigits: integer read FNumDigits write SetNumDigits default 2;
       property DigitSize: TMMLEDSize read FSize write SetSize default ls13X21;
       property LEDSpace: integer read FLEDSpace write SetLEDSpace default 1;
       property MaxValue: LongInt read FMaxValue write SetMaxValue default 0;
       property MinValue: LongInt read FMinValue write SetMinValue default 100;
       property TabOrder;
       property TabStop;
       property ZeroBlank: Boolean read FZeroBlank write SetZeroBlank default False;
       property Value: Longint read FValue write SetValue default 0;
    end;

    {-- TMMLEDSpin -------------------------------------------------------}
    TMMLEDSpin = class(TMMWinControl)
    private
       FLEDPanel   : TMMLEDPanel;
       FButton     : TMMSpinButton;
       FSpace      : integer;
       FOnChange   : TNotifyEvent;
       FOnUpClick  : TNotifyEvent;
       FOnDownClick: TNotifyEvent;

       procedure SetIncrement(aValue: Longint);
       function  GetIncrement: Longint;
       procedure SetSpace(aValue: integer);
       procedure SetNumDigits(aValue: integer);
       function  GetNumDigits: integer;
       procedure SetLEDSpace(aValue: integer);
       function  GetLEDSpace: integer;
       procedure SetColor(aValue: TColor);
       function  GetColor: TColor;
       procedure SetLEDColor(aValue: TColor);
       function  GetLedColor: TColor;
       procedure SetInactiveColor(aValue: TColor);
       function  GetInactiveColor: TColor;
       procedure SetDrawInactive(aValue: Boolean);
       function  GetDrawInactive: Boolean;
       procedure SetEnabled(aValue: Boolean);
       function  GetEnabled: Boolean;
       procedure SetSize(aValue: TMMLEDSize);
       function  GetSize: TMMLEDSize;
       procedure SetZeroBlank(aValue: Boolean);
       function  GetZeroBlank: Boolean;
       procedure SetValue(aValue: Longint);
       function  GetValue: Longint;
       procedure SetMinValue(aValue: Longint);
       function  GetMinValue: Longint;
       procedure SetMaxValue(aValue: Longint);
       function  GetMaxValue: Longint;
       procedure SetLEDBevel(aBevel: TMMBevel);
       function  GetLEDBevel: TMMBevel;
       procedure SetTabStop(aValue: Boolean);
       function  GetTabStop: Boolean;
       function  GetUpGlyph: TBitmap;
       function  GetDownGlyph: TBitmap;
       procedure SetUpGlyph(Value: TBitmap);
       procedure SetUpNumGlyphs(Value: TNumGlyphs);
       function  GetUpNumGlyphs: TNumGlyphs;
       procedure SetDownGlyph(Value: TBitmap);
       procedure SetDownNumGlyphs(Value: TNumGlyphs);
       function  GetDownNumGlyphs: TNumGlyphs;
       procedure SetButtonFace(Value: Boolean);
       function  GetButtonFace: Boolean;
       procedure SetMiddleButton(Value: Boolean);
       function  GetMiddleButton: Boolean;
       procedure SetSpinBevel(aValue: TMMBevel);
       function  GetSpinBevel: TMMBevel;
       procedure AdjustSize (var W, H: integer);
       procedure AdjustBounds;
       procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
       procedure WMSize(var Message: TWMSize); message WM_SIZE;
       procedure BtnClick(Sender: TObject);
       procedure BtnDblClick(Sender: TObject);
       procedure MsDown(Sender: TObject; Button: TMouseButton;
                        Shift: TShiftState; X, Y: Integer);
       procedure MsUp(Sender: TObject; Button: TMouseButton;
                      Shift: TShiftState; X, Y: Integer);
       procedure MsMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    protected
       procedure UpClick(Sender: TObject); virtual;
       procedure DownClick(Sender: TObject); virtual;
       procedure ChildChange(Sender: TObject); virtual;
       procedure Change; virtual;

       procedure GetChanged(Sender: TObject); virtual;
       {$IFDEF WIN32}
       {$IFDEF DELPHI3}
       procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
       {$ELSE}
       procedure GetChildren(Proc: TGetChildProc); override;
       {$ENDIF}
       {$ENDIF}
       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
       procedure Click; override;
    public
       constructor Create(AOwner: TComponent); override;
       destructor  Destroy; override;
       property    Button: TMMSpinButton read FButton write FButton;
    published
       { Events }
       property OnClick;