mmleds.pas

一套及时通讯的原码

        ls18x25: StrCopy(str1, 'LCDS_18X25');
        ls19x33: StrCopy(str1, 'LCDS_19X33');
        ls21x37: StrCopy(str1, 'LCDS_21X37');
        ls23x41: StrCopy(str1, 'LCDS_23X41');
   end;

   New(DigitBitmap);
   with DigitBitmap^ do
   begin
      FBitmap := TBitmap.Create;
      {$IFDEF WIN32}
      FBitmap.Handle := Windows.LoadBitmap(HInstance, Str1);{ load the resource }
      {$ELSE}
      FBitmap.Handle := WinProcs.LoadBitmap(HInstance, Str1);{ load the resource }
      {$ENDIF}
      { Change the black/white resource to a colored bitmap }
      ChangeColors(FBitmap,Inactive,LEDColor,InactColor,Color);

      FType      := Typ;
      FSize      := Size;
      FInactive  := Inactive;
      FColor     := Color;
      FLEDColor  := LEDColor;
      FInactColor:= InactColor;
      FCount     := 1;

      BitmapList.Add(DigitBitmap);
      Result := FBitmap;
   end;
end;

{-- TDigitCache ----------------------------------------------------------}
procedure TDigitCache.RemoveBitmap(var Bitmap: TBitmap);
var
   i: integer;

begin
   if (Bitmap <> nil) and (BitmapList.Count > 0) then
   begin
      for i := 0 to BitmapList.Count-1 do
      with PDigitBitmap(BitmapList.Items[i])^ do
      begin
         if (FBitmap = Bitmap) then
         begin
            dec(FCount);
            if (FCount = 0) then
            begin
               FBitmap.Free;
               Dispose(BitmapList.Items[i]);
               BitmapList.Delete(i);
               Bitmap := nil;
            end;
            break;
         end;
      end;
   end;
end;

{== TMMLEDDigit ==========================================================}
constructor TMMLedDigit.Create (AOwner: TComponent);
begin
   ControlState := ControlState + [csCreating];

   inherited Create (AOwner);

   ControlStyle := ControlStyle - [csSetCaption];

   FBitmap := nil;
   Width := 11;
   Height := 21;
   FCascade := False;
   FConnect := Nil;
   FEnabled := True;      { !!!!!!!! ev. wieder zu inherited 鋘dern }
   FMinValue := 0;
   FMaxValue := 9;
   FDrawInactive := True;
   FZeroBlank := False;
   FType := ltDigit;
   FInactiveColor := clGreen;
   FLEDColor := clLime;
   FSize := ls13x21;
   if (DigitCache = nil) then DigitCache := TDigitCache.Create;

   ControlState := ControlState - [csCreating];

   LoadNewResource;

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

{-- TMMLEDDigit ----------------------------------------------------------}
destructor TMMLedDigit.Destroy;
begin
   if (DigitCache <> nil) then
   begin
      DigitCache.RemoveBitmap(FBitmap);
      if DigitCache.Empty then
      begin
         DigitCache.Free;
         DigitCache := nil;
      end;
   end;

   inherited Destroy;
end;

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

   if (Operation = opRemove) and (AComponent = FConnect) then
      FConnect := Nil;
end;

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

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

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

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

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

begin
   if (FBitmap <> nil) then
   begin
      if (FType = ltDigit) then
         DigitWidth  := FBitmap.Width div RC_NumDigits
      else
         DigitWidth  := FBitmap.Width div RC_NumSeparators;

      inherited SetBounds(aLeft, aTop, DigitWidth, FBitmap.Height);
   end
   else inherited SetBounds(aLeft, aTop, aWidth, aHeight);
end;

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

   SetBounds(Left,Top,Width,Height);
end;
{$ENDIF}

{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLEDDigit.LoadNewResource;
begin
   if (csLoading in ComponentState) or
      (csReading in ComponentState) or
      (csCreating in ControlState)  or
      (DigitCache = nil) then exit;

   DigitCache.RemoveBitmap(FBitmap);
   FBitmap := DigitCache.LoadBitmap(FType, FSize, FDrawInactive,
                                    FLEDColor, FInactiveColor, Color);

   { only a dummy call to change to the new Digit size }
   if (FBitmap <> nil) then
       SetBounds(Left, Top, FBitmap.Width, FBitmap.Height);

   Invalidate;
end;

{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLEDDigit.SetSize(aValue: TMMLEDSize);
begin
   if (FSize <> aValue) then
   begin
      FSize := aValue;
      LoadNewResource;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLedDigit.SetType(aType: TMMLEDType);
begin
   if (aType <> FType) then
   begin
      FType := aType;
      LoadNewResource;
   end;
end;

{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLedDigit.SetDrawInactive(aValue: Boolean);
begin
   if (FDrawInactive <> aValue) then
   begin
      FDrawInactive := aValue;
      LoadNewResource;
   end;
end;

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

{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLEDDigit.CMColorChanged(var Message: TMessage);
begin
   LoadNewResource;
end;

{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLedDigit.SetLEDColor(aColor: TColor);
begin
   if (aColor <> FLEDColor) then
   begin
      FLEDColor := aColor;
      LoadNewResource;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLedDigit.SetInactiveColor(aColor: TColor);
begin
   if (aColor <> FInactiveColor) then
   begin
      FInactiveColor := aColor;
      LoadNewResource;
   end;
end;

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

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

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

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

   aValue := aValue mod 10;
   if (aValue <> FValue) AND (aValue >= FMinValue) AND (aValue <= FMaxValue) then
   begin
      FValue := aValue;
      Refresh;
   end;
end;

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

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

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

{-0- TMMLEDDigit ----------------------------------------------------------}
function  TMMLEDDigit.GetEnabled: Boolean;
begin
   {Result := inherited Enabled;}
   Result := FEnabled;        { !!!!!!!! ev. wieder zu inherited 鋘dern }
end;

{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLEDDigit.SetConnect(aControl: TMMCustomLEDDigit);
begin
   if (aControl <> Self) and (FConnect <> aControl) then
   begin
      FConnect := aControl;
   end;
end;

{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLedDigit.Loaded;
begin
   inherited Loaded;

   LoadNewResource;
end;
 
{-- TMMLEDDigit ----------------------------------------------------------}
procedure TMMLedDigit.Paint;
Var
   MemDC: HDC;
   oldBitmap: HBitmap;
   BitmapOfs: integer;
   Blank: Boolean;

begin
   if (FBitmap = nil) then exit;

   if FZeroBlank AND (FValue = 0) then Blank := True
   else Blank := False;

   if (FType = ltDigit) then
       BitmapOfs := Width * ((Ord(FValue)+1) * Ord(Enabled)) * Ord(NOT Blank)
   else
       BitmapOfs := Width * (Ord(FType) * Ord(Enabled));

   MemDC := CreateCompatibleDC(0);
   oldBitmap := SelectObject(MemDC, FBitmap.Handle);
   BitBlt(Canvas.Handle,
          0, 0, Width, Height,
          MemDC,
          BitmapOfs, 0,
          SRCCOPY);
   SelectObject(MemDC, oldBitmap);
   DeleteDC(MemDC);
end;

{== TMMLEDPanel ==========================================================}
constructor TMMLedPanel.Create (aOwner: TComponent);
begin
     inherited Create (aOwner);

     ControlStyle := ControlStyle - [csAcceptsControls,csSetCaption];

     Color := clBlack;
     FValue := 0;
     FMinValue := 0;
     FMaxValue := 100;
     FInactiveColor := clGreen;
     FLEDColor := clLime;
     FDrawInactive := True;
     FZeroBlank := False;