Delphi：在列表视图中绘制自己的进度条

我有一个列表视图,并使用OwnerDraw绘制它.

如何绘制一个简单流畅的进度条,圆角,顶部有一条线,如下图所示？

我需要你的帮助才能将下面的代码应用到我的需求中(我的技能无法编辑).

//  TUbuntuProgress
//  Version 1.2

unit UbuntuProgress;

interface

uses
  Windows,SysUtils,Classes,Controls,Graphics,Math,ExtCtrls;

type
  TUbuntuProgressColorSets = (csOriginal,csBlue,csRed);
  TUbuntuProgressMode = (pmNormal,pmMarquee);
  TMarqueeMode = (mmToLeft,mmToRight);
  TMarqueeSpeed = (msSlow,msMedium,msFast);

  TUbuntuProgress = class(TGraphicControl)
  private
    FColorSet: TUbuntuProgressColorSets;
    FProgressDividers: Boolean;
    FBackgroundDividers: Boolean;
    FMarqueeWidth: Longint;
    FMax: Longint;
    FMode: TUbuntuProgressMode;
    FPosition: Longint;
    FShadow: Boolean;
    FSpeed: TMarqueeSpeed;
    FStep: Longint;
    FVisible: Boolean;
    Buffer: TBitmap;
    DrawWidth: Longint;
    MarqueeMode: TMarqueeMode;
    MarqueePosition: Longint;
    Timer: TTimer;
    procedure SetColorSet(newColorSet: TUbuntuProgressColorSets);
    procedure SetProgressDividers(newProgressDividers: Boolean);
    procedure SetBackgroundDividers(newBackgroundDividers: Boolean);
    procedure SetMarqueeWidth(newMarqueeWidth: Longint);
    procedure SetMax(newMax: Longint);
    procedure SetMode(newMode: TUbuntuProgressMode);
    procedure SetPosition(newPosition: Longint);
    procedure SetShadow(newShadow: Boolean);
    procedure SetSpeed(newSpeed: TMarqueeSpeed);
    procedure SetStep(newStep: Longint);
    procedure SetVisible(newVisible: Boolean);
    procedure MarqueeOnTimer(Sender: TObject);
    procedure PaintNormal;
    procedure PaintMarquee;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft,ATop,AWidth,AHeight: Integer); override;
    procedure StepIt;
  published
    property ColorSet: TUbuntuProgressColorSets read FColorSet write SetColorSet;
    property ProgressDividers: Boolean read FProgressDividers write SetProgressDividers;
    property BackgroundDividers: Boolean read FBackgroundDividers write SetBackgroundDividers;
    property MarqueeWidth: Longint read FMarqueeWidth write SetMarqueeWidth;
    property Max: Longint read FMax write SetMax;
    property Mode: TUbuntuProgressMode read FMode write SetMode;
    property Position: Longint read FPosition write SetPosition;
    property Shadow: Boolean read FShadow write SetShadow;
    property Speed: TMarqueeSpeed read FSpeed write SetSpeed;
    property Step: Longint read FStep write SetStep;
    property Height;
    property Visible: Boolean read FVisible write SetVisible;
    property Width;
  end;

procedure Register;

implementation
uses
  UbuntuProgressColors;

{$R UbuntuProgress.dcr}

procedure TUbuntuPRogress.SetColorSet(newColorSet: TUbuntuProgressColorSets);
  begin
    FColorSet := newColorSet;
    Invalidate;
  end;

procedure TUbuntuProgress.SetMarqueeWidth(newMarqueeWidth: Integer);
  var
    OldWidth: Longint;
  begin
    if (newMarqueeWidth < (Width-3)) and (newMarqueeWidth > 0) then
      begin
        OldWidth := FMarqueeWidth;
        FMarqueeWidth := newMarqueeWidth;
        if MarqueeMode = mmToRight then
          MarqueePosition := MarqueePosition - (newMarqueeWidth - OldWidth);
      end;
  end;

procedure TUbuntuProgress.SetProgressDividers(newProgressDividers: Boolean);
  begin
    FProgressDividers := newProgressDividers;
    Invalidate;
  end;

procedure TUbuntuProgress.SetBackgroundDividers(newBackgroundDividers: Boolean);
  begin
    FBackgroundDividers := newBackgroundDividers;
    Invalidate;
  end;

procedure TUbuntuProgress.SetMax(newMax: Integer);
  begin
    if newMax > 0 then
      FMax := newMax;
    if FPosition > FMax then
      FPosition := FMax;
    Invalidate;
  end;

procedure TUbuntuProgress.SetMode(newMode: TUbuntuProgressMode);
  begin
    FMode := newMode;
    if FMode = pmNormal then
      Timer.Enabled := False
    else
      Timer.Enabled := True;
    Invalidate;
  end;

procedure TUbuntuProgress.SetPosition(newPosition: Integer);
  begin
    if (newPosition >= 0) and (newPosition <= FMax) then
      FPosition := newPosition;
    Invalidate;
  end;

procedure TUbuntuProgress.SetShadow(newShadow: Boolean);
  begin
    FShadow := newShadow;
    if FShadow then
      Height := 19
    else
      Height := 18;
    Invalidate;
  end;

procedure TUbuntuProgress.SetSpeed(newSpeed: TMarqueeSpeed);
  begin
    FSpeed := newSpeed;
    case FSpeed of
      msSlow: Timer.Interval := 50;
      msMedium: Timer.Interval := 20;
      msFast: Timer.Interval := 10;
    end;
  end;

procedure TUbuntuProgress.SetStep(newStep: Integer);
  begin
    if (newStep > 0) and (newStep <= (FMax)) then
      FStep := newStep;
  end;

procedure TUbuntuProgress.SetVisible(newVisible: Boolean);
  begin
    FVisible := newVisible;
    if FVisible then
      Invalidate
    else
      Parent.Invalidate;
  end;

procedure TUbuntuProgress.MarqueeOnTimer(Sender: TObject);
  begin
    if not (csDesigning in ComponentState) then
      Invalidate;
  end;

procedure TUbuntuProgress.PaintNormal;
  var
    POverlay: Longint;
    PJoist: Longint;
    PDistance: Extended;
    i,k: Longint;
  begin
    POverlay := Floor((DrawWidth-3)/FMax*FPosition);
    PJoist := Floor((Width-3)/16);
    PDistance := (Width-3)/PJoist;
    with Buffer.Canvas do
      begin
        //3D-Effekt Fortschritt
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[0];
        FillRect(Rect(1,1,POverlay+1,2));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[1];
        FillRect(Rect(1,2,3));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[2];
        FillRect(Rect(1,3,4));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[3];
        FillRect(Rect(1,4,5));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[4];
        FillRect(Rect(1,5,6));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[5];
        FillRect(Rect(1,6,7));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[6];
        FillRect(Rect(1,7,8));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[7];
        FillRect(Rect(1,8,9));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[8];
        FillRect(Rect(1,9,12));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[9];
        FillRect(Rect(1,12,13));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[10];
        FillRect(Rect(1,13,14));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[11];
        FillRect(Rect(1,14,15));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[12];
        FillRect(Rect(1,15,16));
        Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[13];
        FillRect(Rect(1,16,17));
        //Balken Fortschritt
        if FProgressDividers then
          begin
            for i := 1 to PJoist-1 do
              begin
                if Round(PDistance*i)<=POverlay then
                  for k := 0 to 15 do
                      Pixels[Round(PDistance*i),k+1] := UbuntuProgressColorSets[FColorSet].JoistLeft[k];
                if Round(PDistance*i)+1<=POverlay then
                  for k := 0 to 15 do
                      Pixels[Round(PDistance*i)+1,k+1] := UbuntuProgressColorSets[FColorSet].JoistRight[k];
              end;
          end;
      end;
  end;

procedure TUbuntuProgress.PaintMarquee;
...
  end;

procedure TUbuntuProgress.Paint;
  var
    PJoist: Longint;
    PDistance: Extended;
    i: Longint;
  begin
    inherited;
    if Visible or ((not Visible) and (csDesigning in ComponentState)) then
      begin
        if FShadow then
          DrawWidth := Width
        else
          DrawWidth := Width + 1;
        PJoist := Floor((Width-3)/16);
        PDistance := (Width-3)/PJoist;
        Buffer.Width := Width;
        Buffer.Height := Height; //19
        with Buffer.Canvas do
          begin
            Brush.Style := bsSolid;
            Pen.Style := psSolid;
            //Eckpixel
            Pixels[0,0] := $00C6C7CE;{-}
            Pixels[DrawWidth-2,17] := $00C6C7CE;{-}
            Pixels[0,17] := $00C6C7CE;{-}
            //Ьbergang
            Pixels[1,0] := $00737584;{-}
            Pixels[DrawWidth-3,0] := $00737584;{-}
            Pixels[DrawWidth-2,1] := $00737584;{-}
            Pixels[DrawWidth-2,16] := $00737584;{-}
            Pixels[DrawWidth-3,17] := $00737584;{-}
            Pixels[1,17] := $00737584;{-}
            Pixels[0,16] := $00737584;{-}
            Pixels[0,1] := $00737584;{-}
            //Seitenlinien
            Pen.Color := $00636973;{-}
            MoveTo(2,0);
            LineTo(DrawWidth-3,0);
            MoveTo(DrawWidth-2,2);
            LineTo(DrawWidth-2,16);
            MoveTo(DrawWidth-4,17);
            LineTo(1,17);
            MoveTo(0,15);
            LineTo(0,1);
            //Schatten
            if FShadow then
              begin
                Pixels[0,18] := $00E7EBEF;{-}
                Pixels[1,18] := $00DEE3E7;{-}
                Pixels[DrawWidth-3,18] := $00DEE3E7;{-}
                Pixels[DrawWidth-2,18] := $00E7EBEF;{-}
                Pixels[DrawWidth-1,17] := $00E7EBEF;{-}
                Pixels[DrawWidth-1,16] := $00DEE3E7;{-}
                Pixels[DrawWidth-1,1] := $00DEE3E7;{-}
                Pixels[DrawWidth-1,0] := $00E7EBEF;{-}
                Pen.Color := $00D6D7DE;{-}
                MoveTo(2,18);
                LineTo(DrawWidth-3,18);
                MoveTo(DrawWidth-1,15);
                LineTo(DrawWidth-1,1);
              end;
            //3D-Effekt Innen
            Brush.Color := $00F7F7F7;{-}
            FillRect(Rect(1,DrawWidth-2,3));
            Brush.Color := $00F7F3F7;{-}
            FillRect(Rect(1,5));
            Brush.Color := $00EFF3F7;{-}
            FillRect(Rect(1,8));
            Brush.Color := $00E7E7EF;{-}
            FillRect(Rect(1,9));
            Brush.Color := $00E7EBEF;{-}
            FillRect(Rect(1,12));
            Brush.Color := $00EFEFE7;{-}
            FillRect(Rect(1,13));
            Brush.Color := $00EFF3F7;{-}
            FillRect(Rect(1,14));
            Brush.Color := $00EFEFF7;{-}
            FillRect(Rect(1,16));
            Brush.Color := $00F7F7FF;{-}
            FillRect(Rect(1,17));
            //Balken Innen
            for i := 1 to PJoist-1 do
              if FBackgroundDividers then
                begin
                  Pen.Color := $00DEDBDE;{-}
                  MoveTo(Round(PDistance*i),1);
                  LineTo(Round(PDistance*i),17);
                  Pen.Color := $00D8D5E0;{-}
                  MoveTo(Round(PDistance*i),8);
                  LineTo(Round(PDistance*i),13);
                  Pen.Color := $00FCF5FC;{-}
                  MoveTo(Round(PDistance*i)+1,1);
                  LineTo(Round(PDistance*i)+1,17);
                  Pen.Color := $00EDEDF5;{-}
                  MoveTo(Round(PDistance*i)+1,8);
                  LineTo(Round(PDistance*i)+1,13);
                end;
          end;
        case FMode of
          pmNormal: PaintNormal;
          pmMarquee:
            begin
              if not (csDesigning in ComponentState) then
                PaintMarquee;
              end;
        end;
        BitBlt(Canvas.Handle,Width,19,Buffer.Canvas.Handle,SRCCOPY);
      end;
  end;

procedure TUbuntuProgress.SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer);
  begin
    if AWidth < 100 then
      AWidth := 100;
    if FShadow then
      inherited SetBounds(ALeft,19)
    else
      inherited SetBounds(ALeft,18);
  end;

procedure TUbuntuProgress.StepIt;
  begin
    if FMode = pmNormal then
      begin
        FPosition := FPosition+FStep;
        if FPosition > FMax then
          FPosition := 0;
        Invalidate;
      end;
  end;

constructor TUbuntuProgress.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    ControlStyle := ControlStyle + [csFixedHeight,csOpaque];
    Buffer := TBitmap.Create;
    Timer := TTimer.Create(Self);
    Timer.Enabled := False;
    Timer.Interval := 20;
    Timer.OnTimer := MarqueeOnTimer;
    FColorSet := csOriginal;
    FProgressDividers := True;
    FBackgroundDividers := True;
    FMarqueeWidth := 30;
    FMax := 100;
    FMode := pmNormal;
    FPosition := 50;
    FShadow := True;
    FSpeed := msMedium;
    FStep := 1;
    MarqueeMode := mmToRight;
    MarqueePosition := 0;
    Height := 19;
    Width := 150;
    Visible := True;
  end;

destructor TUbuntuProgress.Destroy;
  begin
    Timer.Free;
    Buffer.Free;
    inherited;
  end;

procedure Register;
begin
  RegisterComponents('Ubuntu',[TUbuntuProgress]);
end;

end.

谢谢！

解决方法

可以这样的吗？

uses
  CommCtrl,Themes;

const
  StatusColumnIndex = 2;

procedure DrawStatus(DC: HDC; R: TRect; State: TCustomDrawState; Font: TFont;
  const Txt: String; Progress: Single);
var
  TxtRect: TRect;
  S: String;
  Details: TThemedElementDetails;
  SaveBrush: HBRUSH;
  SavePen: HPEN;
  TxtFont: TFont;
  SaveFont: HFONT;
  SaveTextColor: COLORREF;
begin
  FillRect(DC,R,0);
  InflateRect(R,-1,-1);
  TxtRect := R;
  S := Format('%s %.1f%%',[Txt,Progress * 100]);
  if ThemeServices.ThemesEnabled then
  begin
    Details := ThemeServices.GetElementDetails(tpBar);
    ThemeServices.DrawElement(DC,Details,nil);
    InflateRect(R,-2,-2);
    R.Right := R.Left + Trunc((R.Right - R.Left) * Progress);
    Details := ThemeServices.GetElementDetails(tpChunk);
    ThemeServices.DrawElement(DC,nil);
  end
  else
  begin
    SavePen := SelectObject(DC,CreatePen(PS_NULL,0));
    SaveBrush := SelectObject(DC,CreateSolidBrush($00EBEBEB));
    Inc(R.Right);
    Inc(R.Bottom);
    RoundRect(DC,R.Left,R.Top,R.Right,R.Bottom,3);
    R.Right := R.Left + Trunc((R.Right - R.Left) * Progress);
    DeleteObject(SelectObject(DC,CreateSolidBrush($00FFC184)));
    RoundRect(DC,3);
    if R.Right > R.Left + 3 then
      Rectangle(DC,R.Right - 3,R.Bottom);
    DeleteObject(SelectObject(DC,SaveBrush));
    DeleteObject(SelectObject(DC,SavePen));
  end;
  TxtFont := TFont.Create;
  try
    TxtFont.Assign(Font);
    TxtFont.Height := TxtRect.Bottom - TxtRect.Top;
    TxtFont.Color := clGrayText;
    SetBkMode(DC,TRANSPARENT);
    SaveFont := SelectObject(DC,TxtFont.Handle);
    SaveTextColor := SetTextColor(DC,GetSysColor(COLOR_GRAYTEXT));
    DrawText(DC,PChar(S),TxtRect,DT_SINGLELINE or DT_CENTER or
      DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
    SetBkMode(DC,TRANSPARENT);
  finally
    DeleteObject(SelectObject(DC,SaveFont));
    SetTextColor(DC,SaveTextColor);
    TxtFont.Free;
  end;
end;

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
var
  ListView: TListView absolute Sender;
  R: TRect;
begin
  DefaultDraw := SubItem <> StatusColumnIndex;
  if not DefaultDraw then
  begin
    ListView_GetSubItemRect(ListView.Handle,Item.Index,SubItem,LVIR_BOUNDS,@R);
    DrawStatus(ListView.Canvas.Handle,State,ListView.Font,'Downloading',Random(101) / 100);
  end;
end;

感谢David Heffernan’s tip和Sertac Akyuz’s answer.

原文链接：https://www.f2er.com/delphi/102067.html

Delphi：在列表视图中绘制自己的进度条

解决方法

猜你在找的Delphi相关文章