mmegauge.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: 15.11.98 - 03:12:16 $                                        =}
{========================================================================}
Unit MMEGauge;

{$I COMPILER.INC}

Interface

Uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    Menus,
    MMUtils,
    MMString,
    MMObj,
    MMMulDiv,
    MMDIBCv;

const
    VALUERANGE      = 100; { Range for SetValue/GetValue, here 0..100%    }

type
    TMMLEDGaugeKind      = (gkHorizontal, gkVertical);
    TMMLEDGaugeDirection = (dirNormal, dirReversed);

    TMMLEDDrawBar        = procedure(Sender: TObject; DIB: TMMDIBCanvas;
                                     Rect: TRect; nSpots: integer) of object;

    {-- TMMLEDGauge ---------------------------------------------------------}
    TMMLEDGauge = class(TMMDIBGraphicControl)
    private
      FBarDIB       : TMMDIBCanvas; { bitmap for inactive spots            }
      FKind         : TMMLEDGaugeKind; { draw horizontal / vertikal bars      }
      FBar1Color    : TColor;       { Farbe f黵 die Punkte im 1. Abschnitt }
      FBar2Color    : TColor;       { Farbe f黵 die Punkte im 2. Abschnitt }
      FBar3Color    : TColor;       { Farbe f黵 die Punkte im 3. Abschnitt }
      FInact1Color  : TColor;       { foreColor for inactive spots 1       }
      FInact2Color  : TColor;       { foreColor for inactive spots 2       }
      FInact3Color  : TColor;       { foreColor for inactive spots 3       }
      FInactiveDoted: Boolean;      { draw the inactive spots doted        }
      FActiveDoted  : Boolean;      { draw the active spots doted          }
      FPoint1       : integer;      { Schwelle von 1. zu 2. Abschnitt %    }
      FPoint2       : integer;      { Schwelle von 2. zu 3. Abschnitt %    }
      FPoint1Spot   : integer;      { on which spot begins next color      }
      FPoint2Spot   : integer;      { on which spot begins next color      }
      FSpotSpace    : integer;      { Horizontal space between spots       }
      FSpotWidth    : integer;      { the spot width in pixel              }
      FFirstSpace   : integer;      { the space before the first spot      }
      FNumSpots     : integer;      { number of Spots                      }
      FDirection    : TMMLEDGaugeDirection;{ draw direction, forward/backward }
      FProgress     : integer;
      FData         : integer;      { the current data for the gauge       }
      FWidth        : integer;      { calculated width without border      }
      FHeight       : integer;      { calculated height without border     }
      FClientRect   : TRect;        { calculated beveled Rect              }
      FTag2         : integer;
      FOnDrawBar    : TMMLEDDrawBar;

      procedure AdjustSize(var W, H: Integer);
      procedure CalcNumSpots;
      procedure DrawInactiveSpots;
      procedure DrawBarHorizontal(DIB: TMMDIBCanvas; nSpots: integer);
      procedure DrawBarVertical(DIB: TMMDIBCanvas; nSpots: integer);
      procedure DrawBar(Dummy: Boolean);

      procedure SetOnDrawBar(aValue: TMMLEDDrawBar);
      procedure SetKind(aValue: TMMLEDGaugeKind);
      Procedure SetColors(Index: Integer; aValue: TColor);
      procedure SetPoints(Index, aValue: integer);
      procedure SetSpotSpace(aValue: integer);
      procedure SetSpotWidth(aValue: integer);
      procedure SetDirection(aValue: TMMLEDGaugeDirection);
      procedure SetInactiveDoted(aValue: Boolean);
      procedure SetActiveDoted(aValue: Boolean);
      procedure SetProgress(aValue: integer);

      procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;

    protected
      procedure SetBPP(aValue: integer); override;
      procedure Paint; override;
      procedure Loaded; override;
      procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
      procedure Changed; override;

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

      property    NumSpots: integer read FNumSpots;
      property    Point1Spot: integer read FPoint1Spot;
      property    Point2Spot: integer read FPoint2Spot;

    published
      property OnClick;
      property OnDblClick;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property OnDragDrop;
      property OnDragOver;
      property OnEndDrag;
      property OnStartDrag;
      property OnDrawBar: TMMLEDDrawBar read FOnDrawBar write SetOnDrawBar;

      property Align;
      property Bevel;
      property PopupMenu;
      property ParentShowHint;
      property ShowHint;
      property Visible;
      property Enabled;
      property DragCursor;
      property ParentColor default False;
      property Color default clBlack;
      property Kind: TMMLEDGaugeKind read FKind write SetKind default gkHorizontal;
      property Height default 17;
      property Width default 200;
      property SpotSpace: integer read FSpotSpace write SetSpotSpace default 1;
      property SpotWidth: integer read FSpotWidth write SetSpotWidth default 1;
      property Bar1Color: TColor index 0 read FBar1Color write SetColors default clAqua;
      property Bar2Color: TColor index 1 read FBar2Color write SetColors default clAqua;
      property Bar3Color: TColor index 2 read FBar3Color write SetColors default clRed;
      property Inactive1Color: TColor index 3 read FInact1Color write SetColors default clTeal;
      property Inactive2Color: TColor index 4 read FInact2Color write SetColors default clTeal;
      property Inactive3Color: TColor index 5 read FInact3Color write SetColors default clMaroon;
      property InactiveDoted: Boolean read FInactiveDoted write SetInactiveDoted default False;
      property ActiveDoted: Boolean read FActiveDoted write SetActiveDoted default False;
      property Point1: integer index 0 Read FPoint1 write SetPoints default 50;
      property Point2: integer index 1 Read FPoint2 write SetPoints default 85;
      property Direction: TMMLEDGaugeDirection read FDirection write SetDirection default dirNormal;
      property Progress: integer read FProgress write SetProgress default 0;
      property Tag2: integer read FTag2 write FTag2;
    end;

implementation

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

   FBarDIB := TMMDIBCanvas.Create(Self);
   FKind := gkHorizontal;
   FDirection := dirNormal;
   FBar1Color := clAqua;
   FBar2Color := clAqua;
   FBar3Color := clRed;
   FInact1Color := clTeal;
   FInact2Color := clTeal;
   FInact3Color := clMaroon;
   FInactiveDoted := False;
   FActiveDoted := False;
   FSpotSpace := 1;
   FSpotWidth := 1;
   FProgress  := 0;
   FData := 0;
   FPoint1 := 50;
   FPoint2 := 85;
   Height := 17;
   Width := 200;
   Color := clBlack;

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

{-- TMMLEDGauge ------------------------------------------------------}
Destructor TMMLEDGauge.Destroy;
begin
   FBarDIB.Free;

   inherited Destroy;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetKind(aValue: TMMLEDGaugeKind);
var
   Temp: integer;
begin
   if (aValue <> FKind) then
   begin
      FKind := aValue;
      if ((FKind = gkHorizontal) and (Height > Width)) or
         ((FKind = gkVertical) and (Height < Width)) then
      begin
         Temp := Width;
         Width := Height;                        { swap Width and Height }
         Height := Temp;
      end;
      Changed;                                    { recalc the dimension }
      Invalidate;
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetDirection(aValue: TMMLEDGaugeDirection);
Begin
   if (aValue <> FDirection) then
   begin
      FDirection := aValue;
      DrawInactiveSpots;
      Invalidate;
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetSpotSpace(aValue: integer);
begin
   aValue := MinMax(aValue, 0, 10);
   if (aValue <> FSpotSpace) then
   begin
      FSpotSpace := aValue;
      CalcNumSpots;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetSpotWidth(aValue: integer);
Var
   Temp: integer;

begin
   Temp := 0;
   case FKind of
      gkHorizontal: Temp := FWidth div 3;
      gkVertical  : Temp := FHeight div 3;
   end;

   aValue := MinMax(aValue, 1, Temp);
   if (aValue <> FSpotWidth) then
   begin
      FSpotWidth := aValue;
      CalcNumSpots;
      Invalidate;
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.CalcNumSpots;
begin
   FSpotWidth := Max(FSpotWidth,1);
   if (FKind = gkHorizontal) then
   begin
      FNumSpots := (FWidth+FSpotSpace) div (FSpotWidth+FSpotSpace);
      FNumSpots := Max(FNumSpots,1);          { fix div by zerro !!! }
      FFirstSpace := (FWidth-(FNumSpots*(FSpotWidth+FSpotSpace)-FSpotSpace)) div 2;
   end
   else
   begin
      FNumSpots := (FHeight+FSpotSpace)div(FSpotWidth+FSpotSpace);
      FNumSpots := Max(FNumSpots,1);           { fix div by zerro !!! }
      FFirstSpace := (FHeight-(FNumSpots*(FSpotWidth+FSpotSpace)-FSpotSpace)) div 2;
   end;

   { calc the spot on which the next color starts }
   FPoint1Spot := (FPoint1 * FNumSpots) div 100;
   FPoint2Spot := (FPoint2 * FNumSpots) div 100;

   { redraw background }