sgauge.pas

AlphaControls是一个Delphi标准控件的集合

unit sGauge;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sStyleUtil, sConst, sGraphUtils, sVclUtils, sUtils;

type
  TsGaugeKind = (gkText, gkHorizontalBar, gkVerticalBar, gkPie, gkNeedle);

  TsGauge = class(TCustomControl)
  private
    FMinValue: Longint;
    FMaxValue: Longint;
    FCurValue: Longint;
    FKind: TsGaugeKind;
    FShowText: Boolean;
    FsStyle : TsPassiveBGStyle;
    FOnChange : TNotifyEvent;
    FForeAlpha: integer;
    FSuffix: string;
    function CreateTempBmp : TBitmap;

    procedure PaintAsText(aRect: TRect);
    procedure PaintAsBar(aRect: TRect);
    procedure PaintSkinBar(Bmp : TBitmap; aRect: TRect; i : integer);
    procedure PaintAsPie(aRect: TRect);
    procedure PaintAsNeedle(aRect: TRect);

    procedure SetGaugeKind(Value: TsGaugeKind);
    procedure SetShowText(Value: Boolean);
    procedure SetMinValue(Value: Longint);
    procedure SetMaxValue(Value: Longint);
    procedure SetProgress(Value: Longint);
    function GetPercentDone: Longint;
    procedure SetForeAlpha(const Value: integer);
    procedure WMEraseBkGND (var Message: TWMPaint); message WM_ERASEBKGND;
    procedure SetSuffix(const Value: string);
  protected
    procedure WndProc (var Message: TMessage); override;
  public
    procedure Paint; override;
    procedure PaintBody(aRect: TRect);

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddProgress(Value: Longint);
    procedure AfterConstruction; override;
    procedure Loaded; override;
    property PercentDone: Longint read GetPercentDone;
    property Color;
  published
    property Align;
    property Anchors;
    property BevelWidth default 1;
    property Constraints;
    property Enabled;
    property Font;
    property ForeAlpha: integer read FForeAlpha write SetForeAlpha default 50;
    property Kind: TsGaugeKind 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 default 47;
    property ShowHint;
    property ShowText: Boolean read FShowText write SetShowText default True;
    property sStyle : TsPassiveBGStyle read FsStyle write FsStyle;
    property Suffix : string read FSuffix write SetSuffix;
    property Visible;
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
  end;

implementation

uses Consts, sStyleSimply, sMaskData, sBorders, sSkinProps;

{ 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;

{ TsGauge }

constructor TsGauge.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  sStyle := TsPassiveBGStyle.Create(Self);
  sStyle.COC := COC_TsGauge;

  ControlStyle := ControlStyle + [csOpaque];

  FMinValue := 0;
  FMaxValue := 100;
  FCurValue := 47;
  FKind := gkHorizontalBar;
  FShowText := True;
  Width := 120;
  Height := 30;
  FSuffix := '%';
  ForeAlpha := 50;
  BevelWidth := 1;
  if (csDesigning in ComponentState) and (sStyle.Background.Gradient.Data = '') then begin
    sStyle.Background.Gradient.Data := '8421504;16777215;99;0;0;16777215;16777215;0;0;0';
  end;
end;

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

procedure TsGauge.Paint;
var
  aRect: TRect;
begin
  if (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit;
  if sStyle.BGChanged then begin
    if (csDestroying in ComponentState) then exit;
    aRect := ClientRect;
    sStyle.FCacheBmp.Height := HeightOf(aRect);
    sStyle.FCacheBmp.Width := WidthOf(aRect);

    sStyle.PaintBG(sStyle.FCacheBMP);
    PaintBody(aRect);
  end;
  sStyle.CopyFromCache(Canvas.Handle, 0, 0, Width, Height);
end;

procedure TsGauge.PaintAsText(aRect: TRect);
var
  S: string;
begin
  S := Format('%d%', [PercentDone]) + FSuffix;
  sStyle.FCacheBmp.Canvas.Font.Assign(Font);
  sStyle.FCacheBmp.Canvas.Pen.Style := psInsideFrame;

  if IsValidSkinIndex(sStyle.SkinIndex) then begin
    sGraphUtils.WriteTextEx(sStyle.FCacheBmp.Canvas, PChar(s), Enabled, aRect, GetStringFlags(Self, taCenter), sStyle.SkinIndex, False);
  end
  else begin
    sGraphUtils.WriteText(sStyle.FCacheBmp.Canvas, PChar(s), Enabled, aRect, GetStringFlags(Self, taCenter));
  end;
end;

procedure TsGauge.PaintAsBar(aRect: TRect);
var
  FillSize: Longint;
  W, H: Integer;
  TempBmp : TBitmap;
  i : integer;
begin
  TempBmp := CreateTempBmp;

  W := WidthOf(aRect);
  H := HeightOf(aRect);

  TempBmp.Canvas.Pen.Width := 1;
  TempBmp.Canvas.Brush.Color := ChangeColor(clBlack, clWhite, FForeAlpha / 100);

  case FKind of
    gkHorizontalBar: begin
      FillSize := SolveForX(PercentDone, W);
      if FillSize > W then FillSize := W;
      if FillSize > 0 then begin
        i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, GaugeHorProgress);
        if IsValidImgIndex(i) then begin
          PaintSkinBar(sStyle.FCacheBmp, Rect(aRect.Left, aRect.Top, FillSize + 1, H + 1), i);
        end
        else begin
          TempBmp.Canvas.FillRect(Rect(aRect.Left, aRect.Top, FillSize + 1, H + 1));
          BlendBmpByMask(sStyle.FCacheBmp, TempBmp, TsColor(sStyle.Painting.Color));
        end;
      end;
    end;
    gkVerticalBar: begin
      FillSize := SolveForX(PercentDone, H);
      if FillSize >= H then FillSize := H - 1;
      TempBmp.Canvas.FillRect(Rect(aRect.Left, H - FillSize, W + 1, H + 1));
      BlendBmpByMask(sStyle.FCacheBmp, TempBmp, TsColor(sStyle.Painting.Color));
    end;
  end;
  FreeAndNil(TempBmp);
end;

procedure TsGauge.PaintAsPie(aRect: TRect);
var
  MiddleX, MiddleY: Integer;
  Angle: Double;
  W, H: Integer;
  TempBmp : TBitmap;
begin
  TempBmp := CreateTempBmp;

  W := WidthOf(aRect);
  H := HeightOf(aRect);

  TempBmp.Canvas.Brush.Style := bsClear;
  TempBmp.Canvas.Pen.Color := ChangeColor(clBlack, clWhite, FForeAlpha / 100);
  TempBmp.Canvas.Pen.Width := 1;
  TempBmp.Canvas.Ellipse(aRect.Left, aRect.Top, W, H);

  if PercentDone > 0 then begin
    TempBmp.Canvas.Brush.Color := ChangeColor(clWhite, clBlack, FForeAlpha / 100);
    MiddleX := W div 2;
    MiddleY := H div 2;
    Angle := (Pi * ((PercentDone / 50) + 0.5));
    TempBmp.Canvas.Pie(aRect.Left, aRect.Top, W, H,
      Integer(Round(MiddleX * (1 - Cos(Angle)))),
      Integer(Round(MiddleY * (1 - Sin(Angle)))), MiddleX, 0);
  end;
  BlendBmpByMask(sStyle.FCacheBmp, TempBmp, TsColor(sStyle.Painting.Color));
//  SumBitmaps(sStyle.FCacheBmp, TempBmp, TsColor(sStyle.Painting.Color));
  FreeAndNil(TempBmp);
end;

procedure TsGauge.PaintAsNeedle(aRect: TRect);
var
  MiddleX: Integer;
  Angle: Double;
  X, Y, W, H: Integer;
  TempBmp : TBitmap;
begin
  TempBmp := CreateTempBmp;

  X := aRect.Left;
  Y := aRect.Top;
  W := WidthOf(aRect);
  H := HeightOf(aRect);

  TempBmp.Canvas.Brush.Style := bsClear;
  TempBmp.Canvas.Pen.Color := ChangeColor(clWhite, clBlack, FForeAlpha / 100);
//  LightingColor(clBlack, 255, FForeAlpha / 100);
  TempBmp.Canvas.Pen.Width := 1;
  TempBmp.Canvas.Pie(X, Y, W, H * 2 - 1, X + W, aRect.Bottom - 1, X, aRect.Bottom - 1);
  TempBmp.Canvas.MoveTo(X, aRect.Bottom);
  TempBmp.Canvas.LineTo(X + W, aRect.Bottom);
  if PercentDone > 0 then begin
    MiddleX := Width div 2;
    TempBmp.Canvas.MoveTo(MiddleX, aRect.Bottom - 1);
    Angle := (Pi * ((PercentDone / 100)));
    TempBmp.Canvas.LineTo(Integer(Round(MiddleX * (1 - Cos(Angle)))),
      Integer(Round((aRect.Bottom - 1) * (1 - Sin(Angle)))));
  end;
  BlendBmpByMask(sStyle.FCacheBmp, TempBmp, TsColor(sStyle.Painting.Color));
//  SumBitmaps(sStyle.FCacheBmp, TempBmp, TsColor(sStyle.Painting.Color));
  FreeAndNil(TempBmp);
end;

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

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

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

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

procedure TsGauge.SetProgress(Value: Longint);
var
  TempPercent: Longint;
begin
  TempPercent := GetPercentDone;
  LimitIt(Value, FMinValue, FMaxValue);
  if FCurValue <> Value then begin
    FCurValue := Value;
    if TempPercent <> GetPercentDone then begin
      if not RestrictDrawing then sStyle.BGChanged := True;
      Refresh;
    end;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

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

destructor TsGauge.Destroy;
begin
  FreeAndNil(FsStyle);
  inherited Destroy;
end;

procedure TsGauge.WndProc(var Message: TMessage);
begin
  if Assigned(FsStyle) then FsStyle.WndProc(Message);
  if Message.Result <> 1 then
    inherited;
end;

procedure TsGauge.PaintBody(aRect: TRect);
var
  b : integer;
begin
  if IsValidImgIndex(sStyle.BorderIndex) then begin
    if sStyle.RegionChanged then begin
      sStyle.FRegion := 0;
      sStyle.FRegion := CreateRectRgn(0,
                              0,
                              Width,
                              Height);
    end;
    PaintRasterBorder(sStyle.FCacheBmp, ma[sStyle.BorderIndex].Bmp, 0, sStyle.FRegion, ma[sStyle.BorderIndex].TransparentColor, True);
    if sStyle.RegionChanged then begin
      SetWindowRgn(Handle, sStyle.FRegion, True);
      sStyle.RegionChanged := False;
    end;
  end
  else begin
    sStyle.PaintBevel(sStyle.FCacheBmp, aRect, BevelWidth, sStyle.ActualBevel, sStyle.SoftControl);
  end;
  b := integer(sStyle.ActualBevel <> cbNone);
  InflateRect(aRect, - b, - b);
  case FKind of
    gkHorizontalBar, gkVerticalBar: PaintAsBar(aRect);
    gkPie: PaintAsPie(aRect);
    gkNeedle: PaintAsNeedle(aRect);
  end;
  if ShowText then PaintAsText(aRect);
  InflateRect(aRect, b, b);
end;

procedure TsGauge.SetForeAlpha(const Value: integer);
begin
  if FForeAlpha <> LimitIt(Value, 0, 100) then begin
    FForeAlpha := LimitIt(Value, 0, 100);
    if not RestrictDrawing then sStyle.BGChanged := True;
    Repaint;
  end;
end;

function TsGauge.CreateTempBmp: TBitmap;
begin
  Result := TBitmap.Create;
  Result.PixelFormat := pf24bit;
  Result.Width := sStyle.FCacheBmp.Width;
  Result.Height := sStyle.FCacheBmp.Height;
end;

procedure TsGauge.WMEraseBkGND(var Message: TWMPaint);
begin
  Message.Result := 1;
end;
{
procedure TsGauge.WMNCPaint(var Message: TMessage);
begin
  Message.Result := 1;
end;

procedure TsGauge.WMPaint(var Message: TMessage);
begin
  Message.Result := 1;
end;
}
procedure TsGauge.SetSuffix(const Value: string);
begin
  if FSuffix <> Value then begin
    FSuffix := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsGauge.AfterConstruction;
begin
  inherited;
  sStyle.Loaded;
end;

procedure TsGauge.Loaded;
begin
  inherited;
  sStyle.Loaded;
end;

procedure TsGauge.PaintSkinBar(Bmp : TBitmap; aRect: TRect; i : integer);
begin
  DrawMaskRect(Bmp, ma[i].Bmp,
               0,
               aRect,
               ma[i].TransparentColor, True, EmptyCI);
end;

end.