任务清单风格的进度条。

Forms/mProgressProFrm.dfm

@@ -0,0 +1,88 @@
+object ProgressProForm: TProgressProForm
+  Left = 1179
+  Top = 324
+  BorderIcons = []
+  BorderStyle = bsNone
+  Caption = #25552#31034
+  ClientHeight = 252
+  ClientWidth = 428
+  Color = clWindow
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #24494#36719#38597#40657
+  Font.Style = []
+  FormStyle = fsStayOnTop
+  OldCreateOrder = False
+  Position = poMainFormCenter
+  PixelsPerInch = 96
+  TextHeight = 17
+  object Shape1: TShape
+    Left = 0
+    Top = 0
+    Width = 428
+    Height = 252
+    Align = alClient
+    Brush.Style = bsClear
+    OnMouseDown = Shape1MouseDown
+  end
+  object Gauge1: TGauge
+    Left = 16
+    Top = 54
+    Width = 393
+    Height = 23
+    BackColor = clWindow
+    Color = clBlack
+    ForeColor = 43690
+    MaxValue = 0
+    ParentColor = False
+    ParentShowHint = False
+    Progress = 0
+    ShowHint = False
+    ShowText = False
+  end
+  object lblTitle: TLabel
+    Left = 16
+    Top = 16
+    Width = 133
+    Height = 25
+    Caption = #27491#22312#29983#25104#25968#25454#21253
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -19
+    Font.Name = #24494#36719#38597#40657
+    Font.Style = []
+    ParentFont = False
+  end
+  object lblPercent: TLabel
+    Left = 336
+    Top = 84
+    Width = 74
+    Height = 30
+    Alignment = taRightJustify
+    AutoSize = False
+    Caption = '100%'
+    Font.Charset = GB2312_CHARSET
+    Font.Color = 43690
+    Font.Height = -35
+    Font.Name = #40657#20307
+    Font.Style = [fsBold]
+    ParentFont = False
+  end
+  object mmTask: TMemo
+    Left = 16
+    Top = 125
+    Width = 393
+    Height = 116
+    TabStop = False
+    BorderStyle = bsNone
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clGray
+    Font.Height = -12
+    Font.Name = #23435#20307
+    Font.Style = []
+    ParentFont = False
+    ReadOnly = True
+    TabOrder = 0
+  end
+end

Forms/mProgressProFrm.pas

@@ -0,0 +1,118 @@
+{*******************************************************************************
+    单元名称： mProgressProFrm.pas
+
+    单元说明： 任务清单效果的进度条。
+
+    作者时间： Chenshilong, 2015-12-07
+*******************************************************************************}
+
+
+unit mProgressProFrm;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Gauges, jpeg;
+
+type
+  TProgressProForm = class(TForm)
+    Shape1: TShape;
+    Gauge1: TGauge;
+    lblTitle: TLabel;
+    lblPercent: TLabel;
+    mmTask: TMemo;
+    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+  TProgressPosType = (pptNo, pptAdd, pptSet);    // 进度不变；增加进度；指定进度；
+  TProgressMemoType = (pmtNo, pmtAdd, pmtEdit);  // 备注信息不变；增加一条备注；修改当前这条备注。
+
+procedure ProgressProCreate(AMaxValue: Integer; ATitle: string = '正在处理请稍候>>>');
+procedure ProgressProFree;
+procedure ProgressProRun(APosType: TProgressPosType; APosValue: Integer;
+                         AMemoType: TProgressMemoType; AMemoValue: string);
+
+var
+  ProgressProForm: TProgressProForm = nil;
+
+const
+  sc_DragMove = $f012;
+
+implementation
+
+uses ScUtils;
+
+{$R *.dfm}
+
+procedure ProgressProCreate(AMaxValue: Integer; ATitle: string);
+begin
+  if ProgressProForm = nil then
+    ProgressProForm := TProgressProForm.Create(nil);
+  ProgressProForm.lblTitle.Caption := ATitle;
+  ProgressProForm.Gauge1.MaxValue := AMaxValue;
+  ProgressProForm.Gauge1.Progress := 0;
+  ProgressProForm.Show;
+  ProgressProForm.Update;
+end;
+
+procedure ProgressProFree;
+begin
+  if ProgressProForm <> nil then
+  begin
+    with ProgressProForm.Gauge1 do
+    begin
+      if (Progress <> MaxValue) then
+      ProgressProRun(pptSet, MaxValue, pmtAdd, '已完成。');
+    end;
+
+    // 关闭前要延迟500ms，有些地方如果不延迟，关得太快，感觉进度条没走完就关了，体验很不好。
+    Sleep(500);
+
+    FreeAndNil(ProgressProForm);
+  end;
+end;
+
+procedure ProgressProRun(APosType: TProgressPosType; APosValue: Integer;
+                         AMemoType: TProgressMemoType; AMemoValue: string);
+begin
+  if ProgressProForm = nil then Exit;
+  with ProgressProForm do
+  begin
+    if APosType = pptAdd then
+      Gauge1.Progress := Gauge1.Progress + APosValue
+    else if APosType = pptSet then
+      Gauge1.Progress := APosValue;
+
+    if Gauge1.Progress > Gauge1.MaxValue then     // 如果算得不对，缩回5格
+      Gauge1.Progress := Gauge1.MaxValue - 2;
+
+    lblPercent.Caption := IntToStr(Gauge1.PercentDone) + '%';
+
+    if (AMemoType <> pmtNo) or (AMemoValue <> '') then
+    begin
+      with mmTask.Lines do
+      begin
+        if (AMemoType = pmtEdit) and (Count > 0) then
+          Delete(Count - 1);
+        Add(AMemoValue);
+      end;
+    end;
+
+    Update;
+  end;
+end;
+
+procedure TProgressProForm.Shape1MouseDown(Sender: TObject;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  ReleaseCapture;
+  (ProgressProForm as TWinControl).PerForm(wm_SysCommand, sc_DragMove, 0);
+end;
+
+end.