acprogressbar.pas

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

unit acProgressBar;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, sCommonData, sConst;

type
  TsProgressBar = class(TProgressBar)
{$IFNDEF NOTFORHELP}
  private
    FCommonData: TsCommonData;
    FProgressSkin: TsSkinSection;
    procedure PrepareCache;
    function ProgressRect : TRect;
    function ItemSize : TSize;
    function ClRect : TRect;
    procedure SetProgressSkin(const Value: TsSkinSection);
  public
    procedure Paint(DC : hdc);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure WndProc (var Message: TMessage); override;
  published
{$ENDIF}
    property ProgressSkin : TsSkinSection read FProgressSkin write SetProgressSkin;
    property SkinData : TsCommonData read FCommonData write FCommonData;
  end;

implementation

uses sMessages, sVclUtils, sGraphUtils, acntUtils, sAlphaGraph, sSkinProps;

const
  iNdent = 2;

{ TsProgressBar }

procedure TsProgressBar.AfterConstruction;
begin
  inherited;
  FCommonData.Loaded;
end;

function TsProgressBar.ClRect: TRect;
begin
  Result := ClientRect;
//  InflateRect(Result, - BorderWidth, - BorderWidth);
  OffsetRect(Result, 1, 1);
end;

constructor TsProgressBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

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

destructor TsProgressBar.Destroy;
begin
  FreeAndNil(FCommonData);
  inherited Destroy;
end;

function TsProgressBar.ItemSize: TSize;
const
  prop = 0.66;
begin
  if Orientation = pbVertical then begin
    Result.cx := WidthOf(clRect);
    if Smooth
      then Result.cy := ProgressRect.Bottom - 1 - BorderWidth
      else Result.cy := Round(Result.cx * prop) - iNdent;
  end
  else begin
    Result.cy := HeightOf(clRect);
    if Smooth
      then Result.cx := ProgressRect.Right - 1 - BorderWidth
      else Result.cx := Round(Result.cy * prop) - iNdent;
  end;
end;

procedure TsProgressBar.Loaded;
begin
  inherited;
  FCommonData.Loaded;
end;

procedure TsProgressBar.Paint;
var
  NewDC, SavedDC : hdc;
  PS : TPaintStruct;
begin
  if (Width < 1) or (Height < 1) then Exit;
  BeginPaint(Handle, PS);
  if DC = 0 then NewDC := GetWindowDC(Handle) else NewDC := DC;
  SavedDC := SaveDC(NewDC);
  try
    FCommonData.Updating := FCommonData.Updating;
    if not FCommonData.Updating then begin
      FCommonData.BGChanged := FCommonData.BGChanged or FCommonData.HalfVisible or GetBoolMsg(Parent, AC_GETHALFVISIBLE);
      FCommonData.HalfVisible := not RectInRect(Parent.ClientRect, BoundsRect);

      if (FCommonData.BGChanged) and (not FCommonData.UrgentPainting) then PrepareCache;
      UpdateCorners(FCommonData, 0);
      BitBlt(NewDC, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    end;
  finally
    RestoreDC(NewDC, SavedDC);
    if DC = 0 then ReleaseDC(Handle, NewDC);
    EndPaint(Handle, PS);
  end;
end;

procedure TsProgressBar.PrepareCache;
var
  si, i, d, c, value, w, h : integer;
  s : string;
  ci : TCacheInfo;
  Bmp : TBitmap;
  prRect : TRect;
  iSize : TSize;
begin
  if Max <= Min then Exit;
  FCommonData.InitCacheBmp;
  PaintItem(FCommonData, GetParentCache(FCommonData), True, 0, Rect(0, 0, width, Height), Point(Left, Top), FCommonData.FCacheBMP, False);

  if (ProgressSkin <> '') then s := ProgressSkin else begin
    if Orientation = pbVertical then s := s_ProgressV else s := s_ProgressH;
  end;
  si := FCommonData.SkinManager.GetSkinIndex(s);
  ci := MakeCacheInfo(FCommonData.FCacheBmp);
  prRect := ProgressRect;
  if (prRect.Right <= prRect.Left) or (prRect.Bottom <= prRect.Top) then Exit;

  iSize := ItemSize;
  if (iSize.cx < 2) or (iSize.cy < 2) then Exit;
  Bmp := CreateBmp24(iSize.cx, iSize.cy);

  if Orientation = pbHorizontal then begin
    if Smooth then begin
      Bmp.Width := WidthOf(prRect);
      PaintItem(si, s, ci, True, 0, Rect(0, 0, Bmp.Width, Bmp.Height), Point(prRect.Left, prRect.Top), BMP, FCommonData.SkinManager);
      BitBlt(FCommonData.FCacheBmp.Canvas.Handle, prRect.Left, prRect.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    end
    else begin
      w := WidthOf(clRect) - iNdent;
      c := w div (iSize.cx + iNdent);
      if c > 1 then begin
        d := (w - c * iSize.cx) div (c - 1);
        value := Round(c / Max * Position);
        for i := 0 to value - 1 do begin
          PaintItem(si, s, ci, True, 0, Rect(0, 0, Bmp.Width, Bmp.Height), Point(prRect.Left + i * (iSize.cx + d), prRect.Top), BMP, FCommonData.SkinManager);
          BitBlt(FCommonData.FCacheBmp.Canvas.Handle, prRect.Left + i * (iSize.cx + d), prRect.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
        end;
        if (Value > 0) and (Position = Max) and (w - (Value - 1) * (iSize.cx + d) - iSize.cx > 3) then begin
          Bmp.Width := w - (Value - 1) * (iSize.cx + d) - iSize.cx;
          PaintItem(si, s, ci, True, 0, Rect(0, 0, Bmp.Width, Bmp.Height), Point(prRect.Left + Value * (iSize.cx + d), prRect.Top), BMP, FCommonData.SkinManager);
          BitBlt(FCommonData.FCacheBmp.Canvas.Handle, prRect.Left + (Value * (iSize.cx + d)), prRect.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
        end;
      end;
    end;
  end
  else begin
    if Smooth then begin
      Bmp.Height := HeightOf(prRect);
      PaintItem(si, s, ci, True, 0, Rect(0, 0, Bmp.Width, Bmp.Height), Point(prRect.Left, prRect.Top), BMP, FCommonData.SkinManager);
      BitBlt(FCommonData.FCacheBmp.Canvas.Handle, prRect.Left, prRect.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    end
    else begin
      h := HeightOf(clRect) - iNdent;
      c := h div (iSize.cy + iNdent);
      if c > 1 then begin
        d := (h - c * iSize.cy) div (c - 1);
        value := Round(c / Max * Position);
        for i := 0 to value - 1 do begin
          PaintItem(si, s, ci, True, 0, Rect(0, 0, Bmp.Width, Bmp.Height), Point(prRect.Left, prRect.Bottom - i * (iSize.cy + d) - iSize.cy), BMP, FCommonData.SkinManager);
          BitBlt(FCommonData.FCacheBmp.Canvas.Handle, prRect.Left, prRect.Bottom - i * (iSize.cy + d) - iSize.cy, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
        end;
        if (Value > 0) and (Position = Max) and (h - (Value - 1) * (iSize.cy + d) - iSize.cy > 3) then begin
          Bmp.Height := HeightOf(clRect) - Value * (iSize.cy + d);
          PaintItem(si, s, ci, True, 0, Rect(0, 0, Bmp.Width, Bmp.Height), Point(prRect.Left, prRect.Top), BMP, FCommonData.SkinManager);
          BitBlt(FCommonData.FCacheBmp.Canvas.Handle, prRect.Left, prRect.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
        end;
      end;
    end;
  end;

  FreeAndNil(Bmp);
end;

function TsProgressBar.ProgressRect: TRect;
begin
  if Orientation = pbVertical then begin
    Result.Left := 1 + BorderWidth;
    Result.Right := Width - Result.Left;
    Result.Bottom := Height - Result.Left;
    Result.Top := Result.Bottom - Round(((Height - 2 * Result.Left) / (Max - Min)) * (Position));
    if Position = Max
      then Result.Top := Result.Left
      else Result.Top := Result.Bottom - Round(((Height - 2 * Result.Left) / (Max - Min)) * (Position));
  end
  else begin
    Result.Left := 1 + BorderWidth;
    Result.Bottom := Height - Result.Left;
    Result.Top := Result.Left;
    if Position = Max
      then Result.Right := Width - Result.Left
      else Result.Right := Round(((Width - 2 * Result.Left) / (Max - Min)) * (Position));
  end;
end;

procedure TsProgressBar.SetProgressSkin(const Value: TsSkinSection);
begin
  if FProgressSkin <> Value then begin
    FProgressSkin := Value;
    FCommonData.Invalidate;
  end;
end;

procedure TsProgressBar.WndProc(var Message: TMessage);
begin
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      CommonWndProc(Message, FCommonData);
      Repaint;
      Exit
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      Repaint;
      Exit
    end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then
      begin CommonWndProc(Message, FCommonData);
      exit
    end;
    AC_ENDPARENTUPDATE : if FCommonData.Updating then begin
      FCommonData.Updating := False;
      Repaint; Exit
    end;
  end;
  if not ControlIsReady(Self) or not Assigned(FCommonData) or not FCommonData.Skinned then inherited else begin
    case Message.Msg of
      WM_PRINT : begin
        SkinData.Updating := False;
        Paint(TWMPaint(Message).DC);
        Exit;
      end;
      WM_PAINT : if FCommonData.Skinned then begin
        Paint(TWMPaint(Message).DC);
        Exit;
      end;
      WM_NCPAINT : begin
//        PaintBorder(0);
        Exit;
      end;
      WM_ERASEBKGND : begin
//        Paint(TWMPaint(Message).DC);
        Exit;
      end;
    end;
    CommonWndProc(Message, FCommonData);
    inherited;
  end;
end;

end.