unit Gauges;

interface

uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, StdCtrls,
  dialogs, mysetupapi;

type

  TGaugeKind = (gkText, gkHorizontalBar, gkVerticalBar, gkPie, gkNeedle);

  TGauge = class(TGraphicControl)
  private
    FMinValue: Longint;
    FMaxValue: Longint;
    FCurValue: Longint;
    FKind: TGaugeKind;
    FShowText: Boolean;
    FBorderStyle: TBorderStyle;
    FForeColor: TColor;
    FBackColor: TColor;
    FTEXT: widestring;
    fborder: integer;
    procedure PaintBackground(AnImage: TBitmap);
    procedure PaintAsText(AnImage: TBitmap; PaintRect: TRect);
    procedure PaintAsNothing(AnImage: TBitmap; PaintRect: TRect);
    procedure PaintAsBar(AnImage: TBitmap; PaintRect: TRect);
    procedure PaintAsPie(AnImage: TBitmap; PaintRect: TRect);
    procedure PaintAsNeedle(AnImage: TBitmap; PaintRect: TRect);
    procedure SetGaugeKind(Value: TGaugeKind);
    procedure SetShowText(Value: Boolean);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetForeColor(Value: TColor);
    procedure SetBackColor(Value: TColor);
    procedure SetMinValue(Value: Longint);
    procedure SetMaxValue(Value: Longint);
    procedure SetProgress(Value: Longint);
    function GetPercentDone: Longint;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure AddProgress(Value: Longint);
    property PercentDone: Longint read GetPercentDone;
  published
    property Align;
    property Anchors;
    property BackColor: TColor read FBackColor write SetBackColor
      default clWhite;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle
      default bsSingle;
    property Color;
    property Constraints;
    property Enabled;
    property ForeColor: TColor read FForeColor write SetForeColor
      default clBlack;
    property Font;
    property Kind: TGaugeKind read FKind write SetGaugeKind
      default gkHorizontalBar;
    property MinValue: Longint read FMinValue write SetMinValue default 0;
    property MaxValue: Longint read FMaxValue write SetMaxValue default 100;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Progress: Longint read FCurValue write SetProgress;
    property ShowHint;
    property ShowText: Boolean read FShowText write SetShowText default True;
    property Visible;
    property Text: widestring read FTEXT write FTEXT;
    property border: integer read fborder write fborder;

  end;

implementation

uses Consts;

type
  TBltBitmap = class(TBitmap)
    procedure MakeLike(ATemplate: TBitmap);
  end;

  { TBltBitmap }

procedure TBltBitmap.MakeLike(ATemplate: TBitmap);
begin
  Width := ATemplate.Width;
  Height := ATemplate.Height;
  Canvas.Brush.Color := clWindowFrame;
  Canvas.Brush.Style := bsSolid;
  // Canvas.FillRect(Rect(0, 0, Width, Height));
end;

{ This function solves for x in the equation "x is y% of z". }
function SolveForX(Y, Z: Longint): Longint;
begin
  Result := Longint(Trunc(Z * (Y * 0.01)));
end;

{ This function solves for y in the equation "x is y% of z". }
function SolveForY(X, Z: Longint): Longint;
begin
  if Z = 0 then
    Result := 0
  else
    Result := Longint(Trunc((X * 100.0) / Z));
end;

{ TGauge }

constructor TGauge.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csFramed, csOpaque];
  { default values }
  FMinValue := 0;
  FMaxValue := 100;
  FCurValue := 0;
  FKind := gkHorizontalBar;
  FShowText := True;
  FBorderStyle := bsSingle;
  FForeColor := clBlack;
  FBackColor := clWhite;
  Width := 100;
  Height := 100;
  border := 5;
end;

function TGauge.GetPercentDone: Longint;
begin
  Result := SolveForY(FCurValue - FMinValue, FMaxValue - FMinValue);
end;

procedure TGauge.Paint;
var
  TheImage: TBitmap;
  OverlayImage: TBltBitmap;
  PaintRect: TRect;
  kx: integer;
begin
  with Canvas do
  begin
    TheImage := TBitmap.Create;
    try
      TheImage.Height := Height;
      TheImage.Width := Width;
      PaintBackground(TheImage);

      // Canvas.Rectangle(0,0,15,15);
      // Canvas.CopyRect(,TheImage.Canvas,);

      PaintRect := ClientRect;
      if FBorderStyle = bsSingle then
        InflateRect(PaintRect, -1, -1);
      OverlayImage := TBltBitmap.Create;
      try
        OverlayImage.MakeLike(TheImage);
        OverlayImage.Canvas.CopyRect(OverlayImage.Canvas.ClipRect, Canvas,
          Canvas.ClipRect);

        // PaintBackground(OverlayImage);
        case FKind of
          gkText:
            PaintAsNothing(OverlayImage, PaintRect);
          gkHorizontalBar, gkVerticalBar:
            PaintAsBar(OverlayImage, PaintRect);
          gkPie:
            PaintAsPie(OverlayImage, PaintRect);
          gkNeedle:
            PaintAsNeedle(OverlayImage, PaintRect);
        end;
        TheImage.Canvas.CopyMode := cmSrcInvert;
        TheImage.Canvas.Draw(0, 0, OverlayImage);
        TheImage.Canvas.CopyMode := cmSrcCopy;
        if ShowText then
          PaintAsText(TheImage, PaintRect);
      finally
        OverlayImage.Free;
      end;
      Canvas.CopyMode := cmSrcCopy;
      Canvas.Draw(0, 0, TheImage);
    finally
      TheImage.Destroy;
    end;
  end;
end;

procedure TGauge.PaintBackground(AnImage: TBitmap);
var
  ARect: TRect;
begin
  with AnImage.Canvas do
  begin
    CopyMode := cmBlackness;
    ARect := Rect(0, 0, Width, Height);
    CopyRect(ARect, AnImage.Canvas, ARect);
    CopyMode := cmSrcCopy;
  end;
end;

{ procedure TGauge.PaintAsText(AnImage: TBitmap; PaintRect: TRect);
  var
  S: string;
  X, Y: Integer;
  OverRect: TBltBitmap;
  begin
  OverRect := TBltBitmap.Create;

  try
  OverRect.MakeLike(AnImage);
  PaintBackground(OverRect);
  S := Format('Индексация %d%%', [PercentDone]);
  with OverRect.Canvas do
  begin
  Brush.Style := bsClear;
  Font := Self.Font;
  Font.Color := clWhite;
  with PaintRect do
  begin
  X := (Right - Left + 1 - TextWidth(S)) div 2;
  Y := (Bottom - Top + 1 - TextHeight(S)) div 2;
  end;
  TextRect(PaintRect, X, Y, S);
  end;
  AnImage.Canvas.CopyMode := cmSrcInvert;
  AnImage.Canvas.Draw(0, 0, OverRect);
  finally
  OverRect.Free;
  end;
  end; }

procedure TGauge.PaintAsText(AnImage: TBitmap; PaintRect: TRect);
// var
// S: string;
// X, Y: Integer;
// OverRect: TBltBitmap;
begin
  { animage.canvas.Font:=Font;
    animage.canvas.font.Color:=clwhite;
    animage.canvas.Brush.Style:=bsClear;
    //Ftext:='DIas'+#13+'Hello';
    inc(PaintRect.Left,border);
    inc(PaintRect.Top,border);
    dec(PaintRect.Right,border);
    dec(PaintRect.Bottom,border);

    DrawTextW(animage.canvas.Handle, PwideChar(FText), Length(FText), PaintRect, DT_CENTER or DT_EXPANDTABS );
  }

end;

procedure TGauge.PaintAsNothing(AnImage: TBitmap; PaintRect: TRect);
begin
  with AnImage do
  begin
    Canvas.Brush.Color := BackColor;
    Canvas.FillRect(PaintRect);
  end;
end;

{ procedure DrawGradient(ACanvas: TCanvas; Rect: TRect; Horicontal: Boolean;
  Colors: array of TColor);
  type
  RGBArray = array [0 .. 2] of Byte;
  var
  X, Y, Z, stelle, mx, bis, faColorsh, mass: integer;
  Faktor: double;
  A: RGBArray;
  B: array of RGBArray;
  merkw: integer;
  merks: TPenStyle;
  merkp: TColor;
  begin
  mx := High(Colors);
  if mx > 0 then
  begin
  if Horicontal then
  mass := Rect.Right - Rect.Left
  else
  mass := Rect.Bottom - Rect.Top;
  SetLength(B, mx + 1);
  for X := 0 to mx do
  begin
  Colors[X] := ColorToRGB(Colors[X]);
  B[X][0] := GetRValue(Colors[X]);
  B[X][1] := GetGValue(Colors[X]);
  B[X][2] := GetBValue(Colors[X]);
  end;
  merkw := ACanvas.Pen.Width;
  merks := ACanvas.Pen.Style;
  merkp := ACanvas.Pen.Color;
  ACanvas.Pen.Width := 1;
  ACanvas.Pen.Style := psSolid;
  faColorsh := Round(mass / mx);
  for Y := 0 to mx - 1 do
  begin
  if Y = mx - 1 then
  bis := mass - Y * faColorsh - 1
  else
  bis := faColorsh;
  for X := 0 to bis do
  begin
  stelle := X + Y * faColorsh;
  Faktor := X / bis;
  for Z := 0 to 3 do
  A[Z] := Trunc(B[Y][Z] + ((B[Y + 1][Z] - B[Y][Z]) * Faktor));
  ACanvas.Pen.Color := RGB(A[0], A[1], A[2]);
  if Horicontal then
  begin
  ACanvas.MoveTo(Rect.Left + stelle, Rect.Top);
  ACanvas.LineTo(Rect.Left + stelle, Rect.Bottom);
  end
  else
  begin
  ACanvas.MoveTo(Rect.Left, Rect.Top + stelle);
  ACanvas.LineTo(Rect.Right, Rect.Top + stelle);
  end;
  end;
  end;
  B := nil;
  ACanvas.Pen.Width := merkw;
  ACanvas.Pen.Style := merks;
  ACanvas.Pen.Color := merkp;
  end
  else
  // Please specify at least two colors
  raise EMathError.Create
  ('Es mussen mindestens zwei Farben angegeben werden.');
  end; }

procedure TGauge.PaintAsBar(AnImage: TBitmap; PaintRect: TRect);
var
  FillSize: Longint;
  W, H: integer;
  AnImage2: TBltBitmap;
begin
  // border:=5;
  AnImage2 := TBltBitmap.Create;
  AnImage2.MakeLike(AnImage);

  with AnImage.Canvas do
  begin
    // DrawGradient(AnImage.Canvas, PaintRect, false,
    // [$00D3A0AC, $00B35A6E, $00D3A0AC]); // $00B35A6E]);


    Brush.Color := BackColor;
    // FillRect(PaintRect);
    Pen.Color := ForeColor;
    Pen.Width := 1;
    Brush.Color := ForeColor;
    case FKind of
      gkHorizontalBar:
        begin
          inc(PaintRect.Left, border);
          inc(PaintRect.Top, border);
          dec(PaintRect.Right, border);
          dec(PaintRect.Bottom, border);

          W := (PaintRect.Right - 1) - (PaintRect.Left + 1);
          H := PaintRect.Bottom - PaintRect.Top - 2;

          // FillSize := SolveForX(PercentDone, W);
          FillSize := Round(W / MaxValue * Progress);
          // if FillSize > W then FillSize := W;
          if FillSize >= 0 then
          begin
            // FillRect(Rect(PaintRect.Left, PaintRect.Top, FillSize, H));
            AnImage.Canvas.Pen.Color := RGB(211, 204, 231);
            // animage. canvas.Rectangle(PaintRect);
            AnImage.Canvas.RoundRect(PaintRect.Left, PaintRect.Top,
              PaintRect.Right, PaintRect.Bottom, 2, 2);

            InflateRect(PaintRect, -1, -1);

            // DrawGradient(AnImage.Canvas, PaintRect, false, [clWhite, clBtnFace]); // $00B35A6E]);
            DrawGradient(AnImage.Canvas,PaintRect, clWhite, clsilver,
              gdTopBottom);

            AnImage.Canvas.Font := self.Font;
            AnImage.Canvas.Font.Color := $00B35A6E;
            AnImage.Canvas.Brush.Style := bsClear;

            DrawTextW(AnImage.Canvas.Handle, PwideChar(FTEXT), Length(FTEXT),
              PaintRect, DT_CENTER or DT_EXPANDTABS);

            // DrawGradient(AnImage2.Canvas, Rect(PaintRect.Left, PaintRect.Top,
            // PaintRect.Left + FillSize, PaintRect.Bottom), false,
            // [$00D3A0AC, $00B35A6E]); // $00B35A6E]);
            DrawGradient(AnImage2.Canvas, Rect(PaintRect.Left, PaintRect.Top,
              PaintRect.Left + FillSize, PaintRect.Bottom), $00D3A0AC, $00B35A6E,
              gdTopBottom);

            AnImage2.Canvas.Font := self.Font;
            AnImage2.Canvas.Font.Color := clWhite;
            AnImage2.Canvas.Brush.Style := bsClear;

            DrawTextW(AnImage2.Canvas.Handle, PwideChar(FTEXT), Length(FTEXT),
              PaintRect, DT_CENTER or DT_EXPANDTABS);

            AnImage.Canvas.CopyRect(Rect(PaintRect.Left, PaintRect.Top,
              PaintRect.Left + FillSize, PaintRect.Bottom), AnImage2.Canvas,
              Rect(PaintRect.Left, PaintRect.Top, PaintRect.Left + FillSize,
              PaintRect.Bottom));

          end;

        end;
      gkVerticalBar:
        begin
          FillSize := SolveForX(PercentDone, H);
          if FillSize >= H then
            FillSize := H - 1;
          FillRect(Rect(PaintRect.Left, H - FillSize, W, H));
        end;
    end;
  end;
end;

{
  var Paintbox:TPaintBox;
  Rect1:trect;
  Canva:Tcanvas;
  Bit1:TBitmap;
  TopOffset:integer;
  TX,TY:integer;
  text:string;
  begin
  Paintbox:=(sender as TPaintBox);
  Bit1:=TBitmap.Create;
  Bit1.Width:=Paintbox.Width;
  Bit1.Height:=Paintbox.Height;


  //Canva:=Tcanvas.Create;
  //bit1.Canvas.cop
  rect1:=Paintbox.ClientRect;
  try
  bit1.Canvas.CopyRect(rect1,Paintbox.Canvas,rect1);
  except showmessage('DIAS') end;
  canva:=bit1.Canvas;
  //canva:=bit1.Canvas;


  inc(rect1.Left,5);
  inc(rect1.Top,2);
  dec(rect1.Right,5);
  dec(rect1.Bottom,2);

  canva.Pen.Color:=RGB(211,204,231);
  canva.Rectangle(rect1);
  //canva.RoundRect(rect1.Left,rect1.Top,rect1.Right-rect1.Left+1,rect1.Bottom-rect1.Top+1,2,2);


  inc(rect1.Left,1);
  inc(rect1.Top,1);
  dec(rect1.Right,1);
  dec(rect1.Bottom,1);


  DrawGradient(canva,rect1, false, [clWhite,clBtnFace ]);// $00B35A6E]);

  canva.Font:=Paintbox.Font;

  //SetTextAlign( Canva.Handle, ta_Center);

  //SetBkMode(canva.Handle,TRANSPARENT);
  text:='Eiaaenaoey'#13+'I?eaao';
  canva.font.Color:=$00B35A6E;
  canva.Brush.Style:=bsClear;
  TopOffset := ( rect1.Bottom - rect1.Top - Canva.TextHeight( 'Eiaaenaoey' ) ) div 2;
  TX:=   Paintbox.ClientRect.Right div 2;
  TY:=rect1.Top + TopOffset;
  //canva.TextRect(rect1,TX,TY,'Eiaaenaoey');
  DrawText(Canva.Handle, PChar(Text), Length(Text), Rect1, DT_LEFT );

  if Progress_index>100 then Progress_index:=100;
  rect1.Right := round((rect1.Right - rect1.Left) * Progress_index/100)  + rect1.Left;

  //dec(rect1.Right,30);

  DrawGradient(canva,rect1, false, [$00D3A0AC,$00B35A6E ]);// $00B35A6E]);

  //SetBkMode(canva.Handle,TRANSPARENT);
  canva.font.Color:=clwhite;
  canva.Brush.Style:=bsClear;

  DrawText(Canva.Handle, PChar(Text), Length(Text), Rect1, DT_LEFT or DT_EXPANDTABS );


  //try
  PaintBox1.Canvas.Draw(0,0,bit1);
}
procedure TGauge.PaintAsPie(AnImage: TBitmap; PaintRect: TRect);
var
  MiddleX, MiddleY: integer;
  Angle: double;
  W, H: integer;
begin
  W := PaintRect.Right - PaintRect.Left;
  H := PaintRect.Bottom - PaintRect.Top;
  if FBorderStyle = bsSingle then
  begin
    inc(W);
    inc(H);
  end;
  with AnImage.Canvas do
  begin
    Brush.Color := Color;
    FillRect(PaintRect);
    Brush.Color := BackColor;
    Pen.Color := ForeColor;
    Pen.Width := 1;
    Ellipse(PaintRect.Left, PaintRect.Top, W, H);
    if PercentDone > 0 then
    begin
      Brush.Color := ForeColor;
      MiddleX := W div 2;
      MiddleY := H div 2;
      Angle := (Pi * ((PercentDone / 50) + 0.5));
      Pie(PaintRect.Left, PaintRect.Top, W, H,
        integer(Round(MiddleX * (1 - Cos(Angle)))),
        integer(Round(MiddleY * (1 - Sin(Angle)))), MiddleX, 0);
    end;
  end;
end;

procedure TGauge.PaintAsNeedle(AnImage: TBitmap; PaintRect: TRect);
var
  MiddleX: integer;
  Angle: double;
  X, Y, W, H: integer;
begin
  with PaintRect do
  begin
    X := Left;
    Y := Top;
    W := Right - Left;
    H := Bottom - Top;
    if FBorderStyle = bsSingle then
    begin
      inc(W);
      inc(H);
    end;
  end;
  with AnImage.Canvas do
  begin
    Brush.Color := Color;
    FillRect(PaintRect);
    Brush.Color := BackColor;
    Pen.Color := ForeColor;
    Pen.Width := 1;
    Pie(X, Y, W, H * 2 - 1, X + W, PaintRect.Bottom - 1, X,
      PaintRect.Bottom - 1);
    MoveTo(X, PaintRect.Bottom);
    LineTo(X + W, PaintRect.Bottom);
    if PercentDone > 0 then
    begin
      Pen.Color := ForeColor;
      MiddleX := Width div 2;
      MoveTo(MiddleX, PaintRect.Bottom - 1);
      Angle := (Pi * ((PercentDone / 100)));
      LineTo(integer(Round(MiddleX * (1 - Cos(Angle)))),
        integer(Round((PaintRect.Bottom - 1) * (1 - Sin(Angle)))));
    end;
  end;
end;

procedure TGauge.SetGaugeKind(Value: TGaugeKind);
begin
  if Value <> FKind then
  begin
    FKind := Value;
    Refresh;
  end;
end;

procedure TGauge.SetShowText(Value: Boolean);
begin
  if Value <> FShowText then
  begin
    FShowText := Value;
    Refresh;
  end;
end;

procedure TGauge.SetBorderStyle(Value: TBorderStyle);
begin
  if Value <> FBorderStyle then
  begin
    FBorderStyle := Value;
    Refresh;
  end;
end;

procedure TGauge.SetForeColor(Value: TColor);
begin
  if Value <> FForeColor then
  begin
    FForeColor := Value;
    Refresh;
  end;
end;

procedure TGauge.SetBackColor(Value: TColor);
begin
  if Value <> FBackColor then
  begin
    FBackColor := Value;
    Refresh;
  end;
end;

procedure TGauge.SetMinValue(Value: Longint);
begin
  if Value <> FMinValue then
  begin
    if Value > FMaxValue then
      if not(csLoading in ComponentState) then
        raise EInvalidOperation.CreateFmt(SOutOfRange,
          [-MaxInt, FMaxValue - 1]);
    FMinValue := Value;
    if FCurValue < Value then
      FCurValue := Value;
    Refresh;
  end;
end;

procedure TGauge.SetMaxValue(Value: Longint);
begin
  if Value <> FMaxValue then
  begin
    if Value < FMinValue then
      if not(csLoading in ComponentState) then
        raise EInvalidOperation.CreateFmt(SOutOfRange, [FMinValue + 1, MaxInt]);
    FMaxValue := Value;
    if FCurValue > Value then
      FCurValue := Value;
    Refresh;
  end;
end;

procedure TGauge.SetProgress(Value: Longint);
var
  TempPercent: Longint;
begin
  TempPercent := GetPercentDone; { remember where we were }
  if Value < FMinValue then
    Value := FMinValue
  else if Value > FMaxValue then
    Value := FMaxValue;
  if FCurValue <> Value then
  begin
    FCurValue := Value;
    if TempPercent <> GetPercentDone then { only refresh if percentage changed }
      Refresh;
  end;
end;

procedure TGauge.AddProgress(Value: Longint);
begin
  Progress := FCurValue + Value;
  Refresh;
end;

end.
