mmbmpled.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: 03.11.98 - 14:57:52 $                                        =}
{========================================================================}
unit MMBmpLED;

{$I COMPILER.INC}

interface

uses
    Windows,
    SysUtils,
    Messages,
    Classes,
    Graphics,
    Controls,
    CommCtrl,
    ExtCtrls,
    Menus,
    Forms,
    MMObj,
    MMUtils,
    MMString,
    MMBmpLst,
    MMObsrv;

type
    {-- TMMCustomBitmapLEDDigit -----------------------------------------------}
    TMMCustomBitmapLEDDigit = class(TMMCustomBitmapListControl);
    TMMPaintImage       = procedure(Sender: TObject; Canvas: TCanvas; DstRect, SrcRect: TRect) of object;

    {-- TMMBitmapLEDDigit ------------------------------------------------------}
    TMMBitmapLEDDigit = class(TMMCustomBitmapLEDDigit)
    private
       FMinValue      : integer;
       FMaxValue      : integer;
       FValue         : Longint;
       FDrawInactive  : Boolean;
       FZeroBlank     : Boolean;
       FEnabled       : Boolean;
       FCascade       : Boolean;
       FGlyphIndex    : integer;
       FNumGlyphs     : integer;
       FConnect       : TMMCustomBitmapLEDDigit;
       FOnRollForward : TNotifyEvent;
       FOnRollBackward: TNotifyEvent;
       FOnPaint       : TMMPaintImage;

       procedure SetNumGlyphs(aValue: integer);
       procedure SetGlyphIndex(aValue: integer);
       procedure SetEnabled(aValue: Boolean);
       function  GetEnabled: Boolean; 
       procedure SetMinValue(aValue: integer);
       procedure SetMaxValue(aValue: integer);
       procedure SetValue(aValue: Longint);
       procedure SetZeroBlank(aValue: Boolean);
       procedure SetCascade(aValue: Boolean);
       procedure SetConnect(aControl: TMMCustomBitmapLEDDigit);
    protected
       procedure Paint; override;
       procedure FastDraw; virtual;
       procedure Notification(AComponent: TComponent; Operation: TOperation); override;
       procedure RollForward; dynamic;
       procedure RollBackward; dynamic;
       procedure BitmapChanged; override;

    public
       constructor Create (AOwner: TComponent); override;

       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;

       procedure   Increase;
       procedure   Decrease;

    published
       { Events }
       property OnClick;
       property OnDblClick;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnDragDrop;
       property OnDragOver;
       property OnEndDrag;
       property OnStartDrag;
       property OnRollForward: TNotifyEvent read FOnRollForward write FOnRollForward;
       property OnRollBackward: TNotifyEvent read FOnRollBackward write FOnRollBackward;
       property OnPaint: TMMPaintImage read FOnPaint write FOnPaint;

       property Color default clBlack;
       property ParentColor;
       property ParentShowHint;
       property DragCursor;
       property ShowHint;
       property Visible;
       property Width default 11;
       property Height default 21;
       property PopupMenu;

       property BitmapList;
       property BitmapIndex;
       property BitmapBackIndex;
       property NumGlyphs: integer read FNumGlyphs write SetNumGlyphs;
       property GlyphIndex: integer read FGlyphIndex write SetGlyphIndex default 0;
       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 ZeroBlank: Boolean read FZeroBlank write SetZeroBlank default False;
       property CascadeValues: Boolean read FCascade write SetCascade default False;
       property Connect: TMMCustomBitmapLEDDigit read FConnect write SetConnect;
    end;

    TMMScrollDirection = (sdLeft,sdRight);

    {-- TMMBitmapLabel --------------------------------------------------------}
    TMMBitmapLabel = class(TMMCustomBitmapListControl)
    private
       FRC_CharWidth : integer;         { the width of one digit          }
       FRC_CharHeight: integer;         { the height of one digit         }
       FAutoSize     : Boolean;
       FCharSpace    : integer;
       FNumChars     : integer;
       FAutoScroll   : Boolean;
       FTimer        : TTimer;
       FSpeed        : integer;
       FScrollDir    : TMMScrollDirection;
       FStartStep    : integer;
       FCurStep      : integer;
       FOnChange,
       FOnBegin,
       FOnStep,
       FOnEnd        : TNotifyEvent;

       procedure AdjustControlSize(var W, H: integer);
       procedure AdjustBounds;
       procedure DrawLabel;
       procedure SetAutoSize(aValue: Boolean);
       procedure SetCharSpace(aValue: integer);
       procedure SetNumChars(aValue: integer);
       procedure SetCurStep(aValue: integer);
       procedure SetStartStep(aValue: integer);
       procedure SetSpeed(aValue: integer);
       procedure SetAutoScroll(aValue: Boolean);
       procedure SetScrollDir(aValue: TMMScrollDirection);
       procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    protected
       procedure BitmapChanged; override;
       procedure Paint; override;
       procedure Loaded; override;
       procedure TimerTick(Sender: TObject);
       procedure Changed; override;
       function  GetCharMapping(ch: Char): integer; virtual;

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

       procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;

       procedure Start;
       procedure Stop;
    published
       { Events }
       property OnClick;
       property OnDblClick;
       property OnMouseDown;
       property OnMouseMove;
       property OnMouseUp;
       property OnChange: TNotifyEvent read FOnChange write FOnChange;
       property OnBegin: TNotifyEvent read FOnBegin write FOnBegin;
       property OnStep: TNotifyEvent read FOnStep write FOnStep;
       property OnEnd: TNotifyEvent read FOnEnd write FOnEnd;

       property Align;
       property Caption;
       property ParentShowHint;
       property PopupMenu;
       property ShowHint;
       property Visible;
       property Width default 11;
       property Height default 13;
       property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
       property Enabled;
       property BitmapList;
       property BitmapIndex;
       property NumChars: integer read FNumChars write SetNumChars default 12;
       property CharSpace: integer read FCharSpace write SetCharSpace default 0;
       property ScrollSpeed: integer read FSpeed write SetSpeed default 100;
       property StartStep: integer read FStartStep write SetStartStep default 0;
       property CurrentStep: integer read FCurStep write SetCurStep default 0;
       property AutoScroll: Boolean read FAutoScroll write SetAutoScroll default False;
       property ScrollDirection: TMMScrollDirection read FScrollDir write SetScrollDir default sdLeft;
    end;

implementation

const
     RC_NumDigits    = 11;     { number of digits in the digit bitmap  }

     RC_CHARSPERROW  = 31;     { number of chars in the label bitmap   }
     RC_CHARROWS     = 3;      { number of rows in the label bitmap    }

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

   Width := 11;
   Height := 21;
   FCascade := False;
   FConnect := Nil;
   FEnabled := True;      { !!!!!!!! ev. wieder zu inherited 鋘dern }
   FMinValue := 0;
   FMaxValue := 9;
   FDrawInactive := True;
   FZeroBlank := False;
   FNumGlyphs   := 1;
   FGlyphIndex  := 0;

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

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(AComponent, Operation);

   if (Operation = opRemove) then
   begin
      if (AComponent = FConnect) then
          FConnect := nil;
   end;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.BitmapChanged;
begin
   if BitmapValid then
      SetBounds(Left, Top, Bitmap.Width, Bitmap.Height);

   inherited BitmapChanged
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetGlyphIndex(aValue: integer);
begin
   if (aValue <> FGlyphIndex) then
   begin
      FGlyphIndex := MinMax(aValue,0,FNumGlyphs-1);
      Invalidate;
   end;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetNumGlyphs(aValue: integer);
begin
   if (FNumGlyphs <> aValue) then
   begin
      FNumGlyphs := Max(aValue,1);
      if BitmapValid then
         SetBounds(Left, Top, Bitmap.Width, Bitmap.Height);
   end;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.RollForward;
begin
   if (csLoading in ComponentState) or
      (csReading in ComponentState) then exit;

   if assigned(FOnRollForward) then FOnRollForward(self);
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.RollBackward;
begin
   if (csLoading in ComponentState) or
      (csReading in ComponentState) then exit;

   if assigned(FOnRollBackward) then FOnRollBackward(self);
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
Var
   DigitWidth: integer;

begin
   if BitmapValid then
   begin
      DigitWidth  := Bitmap.Width div RC_NumDigits;

      inherited SetBounds(aLeft, aTop, DigitWidth, Bitmap.Height div FNumGlyphs);
   end
   else inherited SetBounds(aLeft, aTop, aWidth, aHeight);
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetZeroBlank(aValue: Boolean);
begin
   if (FZeroBlank <> aValue) then
   begin
      FZeroBlank := aValue;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetCascade(aValue: Boolean);
begin
   if (aValue <> FCascade) then FCascade := aValue;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetMinValue(aValue: integer);
begin
   if (aValue <> FMinValue) AND (aValue >= 0) AND (aValue < 10) then
   begin
      FMinValue := aValue;
      if (FValue < FMinValue) then FValue := FMinValue;
      Invalidate;
   end;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetMaxValue(aValue: integer);
begin
   if (aValue <> FMaxValue) AND (aValue >= 0) AND (aValue < 10) then
   begin
      FMaxValue := aValue;
      if (FValue > FMaxValue) then FValue := FMaxValue;
      Invalidate;
   end;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetValue(aValue: Longint);
begin
   if FCascade AND assigned(FConnect) then
      TMMBitmapLEDDigit(FConnect).Value := aValue div 10;

   aValue := aValue mod 10;
   if (aValue <> FValue) AND (aValue >= FMinValue) AND (aValue <= FMaxValue) then
   begin
      FValue := aValue;
      if (csDesigning in ComponentState) then
         Refresh
      else
         FastDraw;
   end;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.Increase;
begin
   if (FValue = FMaxValue) then
   begin
      FValue := FMinValue;
      if assigned(FConnect) then TMMBitmapLEDDigit(FConnect).Increase;
      RollForward;
   end
   else inc(FValue);
   Invalidate;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.Decrease;
begin
   if (FValue = FMinValue) then
   begin
      FValue := FMaxValue;
      if assigned(FConnect) then TMMBitmapLEDDigit(FConnect).Decrease;
      RollBackward;
   end
   else dec(FValue);
   Invalidate;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetEnabled(aValue: Boolean);
begin
   {inherited Enabled := aValue;}
   if (aValue <> FEnabled) then
   begin
      FEnabled := aValue;        { !!!!!!!! ev. wieder zu inherited 鋘dern }
      Invalidate;
   end;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
function  TMMBitmapLEDDigit.GetEnabled: Boolean;