I have a list view and draw it with OwnerDraw.
How to draw a simple and smooth progress bar with rounded angles and a line on the top as on a picture below?
I need your help to apply a code below to my needs (my skills don't make it possible to edit).
// 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, POverlay+1, 3));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[2];
FillRect(Rect(1, 3, POverlay+1, 4));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[3];
FillRect(Rect(1, 4, POverlay+1, 5));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[4];
FillRect(Rect(1, 5, POverlay+1, 6));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[5];
FillRect(Rect(1, 6, POverlay+1, 7));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[6];
FillRect(Rect(1, 7, POverlay+1, 8));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[7];
FillRect(Rect(1, 8, POverlay+1, 9));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[8];
FillRect(Rect(1, 9, POverlay+1, 12));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[9];
FillRect(Rect(1, 12, POverlay+1, 13));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[10];
FillRect(Rect(1, 13, POverlay+1, 14));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[11];
FillRect(Rect(1, 14, POverlay+1, 15));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[12];
FillRect(Rect(1, 15, POverlay+1, 16));
Brush.Color := UbuntuProgressColorSets[FColorSet].Progress[13];
FillRect(Rect(1, 16, POverlay+1, 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, 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, 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, 1, DrawWidth-2, 3));
Brush.Color := $00F7F3F7;{-}
FillRect(Rect(1, 3, DrawWidth-2, 5));
Brush.Color := $00EFF3F7;{-}
FillRect(Rect(1, 5, DrawWidth-2, 8));
Brush.Color := $00E7E7EF;{-}
FillRect(Rect(1, 8, DrawWidth-2, 9));
Brush.Color := $00E7EBEF;{-}
FillRect(Rect(1, 9, DrawWidth-2, 12));
Brush.Color := $00EFEFE7;{-}
FillRect(Rect(1, 12, DrawWidth-2, 13));
Brush.Color := $00EFF3F7;{-}
FillRect(Rect(1, 13, DrawWidth-2, 14));
Brush.Color := $00EFEFF7;{-}
FillRect(Rect(1, 14, DrawWidth-2, 16));
Brush.Color := $00F7F7FF;{-}
FillRect(Rect(1, 16, DrawWidth-2, 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, 0, 0, Width, 19, Buffer.Canvas.Handle, 0, 0, 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, ATop, AWidth, 19)
else
inherited SetBounds(ALeft, ATop, AWidth, 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.
Thanks!
NGLN
Could something like this do?
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, R, nil);
InflateRect(R, -2, -2);
R.Right := R.Left + Trunc((R.Right - R.Left) * Progress);
Details := ThemeServices.GetElementDetails(tpChunk);
ThemeServices.DrawElement(DC, Details, R, nil);
end
else
begin
SavePen := SelectObject(DC, CreatePen(PS_NULL, 0, 0));
SaveBrush := SelectObject(DC, CreateSolidBrush($00EBEBEB));
Inc(R.Right);
Inc(R.Bottom);
RoundRect(DC, R.Left, R.Top, R.Right, R.Bottom, 3, 3);
R.Right := R.Left + Trunc((R.Right - R.Left) * Progress);
DeleteObject(SelectObject(DC, CreateSolidBrush($00FFC184)));
RoundRect(DC, R.Left, R.Top, R.Right, R.Bottom, 3, 3);
if R.Right > R.Left + 3 then
Rectangle(DC, R.Right - 3, R.Top, R.Right, 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), -1, 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, R, State, ListView.Font, 'Downloading',
Random(101) / 100);
end;
end;
With thanks to David Heffernan's tip and to Sertac Akyuz's answer.
pixel by pixel ;-)
Commercially, these come close:
- http://www.tmssoftware.com/site/advprogr.asp
- http://devexpress.com/Products/VCL/#ctl00_ctl00_Content_Content_ctl30|2
Use their drawing logic to embed those in your owner drawn listview.
Tristan Marlow
Font will be incorrect for additional sub-items.
Sender.Canvas.Font.OnChange(Sender);
e.g.:
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, R, State, ListView.Font, 'Downloading',
Random(101) / 100);
end;
Sender.Canvas.Font.OnChange(Sender);
end;
来源：https://stackoverflow.com/questions/7044125/delphi-draw-own-progress-bar-in-list-view