SoftTalon - Home

...SoftTalon...

...Downloads

Software and other stuff

Below can be found links to available downloads. The currently available software programs can be found under the 'software' heading and some other goodies such as components can be found under the 'other stuff' heading.

Software:

Just click on the links to download.

    EyeDrives 4.0
    Size: 893 kb
    License: freeware
    Requirements: Windows 95/98/ME/NT/2000/XP
    64 mb RAM, 16 bit or greater color.

HaLWorks 2.3
Size: 2.3 mb
License: shareware
Requirements: Windows 95/98 Internet Explorer
Registering HaLWorks can be done at:
www.shareit.com/programs/102202.htm

All programs have complete install and un-install support and come with help files.

Freeware programs can be freely copied and used but may not be modified or sold and the author retains full copyright.

Shareware programs may be used freely for 30 days to evaluate their usefulness. If after this period you decide to register, the details can be found in the help file. If you decide not to register please remove the program from your computer. As the author believes most users to be honest, the shareware programs have full functionality and are not crippled in any way, just a nag screen on exit.

Other stuff:

Delphi components

These are some Delphi components that I have written or modified. If you program with Delphi, you are welcome to use them if you wish but, even though they work fine for me, I can't guarantee that they will do so for you - use at your own risk!

To use, right-click on the source code, select all and save to your computer - make sure you save with a PAS extension. Then just install into your Delphi IDE as normal.

STGauge.pas This is a gauge I find rather useful

{This is a freeware Delphi gauge with different shapes and colors.
This software is distributed as freeware and is provided to you "AS-IS". Any use or misuse of the software is solely the responsibility of you, the user.}

unit STGauge;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math, ExtCtrls;
type
  TGaugeShape = (gsTriangle, gsVertRect, gsHorzRect, gsEllipse, gsArc, gsPole);
  TGaugeBorder = (gbNone, gbSingle, gbRaised, gbLowered);
  TSTGauge = class(TGraphicControl)
  private
    { Private declarations }
    fTransparent : boolean;
    fBAColor : TColor;
    FBGColor : TColor;
    fBorder : TGaugeBorder;
    fShape : TGaugeShape;
    fgradient, fusemiddle: boolean;
    fpercent : integer;
    fStartColor, fMiddleColor, fEndColor : TColor;
    fOnChangeEvent : TNotifyEvent;
    procedure SetGradient(Value:Boolean);
    procedure SetShape(Value : TGaugeShape);
    procedure SetBorder(Value : TGaugeBorder);
    procedure SetPercent(value:integer);
    procedure SetStartColor(Value : TColor);
    procedure SetMiddleColor(Value:TColor);
    procedure SetEndColor(Value :TColor);
    procedure SetUseMiddle(Value:Boolean);
  protected
    { Protected declarations }
    function ColorUsed(TestColor:TColor):boolean;
    function UniqueColor:TColor;
    function CalcColorIndex(StartColor, EndColor:TColor; Steps, ColorIndex:integer):TColor;
    function GradientColorIndex(ColorIndex:integer):TColor;
    procedure GetBorderColors(var TopColor, BottomColor:TColor);
    procedure PaintTriangle;
    procedure PaintEllipse;
    procedure PaintHorzRect;
    procedure PaintVertRect;
    procedure PaintArc;
    procedure PaintPole;
    procedure paint; override;
    procedure SetBGColor (Value: TColor);
    procedure SetBAColor (Value: TColor);
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    procedure ChangeTransparent(b: boolean);
  published
    { Published declarations }
    property Transparent: boolean read FTransparent write ChangeTransparent default false;
    property Border : TGaugeBorder read fborder write SetBorder default gbsingle;
    property Shape : TGaugeShape read fshape write SetShape default gsVertRect;
    property GradientFill : boolean read fGradient write SetGradient default False;
    property Percent:integer read fpercent write setpercent default 0;
    property FillColor : TColor read fStartColor write SetStartColor default clLime;
    property GradientColor : TColor read fEndColor write SetEndColor default clRed;
    property MedianColor : TColor read fMiddleColor write SetMiddleColor default clYellow;
    property UseMedianColor : Boolean read fusemiddle write setusemiddle default false;
    property OnChange : TNotifyEvent read fOnChangeEvent write fOnChangeEvent;
    property Backcolor: TColor read Fbgcolor write SetBGcolor;
    property BlendColor: Tcolor read fBAColor write SetBAColor;
  end;

procedure Register;

implementation

constructor TSTGauge.Create(AOwner:TComponent);
begin
     inherited create(AOwner);
     width := 100;
     height := 50;
     fgradient := True;
     fshape := gsHorzRect;
     fborder := gbLowered;
     fstartcolor := cllime;
     fendcolor := clred;
     fmiddlecolor := clyellow;
     fusemiddle := true;
     fpercent := 0;
     fBGColor := clBlack;
     fBAColor := clBtnFace;
     fTransparent := False;
end;

procedure TSTGauge.paint;
begin
     case shape of
          gsTriangle : PaintTriangle;
          gsHorzRect : PaintHorzRect;
          gsEllipse  : PaintEllipse;
          gsArc      : PaintArc;
          gsVertRect : PaintVertRect;
          gsPole     : PaintPole;
     end;
end;

procedure TSTGauge.GetBorderColors(var TopColor, BottomColor:TColor);
begin
     case border of
          gbSingle:begin
                        topColor := clWindowFrame;
                        bottomcolor := topcolor;
                   end;
          gbRaised:begin
                        topcolor := clbtnhighlight;
                        bottomcolor := clbtnshadow;
                   end;
          gbLowered:begin
                         topcolor := clbtnshadow;
                         bottomcolor := clbtnhighlight;
                    end;
          else
          begin
               topcolor := clbtnface;
               bottomcolor := topcolor;
          end;
     end;
end;

procedure TSTGauge.PaintHorzRect;
var
   bmp : tbitmap;
   wrect, wr2 : TRect;
   topColor, bottomcolor : TColor;
   NewBrush, OldBrush : HBrush;
   loop : integer;
begin
     bmp := tbitmap.create;
     bmp.width := width;
     bmp.height := height;
     bmp.canvas.brush.color := FBGColor;
     bmp.canvas.fillrect(rect(0,0,width-1,height-1));

     GetBorderColors(TopColor,BottomColor);
     with bmp.Canvas do
     begin
          wrect := rect(0,0,width,height);
          if border <> gbNone then
          begin
             pen.color := TopColor;
             PolyLine([point(width-1,0),point(0,0),point(0,height-1)]);
             pen.color := BottomColor;
             PolyLine([point(0,height-1),point(width-1,height-1),point(width-1,0)]);
             inflaterect(wrect,-1,-1);
          end;
          brush.color := Fbgcolor;
          fillrect(wrect);
          if gradientfill then
          begin
               for loop := 0 to percent-1 do
               begin
                    wr2 := rect(0,wrect.top, 0,wrect.bottom);
                    wr2.Left  := wrect.Left+ MulDiv (loop    , wrect.Right-wrect.Left, 100);
                    wr2.Right := wrect.Left+ MulDiv (loop + 1, wrect.Right-wrect.Left, 100);

                    NewBrush := CreateSolidBrush(GradientColorIndex(loop+1));
                    OldBrush := SelectObject(bmp.Canvas.handle, NewBrush);
                    try
                      PatBlt(bmp.Canvas.handle, wr2.Left, wr2.Top, wr2.Right-wr2.Left, wr2.Bottom-wr2.Top, PATCOPY);
                    finally
                      SelectObject(bmp.Canvas.handle, OldBrush);
                      DeleteObject(NewBrush);
                    end;
               end;
          end
          else
          begin
               wrect.Right := wrect.Left + (((wrect.Right-Wrect.left) * percent) div 100);
               brush.color := fillcolor;
               fillrect(wrect);
          end;
     end;
     bitblt(canvas.handle,0,0,width,height,bmp.canvas.handle,0,0,srccopy);
     bmp.free;
end;

procedure TSTGauge.PaintVertRect;
var
   bmp : TBitmap;
   wrect, wr2 : TRect;
   topColor, bottomcolor : TColor;
   NewBrush, OldBrush : HBrush;
   loop : integer;
begin
     bmp := tbitmap.create;
     bmp.width := width;
     bmp.height := height;
     bmp.canvas.brush.color := FBGcolor;
     bmp.canvas.fillrect(rect(0,0,width-1,height-1));

     GetBorderColors(TopColor,BottomColor);
     with bmp.canvas do
     begin
          wrect := rect(0,0,width,height);
          if border <> gbNone then
          begin
             pen.color := TopColor;
             PolyLine([point(width-1,0),point(0,0),point(0,height-1)]);
             pen.color := BottomColor;
             PolyLine([point(0,height-1),point(width-1,height-1),point(width-1,0)]);
             inflaterect(wrect,-1,-1);
          end;
          brush.color := Fbgcolor;
          fillrect(wrect);
          if gradientfill then
          begin
               for loop := 0 to percent-1 do
               begin
                    wr2 := rect(wrect.left,0,wrect.right,0);
                    wr2.Bottom  := wrect.Bottom- MulDiv (loop    , wrect.Bottom-wrect.Top, 100);
                    wr2.Top := wrect.Bottom- MulDiv (loop + 1, wrect.Bottom-wrect.Top, 100);

                    NewBrush := CreateSolidBrush(GradientColorIndex(loop+1));
                    OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
                    try
                      PatBlt(bmp.canvas.handle, wr2.Left, wr2.Top, wr2.Right-wr2.Left, wr2.Bottom-wr2.Top, PATCOPY);
                    finally
                      SelectObject(bmp.canvas.handle, OldBrush);
                      DeleteObject(NewBrush);
                    end;
               end;
          end
          else
          begin
               wrect.Top := wrect.Bottom - (((wrect.Bottom-Wrect.Top) * percent) div 100);
               brush.color := fillcolor;
               fillrect(wrect);
          end;
     end;
     bitblt(canvas.handle,0,0,width,height,bmp.canvas.handle,0,0,srccopy);
     bmp.free;
end;

procedure TSTGauge.PaintTriangle;
var
   bmp : TBitMap;
   topColor, bottomcolor : TColor;
   theta, adjacent : double;
   NewBrush, OldBrush : HBrush;
   NewPen, OldPen : HPen;
   i,loop : integer;
begin
  bmp := tbitmap.create;
  bmp.Width := Width;
  bmp.Height := Height;
  if not Transparent then bmp.Canvas.Brush.Color := fBAColor else
                          bmp.Canvas.Brush.Color := Parent.Brush.Color;
  bmp.Canvas.Fillrect(rect(0,0,width-1,height-1));
  GetBorderColors(TopColor,BottomColor);
     with bmp.canvas do
     begin
          brush.color := fBGColor;
          pen.color := brush.color;
          Polygon([point(width-1,0),point(0,height-1),point(width-1,height-1)]);
         if percent > 0 then
          begin
               if gradientfill then
               begin
                    theta := ArcTan(height/width);
                    for loop := Percent downto 1 do
                    begin
                         NewBrush := CreateSolidBrush(GradientColorIndex(loop));
                         OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
                         NewPen := CreatePen(ps_Solid,1,GradientColorIndex(loop));
                         OldPen := SelectObject(bmp.canvas.handle, NewPen);
                         try
                            adjacent := ((width-1) * loop) / 100;
                            polygon([point(0,height-1),
                                     point(round(adjacent),height-1),
                                     point(round(adjacent),(height)-trunc(tan(theta) * adjacent))]);
                         finally
                           SelectObject(bmp.canvas.handle, OldPen);
                           DeleteObject(NewPen);
                           SelectObject(bmp.canvas.handle, OldBrush);
                           DeleteObject(NewBrush);
                         end;
                    end;
               end
               else
               begin
                    brush.color := fillcolor;
                    pen.color := fillcolor;
                    theta := ArcTan(height/width);
                    adjacent := ((width-1) * percent) / 100;
                    polygon([point(0,height-1),
                             point(round(adjacent),height-1),
                             point(round(adjacent),(height)-trunc(tan(theta) * adjacent))]);
               end;
          end;
          if border <> gbNone then
          begin
             pen.color := TopColor;
             PolyLine([point(width-1,0),point(0,height-1)]);
             pen.color := BottomColor;
             PolyLine([point(0,height-1),point(width-1,height-1),point(width-1,0)]);
          end;
     end;
     bitblt(canvas.handle,0,0,width,height,bmp.canvas.handle,0,0,srccopy);
     bmp.free;
end;

procedure TSTGauge.PaintArc;
var
   bmp : TBitMap;
   topColor, bottomcolor : TColor;
   angle, incangle : double;
   lastx, lasty : integer;
   NewBrush, OldBrush : HBrush;
   NewPen, OldPen : HPen;
   loop : integer;
begin
     bmp := tbitmap.create;
     bmp.width := width;
     bmp.height := height;
     if not Transparent then
       begin
         bmp.canvas.brush.color := fBAColor;//clbtnface;
         bmp.canvas.fillrect(rect(0,0,width-1,height-1));
         GetBorderColors(TopColor,BottomColor);
       end else
       begin
         bmp.canvas.brush.color := Parent.Brush.Color; //faColor;
         bmp.canvas.fillrect(rect(0,0,width-1,height-1));
         GetBorderColors(TopColor,BottomColor);
       end;
     with bmp.canvas do
     begin
       Brush.Color := Fbgcolor;
       pen.color := clbtnface;
       Pie(0, 0, Width-1, (Height shl 1) - 1, Width-1, height - 1, 0, height - 1);

       if percent > 0 then
       begin
            if gradientfill then
            begin
                 lastx := 0;
                 lasty := height-1;
                 for loop := 1 to percent do
                 begin
                      NewBrush := CreateSolidBrush(GradientColorIndex(loop));
                      OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
                      NewPen := CreatePen(ps_Solid,1,GradientColorIndex(loop));
                      OldPen := SelectObject(bmp.canvas.handle, NewPen);
                      try
                         if loop < percent then incangle := 0.027
                         else
                         incangle := 0;
                         Angle := (Pi * ((loop / 100)));
                         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);
                         lastx := Round(((Width shr 1)-1) * (1 - Cos(Angle)));
                         lasty := Round((height - 1) * (1 - Sin(Angle)));
                      finally
                        SelectObject(bmp.canvas.handle, OldPen);
                        DeleteObject(NewPen);
                        SelectObject(bmp.canvas.handle, OldBrush);
                        DeleteObject(NewBrush);
                      end;
                 end;
            end
            else
            begin
                 Pen.Color := clblack;
                 Pen.Width := 1;
                 brush.color := fillcolor;
                 Angle := (Pi * ((Percent / 100)));
                 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);
            end;
       end;

       if border <> gbNone then
       begin
            Pen.Width := 1;
            Pen.Color :=  TopColor;
            Arc (0, 0, width-1, (height shl 1)-1, // ellipse
                 width-1, 0, // start
                 0, (height shl 1)-1); // end

            Pen.Color :=  BottomColor;
            Arc (0, 0, width - 1, (height shl 1)-1, // ellipse
                 0, (height shl 1)-1, // start
                 width - 1, 0); // end
            moveto(0,height-1);
            lineto(width-1,height-1);
       end;
     end;
     bitblt(canvas.handle,0,0,width-1,height,bmp.canvas.handle,0,0,srccopy);
     bmp.free;
end;

procedure TSTGauge.PaintEllipse;
var
   bmp : TBitMap;
   topColor, bottomcolor : TColor;
   angle : double;
   lastx, lasty : integer;
   NewBrush, OldBrush : HBrush;
   NewPen, OldPen : HPen;
   loop : integer;
   incangle : double;
begin
     bmp := tBitmap.create;
     bmp.width := width;
     bmp.height := height;
     if not Transparent then
       begin
         bmp.canvas.brush.color := fBAColor;//clbtnface;
         bmp.canvas.fillrect(rect(0,0,width-1,height-1));
         GetBorderColors(TopColor,BottomColor);
       end else
       begin
         bmp.canvas.brush.color := Parent.Brush.Color;//faColor;
         bmp.canvas.fillrect(rect(0,0,width-1,height-1));
         GetBorderColors(TopColor,BottomColor);
       end;
     with bmp.canvas do
     begin
       Brush.Color := Fbgcolor;
       pen.color := clbtnface;
       Ellipse(0, 0, Width-1, Height - 1);

       if percent > 0 then
       begin
            if gradientfill then
            begin
                 lastx := 0;
                 lasty := (height shr 1)-1;
                 for loop := 1 to percent do
                 begin
                      NewBrush := CreateSolidBrush(GradientColorIndex(loop));
                      OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
                      NewPen := CreatePen(ps_Solid,1,GradientColorIndex(loop));
                      OldPen := SelectObject(bmp.canvas.handle, NewPen);
                      try
                         Angle := (2 * Pi * ((loop / 100)));
                         if loop < percent then incangle := 0.027
                         else
                         incangle := 0;
                         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);
                         lastx := Round(((width shr 1)-1) * (1 - Cos(Angle)));
                         lasty := Round(((height shr 1) - 1) * (1 - Sin(Angle)));
                      finally
                        SelectObject(bmp.canvas.handle, OldPen);
                        DeleteObject(NewPen);
                        SelectObject(bmp.canvas.handle, OldBrush);
                        DeleteObject(NewBrush);
                      end;
                 end;
            end
            else
            begin
                 Pen.Width := 1;
                 brush.color := fillcolor;
                 Pen.Color := clblack;
                 Angle := (2*Pi * ((Percent / 100)));
                 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);
            end;
       end;

       if border <> gbNone then
       begin
            Pen.Color :=  TopColor;
            Arc (0, 0, width-1, height-1, // ellipse
                 width-1, 0, // start
                 0, height-1); // end

            Pen.Color :=  BottomColor;
            Arc (0, 0, width-1, height-1, // ellipse
                 0, height-1, // start
                 width, 0); // end
       end;
     end;
     bitblt(canvas.handle,0,0,width-1,height-1,bmp.canvas.handle,0,0,srccopy);
     bmp.free;
end;

procedure TSTGauge.PaintPole;
const
     bw = 15;
var
   bmp : TBitMap;
   wrect : TRect;
   NewBrush, OldBrush : HBrush;
   ph, loop : integer;
begin
     bmp := tbitmap.create;
     bmp.width := width;
     bmp.height := height;
     bmp.canvas.brush.color := clBtnFace;
     bmp.canvas.fillrect(rect(0,0,width-1,height-1));
     with bmp.canvas do
     begin
          moveto(width-1,0);
          pen.Color := clblack;
          lineto(0,0);
          lineto(0,height-1);
          lineto(width-1,height-1);
          wrect := rect(((width-1)-3)-bw, 1,((width-1)-3),(height-1));
          brush.color := Fbgcolor;
          fillrect(wrect);
          ph := round((((height-1)-1) * percent) / 100);
          wrect := rect(((width-1)-3)-bw,(height-1) - ph,((width-1)-3),(height-1));
          for loop := 1 to (bw shr 1) do
          begin
               if loop <= percent then
               begin
                    NewBrush := CreateSolidBrush(CalcColorIndex(fendcolor,fstartcolor,bw shr 1,loop));
                    OldBrush := SelectObject(bmp.canvas.handle, NewBrush);
                    try
                       PatBlt(bmp.canvas.handle, wrect.Left, wrect.Top, wrect.Right-wrect.Left, wrect.Bottom-wrect.Top, PATCOPY);
                       inflaterect(wrect,-1,-1);
                    finally
                      SelectObject(bmp.canvas.handle, OldBrush);
                      DeleteObject(NewBrush);
                    end;
               end;
          end;
     end;
     bitblt(canvas.handle,0,0,width-1,height,bmp.canvas.handle,0,0,srccopy);
     bmp.free;
end;

procedure TSTGauge.SetGradient(Value:Boolean);
begin
     if fGradient <> value then
     begin
          fgradient := value;
          invalidate;
     end;
end;

procedure TSTGauge.SetShape(Value : TGaugeShape);
begin
     if fshape <> value then
     begin
          fshape := value;
          invalidate;
     end;
end;

procedure TSTGauge.SetBorder(Value : TGaugeBorder);
begin
     if fborder <> value then
     begin
          fborder := value;
          invalidate;
     end;
end;

procedure TSTGauge.SetPercent(value:integer);
begin
  if (value < 0) or (value > 100) then exit;
  if fpercent <> value then
     begin
          fpercent := value;
          paint;
          if assigned(fOnChangeEvent) then fOnChangeEvent(self);
     end;
end;

procedure TSTGauge.SetStartColor(Value : TColor);
begin
     if fStartcolor <> value then
     begin
          fStartColor := Value;
          paint;
     end;
end;

procedure TSTGauge.SetUseMiddle(Value:Boolean);
begin
     if fUseMiddle <> value then
     begin
          fUseMiddle := Value;
          paint;
     end;
end;

procedure TSTGauge.SetMiddleColor(Value:TColor);
begin
     if fMiddleColor <> value then
     begin
          fMiddleColor := Value;
          paint;
     end;
end;

procedure TSTGauge.SetEndColor(Value :TColor);
begin
     if fendcolor <> value then
     begin
          fendcolor := value;
          paint;
     end;
end;

function TSTGauge.GradientColorIndex(ColorIndex:integer):TColor;
var
  BeginRGBValue  : array[0..2] of Byte;
  RGBDifference  : array[0..2] of integer;
  Red       : Byte;
  Green     : Byte;
  Blue      : Byte;
  StartColor, EndColor : TColor;
  NumColors : integer;
begin
  if (Colorindex < 1) or (colorindex > 100) then
     raise ERangeError.create('ColorIndex can''t be less than 1 or greater than 100');
  if UseMedianColor then
  begin
       NumColors := 50;
       if Colorindex <= 50 then
       begin
            StartColor := fStartColor;
            EndColor := fMiddleColor;
       end
       else
       begin
            dec(ColorIndex,50);
            StartColor := fMiddleColor;
            EndColor := fEndColor;
       end;
  end
  else
  begin
       NumColors := 100;    //100;
       StartColor := fStartColor;
       EndColor := fEndColor;
  end;
  dec(ColorIndex);
  BeginRGBValue[0] := GetRValue (ColorToRGB (StartColor));
  BeginRGBValue[1] := GetGValue (ColorToRGB (StartColor));
  BeginRGBValue[2] := GetBValue (ColorToRGB (StartColor));

  RGBDifference[0] := GetRValue (ColorToRGB (EndColor)) - BeginRGBValue[0];
  RGBDifference[1] := GetGValue (ColorToRGB (EndColor)) - BeginRGBValue[1];
  RGBDifference[2] := GetBValue (ColorToRGB (EndColor)) - BeginRGBValue[2];

  { Calculate the color band's color }
  Red   := BeginRGBValue[0] + MulDiv (ColorIndex, RGBDifference[0], NumColors - 1);
  Green := BeginRGBValue[1] + MulDiv (ColorIndex, RGBDifference[1], NumColors - 1);
  Blue  := BeginRGBValue[2] + MulDiv (ColorIndex, RGBDifference[2], NumColors - 1);

  result := rgb(red, green, blue);
end;

function TSTGauge.CalcColorIndex(StartColor, EndColor:TColor; Steps, ColorIndex:integer):TColor;
var
  BeginRGBValue  : array[0..2] of Byte;
  RGBDifference  : array[0..2] of integer;
  Red       : Byte;
  Green     : Byte;
  Blue      : Byte;
  NumColors : integer;
begin
  if (Colorindex < 1) or (colorindex > steps) then
     raise ERangeError.create('ColorIndex can''t be less than 1 or greater than '+inttostr(steps));
  NumColors := steps;
  dec(ColorIndex);
  BeginRGBValue[0] := GetRValue (ColorToRGB (StartColor));
  BeginRGBValue[1] := GetGValue (ColorToRGB (StartColor));
  BeginRGBValue[2] := GetBValue (ColorToRGB (StartColor));

  RGBDifference[0] := GetRValue (ColorToRGB (EndColor)) - BeginRGBValue[0];
  RGBDifference[1] := GetGValue (ColorToRGB (EndColor)) - BeginRGBValue[1];
  RGBDifference[2] := GetBValue (ColorToRGB (EndColor)) - BeginRGBValue[2];

  { Calculate the color band's color }
  Red   := BeginRGBValue[0] + MulDiv (ColorIndex, RGBDifference[0], NumColors - 1);
  Green := BeginRGBValue[1] + MulDiv (ColorIndex, RGBDifference[1], NumColors - 1);
  Blue  := BeginRGBValue[2] + MulDiv (ColorIndex, RGBDifference[2], NumColors - 1);

  result := rgb(red, green, blue);
end;

function TSTGauge.ColorUsed(TestColor:TColor):boolean;
var
   loop : integer;
   tc, bc : TColor;
begin
     for loop := 1 to 100 do
     begin
          result := GradientColorIndex(loop) = testcolor;
          if result then exit;
     end;
     GetBorderColors(Tc,Bc);
     result := (TestColor = TC) or (TestColor = BC);
end;

function TSTGauge.UniqueColor:TColor;
begin
     randomize;
     result := random(rgb(255,255,255)+1);
     while ColorUsed(result) do
           result := random(rgb(255,255,255)+1);
end;

procedure TSTGauge.SetBGcolor(Value:  Tcolor);
begin
  if Value <> FBGcolor then
  begin
    Fbgcolor := Value;
    Invalidate;
  end;
end;

procedure TSTGauge.ChangeTransparent(b: boolean);
begin
  fTransparent := b;
  Invalidate;
end;

procedure TSTGauge.SetBAColor(Value:  TColor);
begin
  if Value <> fBAColor then
  begin
    fBAColor := Value;
    Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents('SoftTalon', [TSTGauge]);
end;

end.

STalonColBut.pas This is a TSpeedButton with some extra features.

{This is a freeware Delphi speedbutton with additional features.
This software is distributed as freeware and is provided to you "AS-IS". Any use or misuse of the software is solely the responsability of you, the user.}

unit STalonColBut;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Buttons;

type
  TAlignment = (alTopLeft, alTopCenter, alTopRight, alMiddleLeft,
  alMiddleCenter, alMiddleRight, alBottomLeft, alBottomCenter, alBottomRight);
  TButtonBevel = (bbLowered, bbNone, bbRaised);
  TButtonStyles = (bsAutoSize, bsCenter, bsStretch, bsShowFocus, bsShowKey);
  TButtonStyle = set of TButtonStyles;
  TButtonState = (bsUp, bsDown, bsDisabled);
  TSTalonColBut = class(TSpeedButton)
  private
    { Private declarations }
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FAlignment: TAlignment;
    FBevelStyle: TButtonBevel;
    FBevelSize: Integer;
    FColor: TColor;
    FSpacing: Integer;
    FStyle: TButtonStyle;
    FFocused: Boolean;
    FState: TButtonState;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure SetAlignment(Value: TAlignment);
    procedure SetBevelStyle(Value: TButtonBevel);
    procedure SetBevelSize(Value: Integer);
    procedure SetCaption(var Message: TMessage); message CM_TEXTCHANGED;
    procedure SetColor(Value: TColor);
    procedure SetEnabled(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure SetFocusOff(var Message: TMessage); message CM_LOSTFOCUS;
    procedure SetFocusOn(var Message: TMessage); message CM_GOTFOCUS;
    procedure SetFont(var Message: TMessage); message CM_FONTCHANGED;
    procedure SetSpacing(Value: Integer);
    procedure SetStyle(Value: TButtonStyle);
    procedure KeyAccel(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  protected
    { Protected declarations }
    FColorLeaveLabel: TColor;
    FColorEnterLabel: TColor;
    procedure SetColorLeaveLabel(aVal: TColor);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Paint; override;
  published
    { Published declarations }
    property ColorLeave: TColor read FColorLeaveLabel write SetColorLeaveLabel;
    property ColorEnter: TColor read FColorEnterLabel write FColorEnterLabel;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property Alignment: TAlignment read FAlignment write SetAlignment default alMiddleCenter;
    property BevelStyle: TButtonBevel read FBevelStyle write SetBevelStyle default bbRaised;
    property BevelSize: Integer read FBevelSize write SetBevelSize default 2;
    property Caption;
    property Color: TColor read FColor write SetColor default clBtnFace;
    property Cursor;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Height;
    property Left;
    property Name;
    property Spacing: Integer read FSpacing write SetSpacing default 2;
    property Style: TButtonStyle read FStyle write SetStyle default [bsCenter, bsShowFocus];
    property Tag;
    property Top;
    property Width;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

procedure Register;

function Smallest(X, Y: Integer): Integer;
function Largest(X, Y: Integer): Integer;
function GetHighlightColor(BaseColor: TColor): TColor;
function GetShadowColor(BaseColor: TColor): TColor;
function GetSpeedKey(var Caption: String): Integer;

implementation

function Smallest(X, Y: Integer): Integer;
begin
  if X < Y then Result := X else Result := Y;
end;

function Largest(X, Y: Integer): Integer;
begin
  if X > Y then Result := X else Result := Y;
end;

function GetHighlightColor(BaseColor: TColor): TColor;
begin
  Result := RGB(
  Smallest(GetRValue(ColorToRGB(BaseColor)) + 128, 255),
  Smallest(GetGValue(ColorToRGB(BaseColor)) + 128, 255),
  Smallest(GetBValue(ColorToRGB(BaseColor)) + 128, 255));
end;

function GetShadowColor(BaseColor: TColor): TColor;
begin
  Result := RGB(
  Largest(GetRValue(ColorToRGB(BaseColor)) - 128, 0),
  Largest(GetGValue(ColorToRGB(BaseColor)) - 128, 0),
  Largest(GetBValue(ColorToRGB(BaseColor)) - 128, 0));
end;

function GetSpeedKey(var Caption: String): Integer;
var
  keyPos: Integer;
begin
  keyPos := Pos('&', Caption);
  Delete(Caption, keyPos, 1);
  Result := keyPos;
end;

procedure TSTalonColBut.CMMouseEnter(var Message: TMessage);
begin
  inherited;
   if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  font.color := FColorEnterLabel;
end;

procedure TSTalonColBut.CMMouseLeave(var Message: TMessage);
begin
  inherited;
   if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  font.color := FColorLeaveLabel;
end;

constructor TSTalonColBut.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAlignment := alMiddleCenter;
  FBevelStyle := bbRaised;
  FBevelSize := 2;
  FColor := clBtnFace;
  FSpacing := 2;
  FStyle := [bsCenter, bsShowFocus, bsShowKey];
  FFocused := False;
  FState := bsUp;
  Width := 25; Height := 23;
  Enabled := True;
  Cursor := crHandPoint;
end;

destructor TSTalonColBut.Destroy;
begin
  inherited Destroy;
end;

procedure TSTalonColBut.SetColorLeaveLabel(aVal: TColor);
begin
  FColorLeaveLabel := aVal;
  font.color := aVal;
end;

procedure TSTalonColBut.Loaded;
begin
  inherited Loaded;
  if Enabled then FState := bsUp else FState := bsDisabled;
end;

procedure TSTalonColBut.Paint;
procedure DrawCaption(Offset: Integer);
var
  xLoc, yLoc, edgeSize, keyPos: Integer;
  newCaption: String;
  begin
    edgeSize := (FBevelSize + FSpacing);
    newCaption := Caption;
    keyPos := GetSpeedKey(newCaption);
    with inherited Canvas do
    begin
      case FAlignment of
      alTopLeft:
      	begin
    	  xLoc := edgeSize + Offset; yLoc := edgeSize + Offset;
      	end;
      alTopCenter:
      	begin
    	  xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) - TextWidth(newCaption)) div 2; yLoc := edgeSize + Offset;
      	end;
      alTopRight:
      	begin
    	  xLoc := Width - edgeSize - TextWidth(newCaption) + Offset; yLoc := edgeSize + Offset;
    	end;
      alMiddleLeft:
      	begin
    	  xLoc := edgeSize + Offset; yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) - TextHeight(newCaption)) div 2;
      	end;
      alMiddleCenter:
      	begin
      	  xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) - TextWidth(newCaption)) div 2;
      	  yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) - TextHeight(newCaption)) div 2;
      	end;
      alMiddleRight:
      	begin
    	  xLoc := Width - edgeSize - TextWidth(newCaption) + Offset;
      	  yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) - TextHeight(newCaption)) div 2;
      	end;
      alBottomLeft:
      	begin
    	  xLoc := edgeSize + Offset; yLoc := Height - edgeSize - TextHeight(newCaption) + Offset;
      	end;
      alBottomCenter:
      	begin
    	  xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) - TextWidth(newCaption)) div 2;
      	  yLoc := Height - edgeSize - TextHeight(newCaption) + Offset;
      	end;
      alBottomRight:
      	begin
    	  xLoc := Width - edgeSize - TextWidth(newCaption) + Offset;
    	  yLoc := Height - edgeSize - TextHeight(newCaption) + Offset;
    	end;
      else
       	xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) - TextWidth(newCaption)) div 2;
        yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) - TextHeight(newCaption)) div 2;
      end;
    TextOut(xLoc, yLoc, newCaption);
    if ((keyPos > 0) and (bsShowKey in FStyle)) then
      begin
        Pen.Color := Font.Color;
      	MoveTo(xLoc + (TextWidth(Copy(newCaption, 1, keyPos - 1))), yLoc + (TextHeight('ABC')));
      	LineTo(xLoc + (TextWidth(Copy(newCaption, 1, keyPos))), yLoc + (TextHeight('ABC')));
      end;
  end;
end;

var
Client: TRect;
clHigh, clLow: TColor;
begin
  if not Enabled and not (csDesigning in ComponentState) then FState := bsDisabled else
  if FState = bsDisabled then FState := bsUp;
    Client := Bounds(0, 0, Width, Height);
    Canvas.Font.Assign(Font);

  with inherited Canvas do
  begin
    Brush.Color := FColor;
    FillRect(Client);
    if not (FBevelStyle = bbNone) then
      begin
    	if ((FState = bsDown) xor (FBevelStyle = bbLowered)) then
      begin
      	clHigh := GetShadowColor(FColor);
        clLow := GetHighlightColor(FColor);
      end else
      begin
      	clHigh := GetHighlightColor(FColor);
        clLow := GetShadowColor(FColor);
      end;
    	Frame3D(Canvas, Client, clHigh, clLow, FBevelSize);
  end;

    if (FFocused and (bsShowFocus in FStyle)) and Enabled then
    	DrawFocusRect(Rect(
       	Client.Left + FSpacing - 1, Client.Top + FSpacing - 1,
        Client.Right - FSpacing + 1, Client.Bottom - FSpacing + 1));
        begin
      Brush.Color := FColor;
      FillRect(Rect(FBevelSize, FBevelSize, Width - FBevelSize, Height - FBevelSize));
    end;
  if (Caption <> '') then
    begin
      Brush.Style := bsClear;
    if ((not Enabled) and (not (csDesigning in ComponentState))) then
      begin
      	Font.Color := GetHighlightColor(FColor); DrawCaption(1);
        Font.Color := GetShadowColor(FColor); DrawCaption(0);
      end else DrawCaption(0);
    end;
  end;
end;

procedure TSTalonColBut.KeyAccel(var Message: TCMDialogChar);
begin
  with Message do
  begin
    if IsAccel(CharCode, Caption) and Enabled then
    begin
      Click;
      Result := 1;
    end else inherited;
  end;
end;

procedure TSTalonColBut.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Enabled then
    begin
      FState := bsDown;
      Repaint;
    end;
end;

procedure TSTalonColBut.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Enabled then
    begin
      FState := bsUp;
      Repaint;
    end;
end;

procedure TSTalonColBut.SetAlignment(Value: TAlignment);
begin
  FAlignment := Value;
  Repaint;
end;

procedure TSTalonColBut.SetBevelStyle(Value: TButtonBevel);
begin
  FBevelStyle := Value;
  Repaint;
end;

procedure TSTalonColBut.SetBevelSize(Value: Integer);
begin
  if Value < 1 then Value := 1;
  FBevelSize := Value;
  Repaint;
end;

procedure TSTalonColBut.SetCaption(var Message: TMessage);
begin
  Repaint;
end;

procedure TSTalonColBut.SetColor(Value: TColor);
begin
  FColor := Value;
  Repaint;
end;

procedure TSTalonColBut.SetEnabled(var Message: TMessage);
begin
  inherited;
  if Enabled then FState := bsUp else FState := bsDisabled;
  Repaint;
end;

procedure TSTalonColBut.SetFocusOff(var Message: TMessage);
begin
  inherited;
    FFocused := False;
    Repaint;
end;

procedure TSTalonColBut.SetFocusOn(var Message: TMessage);
begin
  inherited;
  FFocused := True;
  Repaint;
end;

procedure TSTalonColBut.SetFont(var Message: TMessage);
begin
  inherited;
  Repaint;
end;

procedure TSTalonColBut.SetSpacing(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Repaint;
  end;
end;

procedure TSTalonColBut.SetStyle(Value: TButtonStyle);
begin
  if FStyle <> Value then
    begin
      FStyle := Value;
      Repaint;
    end;
end;

procedure Register;
begin
  RegisterComponents('SoftTalon', [TSTalonColBut]);
end;

End.

Top of page