sgauge.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sGauge;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sConst, sGraphUtils, sVclUtils, acntUtils, sCommonData;

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

  TsGauge = class(TGraphicControl)
{$IFNDEF NOTFORHELP}
  private
    FMinValue: Longint;
    FMaxValue: Longint;
    FCurValue: Longint;
    FKind: TsGaugeKind;
    FShowText: Boolean;
    FOnChange : TNotifyEvent;
    FSuffix: string;
    FCommonData: TsCommonData;
    FForeColor: TColor;
    FBorderStyle: TBorderStyle;
    FBackColor: TColor;
    FProgressSkin: TsSkinSection;
    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 SkinPaintAsText(aRect: TRect);
    procedure SkinPaintAsBar(aRect: TRect);
    procedure SkinPaintAsPie(aRect: TRect);
    procedure SkinPaintAsNeedle(aRect: TRect);
    procedure SkinPaintBody(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 WMEraseBkGND (var Message: TWMPaint); message WM_ERASEBKGND;
    procedure SetSuffix(const Value: string);
    procedure SetForeColor(const Value: TColor);
    procedure SetBorderStyle(const Value: TBorderStyle);
    procedure SetBackColor(const Value: TColor);
    procedure SetProgressSkin(const Value: TsSkinSection);
  protected
    procedure WndProc (var Message: TMessage); override;
  public
    procedure Paint; override;

    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 Constraints;
    property Enabled;
    property Font;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property Kind: TsGaugeKind read FKind write SetGaugeKind default gkHorizontalBar;
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
{$ENDIF} // NOTFORHELP
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property BackColor: TColor read FBackColor write SetBackColor default clWhite;
    property ForeColor : TColor read FForeColor write SetForeColor;
    property MinValue: Longint read FMinValue write SetMinValue default 0;
    property MaxValue: Longint read FMaxValue write SetMaxValue default 100;
    property Progress: Longint read FCurValue write SetProgress default 47;
    property ProgressSkin : TsSkinSection read FProgressSkin write SetProgressSkin;
    property ShowText: Boolean read FShowText write SetShowText default True;
    property Suffix : string read FSuffix write SetSuffix;
  end;

implementation

uses Consts, sStyleSimply, sMaskData, sBorders, sSkinProps, sAlphaGraph,
  sMessages, sSKinManager;

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

  FCommonData := TsCommonData.Create(Self, False);
  FCommonData.COC := COC_TsGauge;
  ControlStyle := ControlStyle + [csOpaque];

  FMinValue := 0;
  FMaxValue := 100;
  FCurValue := 47;
  FKind := gkHorizontalBar;
  FShowText := True;
  FBorderStyle := bsSingle;
  FForeColor := clBlack;
  FBackColor := clWhite;
  Width := 120;
  Height := 30;
  FSuffix := '%';
//  ForeAlpha := 50;
//  BevelWidth := 1;
end;

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

procedure TsGauge.Paint;
var
  TheImage: TBitmap;
  OverlayImage: TBitmap;
  PaintRect: TRect;
begin
  if (Width < 1) or (Height < 1) then Exit;
  if FCommonData.Skinned then begin
    if FCommonData.Updating then begin
      SetPixel(Canvas.Handle, 0, 0, clFuchsia);
      Exit
    end;
    FCommonData.InitCacheBmp;
    PaintItem(FCommonData, GetParentCache(FCommonData), True, 0, Rect(0, 0, width, Height), Point(Left, Top), FCommonData.FCacheBMP, False);

    SkinPaintBody(Rect(0, 0, width, Height));
    FCommonData.BGChanged := False;
    UpdateCorners(FCommonData, 0);
    BitBlt(Canvas.Handle, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    FreeAndNil(FCommonData.FCacheBmp);
  end
  else with Canvas do begin
    TheImage := CreateBmp24(Width, Height);
    try
      PaintBackground(TheImage);
      PaintRect := ClientRect;
      if FBorderStyle = bsSingle then InflateRect(PaintRect, -1, -1);
      OverlayImage := CreateBmpLike(TheImage);
      OverlayImage.Canvas.Brush.Color := clWindowFrame;
      OverlayImage.Canvas.Brush.Style := bsSolid;
      OverlayImage.Canvas.FillRect(Rect(0, 0, Width, Height));
      try
        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 TsGauge.SkinPaintAsText(aRect: TRect);
var
  S: string;
begin
  S := Format('%d%', [PercentDone]) + FSuffix;
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  FCommonData.FCacheBmp.Canvas.Pen.Style := psInsideFrame;

  sGraphUtils.WriteTextEx(FCommonData.FCacheBmp.Canvas, PChar(s), Enabled, aRect, GetStringFlags(Self, taCenter) or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE, FCommonData, False)
end;

procedure TsGauge.SkinPaintAsBar(aRect: TRect);
var
  FillSize: Longint;
  W, H: Integer;
  TempBmp : TBitmap;
  index : integer;
  CI : TCacheInfo;
  bRect : TRect;
  pSkinSection : string;
begin
  W := WidthOf(aRect);
  H := HeightOf(aRect);
  TempBmp := CreateBmp24(W, H);
  CI := MakeCacheInfo(FCommonData.FCacheBmp);
  bRect := aRect;

  if ProgressSkin <> '' then pSkinSection := ProgressSkin else case Kind of
    gkHorizontalBar: pSkinSection := s_ProgressH
    else pSkinSection := s_ProgressV;
  end;

  Index := FCommonData.SkinManager.GetSkinIndex(pSkinSection);
  if Kind = gkHorizontalBar then begin
    FillSize := SolveForX(PercentDone, W);
    if FillSize > W then FillSize := W;
    if FillSize > 0 then if FCommonData.SkinManager.IsValidSkinIndex(Index) then begin
      bRect.Right := FillSize;
      W := WidthOf(bRect);
      TempBmp.Width := W;
      PaintItem(Index, pSkinSection, CI, True, 0, Rect(aRect.Left, aRect.Top, FillSize, H), Point(0, 0), TempBmp, FCommonData.SkinManager);
      BitBlt(FCommonData.FCacheBmp.Canvas.Handle, aRect.Left, aRect.Top, W, H, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
    end;
  end
  else begin
    FillSize := SolveForX(PercentDone, H);
    if FillSize >= H then FillSize := H;
    if FillSize > 0 then if FCommonData.SkinManager.IsValidSkinIndex(Index) then begin
      bRect.Top := Height - FillSize;
      H := HeightOf(bRect);
      TempBmp.Height := H;
      PaintItem(Index, pSkinSection, CI, True, 0, Rect(0, 0, W, H), Point(bRect.Left, bRect.Top), TempBmp, FCommonData.SkinManager);
      BitBlt(FCommonData.FCacheBmp.Canvas.Handle, bRect.Left, bRect.Top, W, H, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
    end;
  end;
  FreeAndNil(TempBmp);
end;

procedure TsGauge.SkinPaintAsPie(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.Width := 1;
  TempBmp.Canvas.Ellipse(aRect.Left, aRect.Top, W, H);}

  FCommonData.FCacheBmp.Canvas.Pen.Width := 1;
  FCommonData.FCacheBmp.Canvas.Brush.Style := bsSolid;
  FCommonData.FCacheBmp.Canvas.Pen.Style := psSolid;
  FCommonData.FCacheBmp.Canvas.Pen.Color := ForeColor;
  FCommonData.FCacheBmp.Canvas.Ellipse(aRect.Left, aRect.Top, W, H);
  FCommonData.FCacheBmp.Canvas.Pen.Style := psSolid;
  FCommonData.FCacheBmp.Canvas.Brush.Color := ForeColor;
  if PercentDone > 0 then begin
    MiddleX := W div 2;
    MiddleY := H div 2;
    Angle := (Pi * ((PercentDone / 50) + 0.5));
    FCommonData.FCacheBmp.Canvas.Pie(aRect.Left, aRect.Top, W, H,
      Integer(Round(MiddleX * (1 - Cos(Angle)))),
      Integer(Round(MiddleY * (1 - Sin(Angle)))), MiddleX, 0);
  end;
end;

procedure TsGauge.SkinPaintAsNeedle(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);

  FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
  FCommonData.FCacheBmp.Canvas.Pen.Width := 1;
  FCommonData.FCacheBmp.Canvas.Pie(X, Y, W, H * 2 - 1, X + W, aRect.Bottom - 1, X, aRect.Bottom - 1);
  FCommonData.FCacheBmp.Canvas.MoveTo(X, aRect.Bottom);
  FCommonData.FCacheBmp.Canvas.LineTo(X + W, aRect.Bottom);
  FCommonData.FCacheBmp.Canvas.Pen.Color := ForeColor;
  FCommonData.FCacheBmp.Canvas.Pen.Style := psSolid;
  FCommonData.FCacheBmp.Canvas.Pie(X, Y, W, H * 2 - 1, X + W, aRect.Bottom - 1, X, aRect.Bottom - 1);
  if PercentDone > 0 then begin
    MiddleX := Width div 2;
    FCommonData.FCacheBmp.Canvas.MoveTo(MiddleX, aRect.Bottom - 1);
    Angle := (Pi * ((PercentDone / 100)));
    FCommonData.FCacheBmp.Canvas.LineTo(Integer(Round(MiddleX * (1 - Cos(Angle)))),
      Integer(Round((aRect.Bottom - 1) * (1 - Sin(Angle)))));
  end;