home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmGauge.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  24KB  |  689 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmGuage
  5. Purpose  : Visual UI eye-candy type gages.
  6. Date     : 09-03-1998
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. ================================================================================}
  10.  
  11. unit rmGauge;
  12.  
  13. interface
  14.  
  15. {$I CompilerDefines.INC}
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math;
  19.  
  20. type
  21.   TGaugeShape = (gsTriangle, gsVertRect, gsHorzRect, gsEllipse, gsArc, gsPole);
  22.   TGaugeBorder = (gbNone, gbSingle, gbRaised, gbLowered);
  23.   TrmGauge = class(TGraphicControl)
  24.   private
  25.     { Private declarations }
  26.     fBorder : TGaugeBorder;
  27.     fShape : TGaugeShape;
  28.     fgradient, fusemiddle: boolean;
  29.     fpercent : integer;
  30.     fStartColor, fMiddleColor, fEndColor : TColor;
  31.     fOnChangeEvent : TNotifyEvent;
  32.     procedure SetGradient(Value:Boolean);
  33.     procedure SetShape(Value : TGaugeShape);
  34.     procedure SetBorder(Value : TGaugeBorder);
  35.     procedure SetPercent(value:integer);
  36.     procedure SetStartColor(Value : TColor);
  37.     procedure SetMiddleColor(Value:TColor);
  38.     procedure SetEndColor(Value :TColor);
  39.     procedure SetUseMiddle(Value:Boolean);
  40.   protected
  41.     { Protected declarations }
  42.     function ColorUsed(TestColor:TColor):boolean;
  43.     function UniqueColor:TColor;
  44.     function CalcColorIndex(StartColor, EndColor:TColor; Steps, ColorIndex:integer):TColor;
  45.     function GradientColorIndex(ColorIndex:integer):TColor;
  46.     procedure GetBorderColors(var TopColor, BottomColor:TColor);
  47.     procedure PaintTriangle;
  48.     procedure PaintEllipse;
  49.     procedure PaintHorzRect;
  50.     procedure PaintVertRect;
  51.     procedure PaintArc;
  52.     procedure PaintPole;
  53.     procedure paint; override;
  54.   public
  55.     { Public declarations }
  56.     constructor Create(AOwner:TComponent); override;
  57.   published
  58.     { Published declarations }
  59.     property Border : TGaugeBorder read fborder write SetBorder default gbsingle;
  60.     property Shape : TGaugeShape read fshape write SetShape default gsVertRect;
  61.     property GradientFill : boolean read fGradient write SetGradient default False;
  62.     property Percent:integer read fpercent write setpercent default 0;
  63.     property FillColor : TColor read fStartColor write SetStartColor default clLime;
  64.     property GradientColor : TColor read fEndColor write SetEndColor default clRed;
  65.     property MedianColor : TColor read fMiddleColor write SetMiddleColor default clYellow;
  66.     property UseMedianColor : Boolean read fusemiddle write setusemiddle default false;
  67.     property OnChange : TNotifyEvent read fOnChangeEvent write fOnChangeEvent;
  68.   end;
  69.  
  70. implementation
  71.  
  72. { TrmGauge }
  73.  
  74. constructor TrmGauge.Create(AOwner:TComponent);
  75. begin
  76.      inherited create(AOwner);
  77.      width := 100;
  78.      height := 50;
  79.      fgradient := false;
  80.      fshape := gsVertRect;
  81.      fborder := gbSingle;
  82.      fstartcolor := cllime;
  83.      fendcolor := clred;
  84.      fmiddlecolor := clyellow;
  85.      fusemiddle := false;
  86.      fpercent := 0;
  87. end;
  88.  
  89. procedure TrmGauge.paint;
  90. begin
  91.      case shape of
  92.           gsTriangle : PaintTriangle;
  93.           gsHorzRect : PaintHorzRect;
  94.           gsEllipse  : PaintEllipse;
  95.           gsArc      : PaintArc;
  96.           gsVertRect : PaintVertRect;
  97.           gsPole     : PaintPole;
  98.      end;
  99. end;
  100.  
  101. procedure TrmGauge.GetBorderColors(var TopColor, BottomColor:TColor);
  102. begin
  103.      case border of
  104.           gbSingle:begin
  105.                         topColor := clWindowFrame;
  106.                         bottomcolor := topcolor;
  107.                    end;
  108.           gbRaised:begin
  109.                         topcolor := clbtnhighlight;
  110.                         bottomcolor := clbtnshadow;
  111.                    end;
  112.           gbLowered:begin
  113.                          topcolor := clbtnshadow;
  114.                          bottomcolor := clbtnhighlight;
  115.                     end;
  116.           else
  117.           begin
  118.                topcolor := clbtnface;
  119.                bottomcolor := topcolor;
  120.           end;
  121.      end;
  122. end;
  123.  
  124. procedure TrmGauge.PaintHorzRect;
  125. var
  126.    bmp : tbitmap;
  127.    wrect, wr2 : TRect;
  128.    topColor, bottomcolor : TColor;
  129.    NewBrush, OldBrush : HBrush;
  130.    loop : integer;
  131. begin
  132.      bmp := tbitmap.create;
  133.      bmp.width := width;
  134.      bmp.height := height;
  135.      bmp.canvas.brush.color := clbtnface;
  136.      bmp.canvas.fillrect(rect(0,0,width-1,height-1));
  137.  
  138.      GetBorderColors(TopColor,BottomColor);
  139.      with bmp.Canvas do
  140.      begin
  141.           wrect := rect(0,0,width,height);
  142.           if border <> gbNone then
  143.           begin
  144.              pen.color := TopColor;
  145.              PolyLine([point(width-1,0),point(0,0),point(0,height-1)]);
  146.              pen.color := BottomColor;
  147.              PolyLine([point(0,height-1),point(width-1,height-1),point(width-1,0)]);
  148.              inflaterect(wrect,-1,-1);
  149.           end;
  150.           brush.color := clbtnface;
  151.           fillrect(wrect);
  152.           if gradientfill then
  153.           begin
  154.                for loop := 0 to percent-1 do
  155.                begin
  156.                     wr2 := rect(0,wrect.top, 0,wrect.bottom);
  157.                     wr2.Left  := wrect.Left+ MulDiv (loop    , wrect.Right-wrect.Left, 100);
  158.                     wr2.Right := wrect.Left+ MulDiv (loop + 1, wrect.Right-wrect.Left, 100);
  159.  
  160.                     NewBrush := CreateSolidBrush(GradientColorIndex(loop+1));
  161.                     OldBrush := SelectObject(bmp.Canvas.handle, NewBrush);
  162.                     try
  163.                       PatBlt(bmp.Canvas.handle, wr2.Left, wr2.Top, wr2.Right-wr2.Left, wr2.Bottom-wr2.Top, PATCOPY);
  164.                     finally
  165.                       SelectObject(bmp.Canvas.handle, OldBrush);
  166.                       DeleteObject(NewBrush);
  167.                     end;
  168.                end;
  169.           end
  170.           else
  171.           begin
  172.                wrect.Right := wrect.Left + (((wrect.Right-Wrect.left) * percent) div 100);
  173.                brush.color := fillcolor;
  174.                fillrect(wrect);
  175.           end;
  176.      end;
  177.      bitblt(canvas.handle,0,0,width,height,bmp.canvas.handle,0,0,srccopy);
  178.      bmp.free;
  179. end;
  180.  
  181. procedure TrmGauge.PaintVertRect;
  182. var
  183.    bmp : TBitmap;
  184.    wrect, wr2 : TRect;
  185.    topColor, bottomcolor : TColor;
  186.    NewBrush, OldBrush : HBrush;
  187.    loop : integer;
  188. begin
  189.      bmp := tbitmap.create;
  190.      bmp.width := width;
  191.      bmp.height := height;
  192.      bmp.canvas.brush.color := clbtnface;
  193.      bmp.canvas.fillrect(rect(0,0,width-1,height-1));
  194.  
  195.      GetBorderColors(TopColor,BottomColor);
  196.      with bmp.canvas do
  197.      begin
  198.           wrect := rect(0,0,width,height);
  199.           if border <> gbNone then
  200.           begin
  201.              pen.color := TopColor;
  202.              PolyLine([point(width-1,0),point(0,0),point(0,height-1)]);
  203.              pen.color := BottomColor;
  204.              PolyLine([point(0,height-1),point(width-1,height-1),point(width-1,0)]);
  205.              inflaterect(wrect,-1,-1);
  206.           end;
  207.           brush.color := clbtnface;
  208.           fillrect(wrect);
  209.           if gradientfill then
  210.           begin
  211.                for loop := 0 to percent-1 do
  212.                begin
  213.                     wr2 := rect(wrect.left,0,wrect.right,0);
  214.                     wr2.Bottom  := wrect.Bottom- MulDiv (loop    , wrect.Bottom-wrect.Top, 100);
  215.                     wr2.Top := wrect.Bottom- MulDiv (loop + 1, wrect.Bottom-wrect.Top, 100);
  216.  
  217.                     NewBrush := CreateSolidBrush(GradientColorIndex(loop+1));
  218.                     OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
  219.                     try
  220.                       PatBlt(bmp.canvas.handle, wr2.Left, wr2.Top, wr2.Right-wr2.Left, wr2.Bottom-wr2.Top, PATCOPY);
  221.                     finally
  222.                       SelectObject(bmp.canvas.handle, OldBrush);
  223.                       DeleteObject(NewBrush);
  224.                     end;
  225.                end;
  226.           end
  227.           else
  228.           begin
  229.                wrect.Top := wrect.Bottom - (((wrect.Bottom-Wrect.Top) * percent) div 100);
  230.                brush.color := fillcolor;
  231.                fillrect(wrect);
  232.           end;
  233.      end;
  234.      bitblt(canvas.handle,0,0,width,height,bmp.canvas.handle,0,0,srccopy);
  235.      bmp.free;
  236. end;
  237.  
  238. procedure TrmGauge.PaintTriangle;
  239. var
  240.    bmp : TBitMap;
  241.    topColor, bottomcolor : TColor;
  242.    theta, adjacent : double;
  243.    NewBrush, OldBrush : HBrush;
  244.    NewPen, OldPen : HPen;
  245.    loop : integer;
  246. begin
  247.      bmp := tbitmap.create;
  248.      bmp.width := width;
  249.      bmp.height := height;
  250.      bmp.canvas.brush.color := clbtnface;
  251.      bmp.canvas.fillrect(rect(0,0,width-1,height-1));
  252.  
  253.      GetBorderColors(TopColor,BottomColor);
  254.      with bmp.canvas do
  255.      begin
  256.           brush.color := clbtnface;
  257.           pen.color := brush.color;
  258.           Polygon([point(width-1,0),point(0,height-1),point(width-1,height-1)]);
  259.           if percent > 0 then
  260.           begin
  261.                if gradientfill then
  262.                begin
  263.                     theta := ArcTan(height/width);
  264.                     for loop := Percent downto 1 do
  265.                     begin
  266.                          NewBrush := CreateSolidBrush(GradientColorIndex(loop));
  267.                          OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
  268.                          NewPen := CreatePen(ps_Solid,1,GradientColorIndex(loop));
  269.                          OldPen := SelectObject(bmp.canvas.handle, NewPen);
  270.                          try
  271.                             adjacent := ((width-1) * loop) / 100;
  272.                             polygon([point(0,height-1),
  273.                                      point(round(adjacent),height-1),
  274.                                      point(round(adjacent),(height)-trunc(tan(theta) * adjacent))]);
  275.                          finally
  276.                            SelectObject(bmp.canvas.handle, OldPen);
  277.                            DeleteObject(NewPen);
  278.                            SelectObject(bmp.canvas.handle, OldBrush);
  279.                            DeleteObject(NewBrush);
  280.                          end;
  281.                     end;
  282.                end
  283.                else
  284.                begin
  285.                     brush.color := fillcolor;
  286.                     pen.color := fillcolor;
  287.                     theta := ArcTan(height/width);
  288.                     adjacent := ((width-1) * percent) / 100;
  289.                     polygon([point(0,height-1),
  290.                              point(round(adjacent),height-1),
  291.                              point(round(adjacent),(height)-trunc(tan(theta) * adjacent))]);
  292.                end;
  293.           end;
  294.           if border <> gbNone then
  295.           begin
  296.              pen.color := TopColor;
  297.              PolyLine([point(width-1,0),point(0,height-1)]);
  298.              pen.color := BottomColor;
  299.              PolyLine([point(0,height-1),point(width-1,height-1),point(width-1,0)]);
  300.           end;
  301.      end;
  302.      bitblt(canvas.handle,0,0,width,height,bmp.canvas.handle,0,0,srccopy);
  303.      bmp.free;
  304. end;
  305.  
  306. procedure TrmGauge.PaintArc;
  307. var
  308.    bmp : TBitMap;
  309.    topColor, bottomcolor : TColor;
  310.    angle, incangle : double;
  311.    lastx, lasty : integer;
  312.    NewBrush, OldBrush : HBrush;
  313.    NewPen, OldPen : HPen;
  314.    loop : integer;
  315. begin
  316.      bmp := tbitmap.create;
  317.      bmp.width := width;
  318.      bmp.height := height;
  319.      bmp.canvas.brush.color := clbtnface;
  320.      bmp.canvas.fillrect(rect(0,0,width-1,height-1));
  321.  
  322.      GetBorderColors(TopColor,BottomColor);
  323.      with bmp.canvas do
  324.      begin
  325.        Brush.Color := clbtnface;
  326.        pen.color := clbtnface;
  327.        Pie(0, 0, Width-1, (Height shl 1) - 1, Width-1, height - 1, 0, height - 1);
  328.  
  329.        if percent > 0 then
  330.        begin
  331.             if gradientfill then
  332.             begin
  333.                  lastx := 0;
  334.                  lasty := height-1;
  335.                  for loop := 1 to percent do
  336.                  begin
  337.                       NewBrush := CreateSolidBrush(GradientColorIndex(loop));
  338.                       OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
  339.                       NewPen := CreatePen(ps_Solid,1,GradientColorIndex(loop));
  340.                       OldPen := SelectObject(bmp.canvas.handle, NewPen);
  341.                       try
  342.                          if loop < percent then incangle := 0.027
  343.                          else
  344.                          incangle := 0;
  345.                          Angle := (Pi * ((loop / 100)));
  346.                          pie(0, 0, width-1, (Height shl 1) - 1, Round(((Width shr 1)-1) * (1 - Cos(Angle+incangle))), Round((height - 1) * (1 - Sin(Angle+incangle))), lastx, lasty);
  347.                          lastx := Round(((Width shr 1)-1) * (1 - Cos(Angle)));
  348.                          lasty := Round((height - 1) * (1 - Sin(Angle)));
  349.                       finally
  350.                         SelectObject(bmp.canvas.handle, OldPen);
  351.                         DeleteObject(NewPen);
  352.                         SelectObject(bmp.canvas.handle, OldBrush);
  353.                         DeleteObject(NewBrush);
  354.                       end;
  355.                  end;
  356.             end
  357.             else
  358.             begin
  359.                  Pen.Color := clblack;
  360.                  Pen.Width := 1;
  361.                  brush.color := fillcolor;
  362.                  Angle := (Pi * ((Percent / 100)));
  363.                  pie(0, 0, width-1, (Height shl 1) - 1, Round(((Width shr 1)-1) * (1 - Cos(Angle))), Round((height - 1) * (1 - Sin(Angle))), 0, height-1);
  364.             end;
  365.        end;
  366.  
  367.        if border <> gbNone then
  368.        begin
  369.             Pen.Width := 1;
  370.             Pen.Color :=  TopColor;
  371.             Arc (0, 0, width-1, (height shl 1)-1, // ellipse
  372.                  width-1, 0, // start
  373.                  0, (height shl 1)-1); // end
  374.  
  375.             Pen.Color :=  BottomColor;
  376.             Arc (0, 0, width - 1, (height shl 1)-1, // ellipse
  377.                  0, (height shl 1)-1, // start
  378.                  width - 1, 0); // end
  379.             moveto(0,height-1);
  380.             lineto(width-1,height-1);
  381.        end;
  382.      end;
  383.      bitblt(canvas.handle,0,0,width-1,height,bmp.canvas.handle,0,0,srccopy);
  384.      bmp.free;
  385. end;
  386.  
  387. procedure TrmGauge.PaintEllipse;
  388. var
  389.    bmp : TBitMap;
  390.    topColor, bottomcolor : TColor;
  391.    angle : double;
  392.    lastx, lasty : integer;
  393.    NewBrush, OldBrush : HBrush;
  394.    NewPen, OldPen : HPen;
  395.    loop : integer;
  396.    incangle : double;
  397. begin
  398.      bmp := tbitmap.create;
  399.      bmp.width := width;
  400.      bmp.height := height;
  401.      bmp.canvas.brush.color := clbtnface;
  402.      bmp.canvas.fillrect(rect(0,0,width-1,height-1));
  403.  
  404.      GetBorderColors(TopColor,BottomColor);
  405.      with bmp.canvas do
  406.      begin
  407.        Brush.Color := clbtnface;
  408.        pen.color := clbtnface;
  409.        Ellipse(0, 0, Width-1, Height - 1);
  410.  
  411.        if percent > 0 then
  412.        begin
  413.             if gradientfill then
  414.             begin
  415.                  lastx := 0;
  416.                  lasty := (height shr 1)-1;
  417.                  for loop := 1 to percent do
  418.                  begin
  419.                       NewBrush := CreateSolidBrush(GradientColorIndex(loop));
  420.                       OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
  421.                       NewPen := CreatePen(ps_Solid,1,GradientColorIndex(loop));
  422.                       OldPen := SelectObject(bmp.canvas.handle, NewPen);
  423.                       try
  424.                          Angle := (2 * Pi * ((loop / 100)));
  425.                          if loop < percent then incangle := 0.027
  426.                          else
  427.                          incangle := 0;
  428.                          pie(0, 0, width-1, Height-1, Round(((width shr 1)-1) * (1 - Cos(Angle+incangle))), Round(((height shr 1) - 1) * (1 - Sin(Angle+incangle))), lastx, lasty);
  429.                          lastx := Round(((width shr 1)-1) * (1 - Cos(Angle)));
  430.                          lasty := Round(((height shr 1) - 1) * (1 - Sin(Angle)));
  431.                       finally
  432.                         SelectObject(bmp.canvas.handle, OldPen);
  433.                         DeleteObject(NewPen);
  434.                         SelectObject(bmp.canvas.handle, OldBrush);
  435.                         DeleteObject(NewBrush);
  436.                       end;
  437.                  end;
  438.             end
  439.             else
  440.             begin
  441.                  Pen.Width := 1;
  442.                  brush.color := fillcolor;
  443.                  Pen.Color := clblack;
  444.                  Angle := (2*Pi * ((Percent / 100)));
  445.                  pie(0, 0, width-1, Height-1, Round(((width shr 1)-1) * (1 - Cos(Angle))), Round(((height shr 1) - 1) * (1 - Sin(Angle))), 0, (height shr 1)-1);
  446.             end;
  447.        end;
  448.  
  449.        if border <> gbNone then
  450.        begin
  451.             Pen.Color :=  TopColor;
  452.             Arc (0, 0, width-1, height-1, // ellipse
  453.                  width-1, 0, // start
  454.                  0, height-1); // end
  455.  
  456.             Pen.Color :=  BottomColor;
  457.             Arc (0, 0, width-1, height-1, // ellipse
  458.                  0, height-1, // start
  459.                  width, 0); // end
  460.        end;
  461.      end;
  462.      bitblt(canvas.handle,0,0,width-1,height-1,bmp.canvas.handle,0,0,srccopy);
  463.      bmp.free;
  464. end;
  465.  
  466. procedure TrmGauge.PaintPole;
  467. const
  468.      bw = 15;
  469. var
  470.    bmp : TBitMap;
  471.    wrect : TRect;
  472.    NewBrush, OldBrush : HBrush;
  473.    ph, loop : integer;
  474. begin
  475.      bmp := tbitmap.create;
  476.      bmp.width := width;
  477.      bmp.height := height;
  478.      bmp.canvas.brush.color := clbtnface;
  479.      bmp.canvas.fillrect(rect(0,0,width-1,height-1));
  480.      with bmp.canvas do
  481.      begin
  482.           moveto(width-1,0);
  483.           pen.Color := clblack;
  484.           lineto(0,0);
  485.           lineto(0,height-1);
  486.           lineto(width-1,height-1);
  487.           wrect := rect(((width-1)-3)-bw, 1,((width-1)-3),(height-1));
  488.           brush.color := clbtnface;
  489.           fillrect(wrect);
  490.           ph := round((((height-1)-1) * percent) / 100);
  491.           wrect := rect(((width-1)-3)-bw,(height-1) - ph,((width-1)-3),(height-1));
  492.           for loop := 1 to (bw shr 1) do
  493.           begin
  494.                if loop <= percent then
  495.                begin
  496.                     NewBrush := CreateSolidBrush(CalcColorIndex(fendcolor,fstartcolor,bw shr 1,loop));
  497.                     OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
  498.                     try
  499.                        PatBlt(bmp.canvas.handle, wrect.Left, wrect.Top, wrect.Right-wrect.Left, wrect.Bottom-wrect.Top, PATCOPY);
  500.                        inflaterect(wrect,-1,-1);
  501.                     finally
  502.                       SelectObject(bmp.canvas.handle, OldBrush);
  503.                       DeleteObject(NewBrush);
  504.                     end;
  505.                end;
  506.           end;
  507.      end;
  508.      bitblt(canvas.handle,0,0,width-1,height,bmp.canvas.handle,0,0,srccopy);
  509.      bmp.free;
  510. end;
  511.  
  512. procedure TrmGauge.SetGradient(Value:Boolean);
  513. begin
  514.      if fGradient <> value then
  515.      begin
  516.           fgradient := value;
  517.           invalidate;
  518.      end;
  519. end;
  520.  
  521. procedure TrmGauge.SetShape(Value : TGaugeShape);
  522. begin
  523.      if fshape <> value then
  524.      begin
  525.           fshape := value;
  526.           invalidate;
  527.      end;
  528. end;
  529.  
  530. procedure TrmGauge.SetBorder(Value : TGaugeBorder);
  531. begin
  532.      if fborder <> value then
  533.      begin
  534.           fborder := value;
  535.           invalidate;
  536.      end;
  537. end;
  538.  
  539. procedure TrmGauge.SetPercent(value:integer);
  540. begin
  541.      if (value < 0) or (value > 100) then exit;
  542.      if fpercent <> value then
  543.      begin
  544.           fpercent := value;
  545.           paint;
  546.           if assigned(fOnChangeEvent) then fOnChangeEvent(self);
  547.      end;
  548. end;
  549.  
  550. procedure TrmGauge.SetStartColor(Value : TColor);
  551. begin
  552.      if fStartcolor <> value then
  553.      begin
  554.           fStartColor := Value;
  555.           paint;
  556.      end;
  557. end;
  558.  
  559. procedure TrmGauge.SetUseMiddle(Value:Boolean);
  560. begin
  561.      if fUseMiddle <> value then
  562.      begin
  563.           fUseMiddle := Value;
  564.           paint;
  565.      end;
  566. end;
  567.  
  568. procedure TrmGauge.SetMiddleColor(Value:TColor);
  569. begin
  570.      if fMiddleColor <> value then
  571.      begin
  572.           fMiddleColor := Value;
  573.           paint;
  574.      end;
  575. end;
  576.  
  577. procedure TrmGauge.SetEndColor(Value :TColor);
  578. begin
  579.      if fendcolor <> value then
  580.      begin
  581.           fendcolor := value;
  582.           paint;
  583.      end;
  584. end;
  585.  
  586. function TrmGauge.GradientColorIndex(ColorIndex:integer):TColor;
  587. var
  588.   BeginRGBValue  : array[0..2] of Byte;
  589.   RGBDifference  : array[0..2] of integer;
  590.   Red       : Byte;
  591.   Green     : Byte;
  592.   Blue      : Byte;
  593.   StartColor, EndColor : TColor;
  594.   NumColors : integer;
  595. begin
  596.   if (Colorindex < 1) or (colorindex > 100) then
  597.      raise ERangeError.create('ColorIndex can''t be less than 1 or greater than 100');
  598.   if UseMedianColor then
  599.   begin
  600.        NumColors := 50;
  601.        if Colorindex <= 50 then
  602.        begin
  603.             StartColor := fStartColor;
  604.             EndColor := fMiddleColor;
  605.        end
  606.        else
  607.        begin
  608.             dec(ColorIndex,50);
  609.             StartColor := fMiddleColor;
  610.             EndColor := fEndColor;
  611.        end;
  612.   end
  613.   else
  614.   begin
  615.        NumColors := 100;
  616.        StartColor := fStartColor;
  617.        EndColor := fEndColor;
  618.   end;
  619.   dec(ColorIndex);
  620.   BeginRGBValue[0] := GetRValue (ColorToRGB (StartColor));
  621.   BeginRGBValue[1] := GetGValue (ColorToRGB (StartColor));
  622.   BeginRGBValue[2] := GetBValue (ColorToRGB (StartColor));
  623.  
  624.   RGBDifference[0] := GetRValue (ColorToRGB (EndColor)) - BeginRGBValue[0];
  625.   RGBDifference[1] := GetGValue (ColorToRGB (EndColor)) - BeginRGBValue[1];
  626.   RGBDifference[2] := GetBValue (ColorToRGB (EndColor)) - BeginRGBValue[2];
  627.  
  628.   { Calculate the color band's color }
  629.   Red   := BeginRGBValue[0] + MulDiv (ColorIndex, RGBDifference[0], NumColors - 1);
  630.   Green := BeginRGBValue[1] + MulDiv (ColorIndex, RGBDifference[1], NumColors - 1);
  631.   Blue  := BeginRGBValue[2] + MulDiv (ColorIndex, RGBDifference[2], NumColors - 1);
  632.  
  633.   result := rgb(red, green, blue);
  634. end;
  635.  
  636. function TrmGauge.CalcColorIndex(StartColor, EndColor:TColor; Steps, ColorIndex:integer):TColor;
  637. var
  638.   BeginRGBValue  : array[0..2] of Byte;
  639.   RGBDifference  : array[0..2] of integer;
  640.   Red       : Byte;
  641.   Green     : Byte;
  642.   Blue      : Byte;
  643.   NumColors : integer;
  644. begin
  645.   if (Colorindex < 1) or (colorindex > steps) then
  646.      raise ERangeError.create('ColorIndex can''t be less than 1 or greater than '+inttostr(steps));
  647.   NumColors := steps;
  648.   dec(ColorIndex);
  649.   BeginRGBValue[0] := GetRValue (ColorToRGB (StartColor));
  650.   BeginRGBValue[1] := GetGValue (ColorToRGB (StartColor));
  651.   BeginRGBValue[2] := GetBValue (ColorToRGB (StartColor));
  652.  
  653.   RGBDifference[0] := GetRValue (ColorToRGB (EndColor)) - BeginRGBValue[0];
  654.   RGBDifference[1] := GetGValue (ColorToRGB (EndColor)) - BeginRGBValue[1];
  655.   RGBDifference[2] := GetBValue (ColorToRGB (EndColor)) - BeginRGBValue[2];
  656.  
  657.   { Calculate the color band's color }
  658.   Red   := BeginRGBValue[0] + MulDiv (ColorIndex, RGBDifference[0], NumColors - 1);
  659.   Green := BeginRGBValue[1] + MulDiv (ColorIndex, RGBDifference[1], NumColors - 1);
  660.   Blue  := BeginRGBValue[2] + MulDiv (ColorIndex, RGBDifference[2], NumColors - 1);
  661.  
  662.   result := rgb(red, green, blue);
  663. end;
  664.  
  665. function TrmGauge.ColorUsed(TestColor:TColor):boolean;
  666. var
  667.    loop : integer;
  668.    tc, bc : TColor;
  669. begin
  670.      for loop := 1 to 100 do
  671.      begin
  672.           result := GradientColorIndex(loop) = testcolor;
  673.           if result then exit;
  674.      end;
  675.      GetBorderColors(Tc,Bc);
  676.      result := (TestColor = TC) or (TestColor = BC);
  677. end;
  678.  
  679. function TrmGauge.UniqueColor:TColor;
  680. begin
  681.      randomize;
  682.      result := random(rgb(255,255,255)+1);
  683.      while ColorUsed(result) do
  684.            result := random(rgb(255,255,255)+1);
  685. end;
  686.  
  687.  
  688. end.
  689.