mmbmpled.pas

一套及时通讯的原码

begin
   {Result := inherited Enabled;}
   Result := FEnabled;        { !!!!!!!! ev. wieder zu inherited 鋘dern }
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.SetConnect(aControl: TMMCustomBitmapLEDDigit);
var
  C: TMMCustomBitmapLEDDigit;
begin
   if FConnect <> aControl then
   begin
      C := aControl;
      while (C <> nil) and (C <> Self) do
      begin
         if C is TMMBitmapLEDDigit then
            C := TMMBitmapLEDDigit(C).Connect
         else break;
      end;
      if C <> Self then
         FConnect := aControl;
  end;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.FastDraw;
var
  DC: HDC;
  Control: TWinControl;

begin
   Control := Parent;

   if Visible and (Control <> nil) and Control.HandleAllocated then
   begin
      DC := GetDC(Control.Handle);
      try
        {$IFDEF DELPHI3}
        Canvas.Lock;
        {$ENDIF}

        if RectVisible(DC, Rect(Left, Top, Left + Width, Top + Height)) then
        begin
           MoveWindowOrg(DC, Left, Top);
           IntersectClipRect(DC, 0, 0, Width, Height);
           Canvas.Handle := DC;
           Paint;
        end;

      finally
        ReleaseDC(Control.Handle, DC);
        Canvas.Handle := 0;
        {$IFDEF DELPHI3}
        Canvas.Unlock;
        {$ENDIF}
      end;
  end;
end;

{-- TMMBitmapLEDDigit ----------------------------------------------------------}
procedure TMMBitmapLEDDigit.Paint;
Var
   MemDC: HDC;
   oldBitmap: HBitmap;
   BitmapOfs: integer;
   Blank: Boolean;
   X,Y: integer;
begin
   if BitmapValid then
   begin
      {$IFDEF DELPHI3}
      Bitmap.Canvas.Lock;
      {$ENDIF}
      try
         if FZeroBlank and (FValue = 0) then Blank := True
         else Blank := False;

         BitmapOfs := Width * ((Ord(FValue)+1) * Ord(Enabled)) * Ord(NOT Blank);
         X := BitmapOfs;
         Y := FGlyphIndex*Height;

         if assigned(FOnPaint) then
         begin
            FOnPaint(Self,Canvas,ClientRect,Rect(X,Y,X+Width,Y+Height));
         end
         else
         begin
            MemDC := CreateCompatibleDC(0);
            oldBitmap := SelectObject(MemDC, Bitmap.Handle);
            BitBlt(Canvas.Handle,
                   0, 0, Width, Height,
                   MemDC,
                   X, Y,
                   SRCCOPY);
            SelectObject(MemDC, oldBitmap);
            DeleteDC(MemDC);
         end;
      finally
         {$IFDEF DELPHI3}
         Bitmap.Canvas.UnLock;
         {$ENDIF}
      end;
   end
   else if csDesigning in ComponentState then
   begin
      Canvas.Brush.Style := bsClear;
      Canvas.Pen.Color   := clBlack;
      Canvas.Pen.Style   := psDot;
      Canvas.Rectangle(0,0,Width,Height);
   end;
end;

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

   FRC_CharWidth  := 1;
   FRC_CharHeight := 1;

   FAutoScroll    := False;
   FSpeed         := 100;
   FStartStep     := 0;
   FCurStep       := 0;
   FScrollDir     := sdLeft;

   FTimer         := nil;

   Width          := 11;
   Height         := 13;
   FAutoSize      := True;
   NumChars       := 11;
   FCharSpace     := 0;
   Color          := clBlack;

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

{-- TMMBitmapLabel ------------------------------------------------------------}
destructor TMMBitmapLabel.Destroy;
begin
   if (FTimer <> nil) then FTimer.Free;

   inherited Destroy;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.BitmapChanged;
begin
   if BitmapValid then
   begin
      FRC_CharWidth := Bitmap.Width div RC_CHARSPERROW;
      FRC_CharHeight:= Bitmap.Height div RC_CHARROWS;

      AdjustBounds;
   end;

   inherited BitmapChanged
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.TimerTick(Sender: TObject);
begin
   if not FTimer.Enabled then exit;
   if FScrollDir = sdLeft then
      inc(FCurStep)
   else
      dec(FCurStep);
   if Visible then DrawLabel;
   if ((FScrollDir = sdLeft) and (FCurStep >= Length(Caption))) or
      ((FScrollDir = sdRight) and (FCurStep <= 0)) then
   begin
      if FAutoScroll then FCurStep := FStartStep
      else FTimer.Enabled := False;
      if Assigned(FOnEnd) then FOnEnd(Self);
   end
   else if Assigned(FOnStep) then FOnStep(Self);
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.SetAutoScroll;
begin
   if (aValue <> FAutoScroll) then
   begin
      FAutoScroll := aValue;
      if FAutoScroll then Start
      else Stop;
      FCurStep := FStartStep;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.SetScrollDir(aValue: TMMScrollDirection);
begin
   if (aValue <> FScrollDir) then
   begin
      FScrollDir := aValue;
      if csDesigning in ComponentState then
        if FScrollDir = sdLeft then
           if StartStep = NumChars then StartStep := 0 else
        else
          if StartStep = 0 then StartStep := NumChars;
   end;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.Start;
begin
   if (FTimer = nil) then
   begin
      FTimer         := TTimer.Create(Self);
      with FTimer do
      begin
         Enabled     := False;
         OnTimer     := TimerTick;
         Interval    := FSpeed;
      end;
   end
   else if FTimer.Enabled then exit;

   if (FScrollDir = sdLeft) then
   begin
      if (FCurStep > Length(Caption)) then
          FCurStep := FStartStep;
   end
   else
   begin
      if (FCurStep <= 0) then
          FCurStep := FStartStep;
   end;
   if Assigned(FOnBegin) then FOnBegin(Self);

   FTimer.Enabled := True;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.Stop;
begin
   if (FTimer <> nil) then FTimer.Enabled := False;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.SetCurStep(aValue: integer);
begin
   if (FCurStep <> aValue) AND (aValue >= 0) AND (aValue <= Length(Caption)) then
   begin
      FCurStep := aValue;
      DrawLabel;
   end;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.SetStartStep(aValue: integer);
begin
   if (FStartStep <> aValue) AND (aValue >= 0) AND (aValue <= Length(Caption)) then
   begin
      FStartStep := aValue;
      FCurStep := aValue;
      DrawLabel;
   end;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
Var
   W, H: integer;

begin
   W := aWidth;
   H := aHeight;
   AdjustControlSize(W,H);
   inherited SetBounds(aLeft, aTop, W, H);
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.AdjustControlSize(Var W, H: integer);
begin
   if (csLoading in ComponentState) or (csReading in ComponentState) then exit;

   if BitmapValid then
   begin
      if FAutoSize then FNumChars := Length(Caption)
      else FNumChars := (W - (FCharSpace)) div (FRC_CharWidth + FCharSpace);

      if (Align <> alTop) and (Align <> alBottom) then
          W := FNumChars * (FRC_CharWidth + FCharSpace)-(FCharSpace);

      H := Bitmap.Height div RC_CHARROWS;
   end;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.AdjustBounds;
Var
   W, H: integer;

begin
     W := Width;
     H := Height;
     AdjustControlSize(W, H);
     if (W <> Width) or (H <> Height) then
        inherited SetBounds(Left, Top, W, H)
     else Invalidate;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.Changed;
begin
   AdjustBounds;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.SetAutoSize(aValue: Boolean);
begin
   if (FAutoSize <> aValue) then
   begin
      FAutoSize := aValue;
      AdjustBounds;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.SetNumChars(aValue: integer);
begin
   if (FNumChars <> aValue) then
   begin
      FNumChars := aValue;
      AdjustBounds;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.SetCharSpace(aValue: integer);
begin
   if (FCharSpace <> aValue) and (aValue >= 0) then
   begin
      FCharSpace := aValue;
      AdjustBounds;
   end;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.SetSpeed(aValue: integer);
begin
   if (FSpeed <> aValue) then
   begin
      FSpeed := aValue;
      if (FTimer <> nil) then FTimer.Interval := FSpeed;
   end;
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
procedure TMMBitmapLabel.CMTextChanged(var Message: TMessage);
begin
   if AutoSize then
      AdjustBounds
   else
      DrawLabel;

   if assigned(FOnChange) then FOnChange(Self);
end;

{-- TMMBitmapLabel ------------------------------------------------------------}
function TMMBitmapLabel.GetCharMapping(ch: Char): integer; 
begin
   Result := RC_CHARSPERROW*RC_CHARROWS-1;
   if (Ord(ch) >= Ord('A')) and (Ord(ch) <= Ord('Z')) then
   begin
      Result := Ord(ch)-Ord('A');
   end
   else
   if (Ord(ch) >= Ord('0')) and (Ord(ch) <= Ord('9')) then
   begin
      Result := RC_CHARSPERROW + (Ord(ch)-Ord('0'));
   end
   else case ch of
        '"': Result := 26;                 // "
        '@': Result := 27;                 // @
        '.': Result := RC_CHARSPERROW+11;  // .
        ':': Result := RC_CHARSPERROW+12;  // :
        '(': Result := RC_CHARSPERROW+13;  // (
        ')': Result := RC_CHARSPERROW+14;  // )
        '-': Result := RC_CHARSPERROW+15;  // -
       '''': Result := RC_CHARSPERROW+16;  // '
        '!': Result := RC_CHARSPERROW+17;  // !
        '_': Result := RC_CHARSPERROW+18;  // _
        '+': Result := RC_CHARSPERROW+19;  // +
        '\': Result := RC_CHARSPERROW+20;  // \
        '/': Result := RC_CHARSPERROW+21;  // /
        '[': Result := RC_CHARSPERROW+22;  // [
        ']': Result := RC_CHARSPERROW+23;  // ]
        '^': Result := RC_CHARSPERROW+24;  // ^
        '&': Result := RC_CHARSPERROW+25;  // &
        '%': Result := RC_CHARSPERROW+26;  // %
        ',': Result := RC_CHARSPERROW+27;  // ,
        '=': Result := RC_CHARSPERROW+28;  // =
        '$': Result := RC_CHARSPERROW+29;  // $
        '#': Result := RC_CHARSPERROW+30;  // #

        '