Стартовый пул
This commit is contained in:
215
TaskedProgressBar/data/TaskedProgressBar.pas
Normal file
215
TaskedProgressBar/data/TaskedProgressBar.pas
Normal file
@@ -0,0 +1,215 @@
|
||||
unit TaskedProgressBar;
|
||||
{$mode delphi}
|
||||
{$codepage UTF8}
|
||||
interface
|
||||
uses LCLIntf, LCLType, LMessages, windows, Messages, Classes, ComCtrls, shlobj,
|
||||
comobj, Controls, sysutils;
|
||||
type TTaskProgressState = (tpsNoProgress, tpsIndeterminate, tpsNormal, tpsError, tpsPaused);
|
||||
type
|
||||
TTaskProgressBar = class(TComponent)
|
||||
private
|
||||
fTaskBarList : ITaskBarList3;
|
||||
fProgressBar: TProgressBar;
|
||||
fAlign: TAlign;
|
||||
fBorderSpacing: TControlBorderSpacing;
|
||||
fState: TTaskProgressState;
|
||||
fWidth, fHeight, fLeft, fTop, fProgress, fProgressMax, fStepDef: Integer;
|
||||
fBarShowText, fSmooth: Boolean;
|
||||
fHandle: HWND;
|
||||
procedure SetAlign (ANewAlign: TAlign);
|
||||
procedure SetBarShowText (ANewValue: boolean);
|
||||
procedure SetBorderSpacing (ANewSpacing: TControlBorderSpacing);
|
||||
procedure SetHeight (ANewHeight: Integer);
|
||||
procedure SetLeft (ANewLeft: Integer);
|
||||
procedure SetProgress (ANewValue: Integer);
|
||||
procedure SetProgressMax (ANewValue: Integer);
|
||||
procedure SetSmooth (ANewSmooth: Boolean);
|
||||
procedure SetState (ANewState: TTaskProgressState);
|
||||
procedure SetStep (ANewStep: Integer);
|
||||
procedure SetTop (ANewTop: Integer);
|
||||
procedure SetWidth (ANewWidth: Integer);
|
||||
public
|
||||
constructor Create (AOwner: TComponent);
|
||||
destructor Destroy;
|
||||
procedure StepBy (const ADelta: Integer);
|
||||
procedure StepIt;
|
||||
property Align: TAlign read fAlign write SetAlign;
|
||||
property BarShowText: Boolean read fBarShowText write SetBarShowText;
|
||||
property BorderSpacing: TControlBorderSpacing read fBorderSpacing write SetBorderSpacing;
|
||||
property Handle: HWND read fHandle write fHandle;
|
||||
property Height: Integer read fHeight write SetHeight;
|
||||
property Left: Integer read fLeft write SetLeft;
|
||||
property Progress: Integer read fProgress write SetProgress;
|
||||
property ProgressMax: Integer read fProgressMax write SetProgressMax;
|
||||
property Smooth: Boolean read fSmooth write SetSmooth;
|
||||
property State: TTaskProgressState read fState write SetState;
|
||||
property Step: Integer read fStepDef write SetStep;
|
||||
property Top: Integer read fTop write SetTop;
|
||||
property Width: Integer read fWidth write SetWidth;
|
||||
end;
|
||||
procedure Register;
|
||||
const IID_ITaskbarList3: TGUID = '{ea1afb91-9e28-4b86-90e9-9e9f8a5eefaf}';
|
||||
implementation
|
||||
constructor TTaskProgressBar.Create (AOwner: TComponent);
|
||||
var tbList: ITaskbarList;
|
||||
hr: HRESULT;
|
||||
begin
|
||||
inherited Create (AOwner);
|
||||
tbList:= CreateComObject(CLSID_TaskBarList) as ITaskBarList;
|
||||
hr:= tbList.QueryInterface(IID_ITaskBarList3, fTaskBarList);
|
||||
if hr <> S_OK then
|
||||
begin
|
||||
fTaskBarList:= nil;
|
||||
tbList._Release;
|
||||
raise Exception.Create('Error creation IID_ITaskBarList3 interface!');
|
||||
end;
|
||||
fHandle:= 0;
|
||||
fState:= tpsNoProgress;
|
||||
fProgressMax:= 100;
|
||||
fProgress:= 0;
|
||||
fWidth:= 100;
|
||||
fHeight:= 20;
|
||||
fLeft:= 10;
|
||||
fTop:= 10;
|
||||
fAlign:= alNone;
|
||||
with fBorderSpacing do
|
||||
begin
|
||||
Around:= 0;
|
||||
Bottom:= 0;
|
||||
CellAlignHorizontal:= ccaFill;
|
||||
CellAlignVertical:= ccaFill;
|
||||
InnerBorder:= 0;
|
||||
Left:= 0;
|
||||
Right:= 0;
|
||||
Top:= 0;
|
||||
end;
|
||||
fProgressBar:= TProgressBar.Create(AOwner);
|
||||
with fProgressBar do
|
||||
begin
|
||||
Align:= fAlign;
|
||||
Max:= fProgressMax;
|
||||
Min:= 0;
|
||||
Style:= pbstNormal;
|
||||
Position:= 0;
|
||||
Width:= fWidth;
|
||||
Height:= fHeight;
|
||||
Left:= fLeft;
|
||||
Top:= fTop;
|
||||
BorderSpacing:= fBorderSpacing;
|
||||
BarShowText:= fBarShowText;
|
||||
Smooth:= fSmooth;
|
||||
Step:= fStepDef;
|
||||
end;
|
||||
end;
|
||||
destructor TTaskProgressBar.Destroy;
|
||||
begin
|
||||
fTaskBarList:= nil;
|
||||
fProgressBar.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
{Align}
|
||||
procedure TTaskProgressBar.SetAlign (ANewAlign: TAlign);
|
||||
begin
|
||||
fAlign:= ANewAlign;
|
||||
fProgressBar.Align:= fAlign;
|
||||
end;
|
||||
{BarShowText}
|
||||
procedure TTaskProgressBar.SetBarShowText (ANewValue: boolean);
|
||||
begin
|
||||
fBarShowText:= ANewValue;
|
||||
fProgressBar.BarShowText:= fBarShowText;
|
||||
end;
|
||||
{BorderSpacing}
|
||||
procedure TTaskProgressBar.SetBorderSpacing (ANewSpacing: TControlBorderSpacing);
|
||||
begin
|
||||
fBorderSpacing:= ANewSpacing;
|
||||
fProgressBar.BorderSpacing:= fBorderSpacing;
|
||||
end;
|
||||
{Height}
|
||||
procedure TTaskProgressBar.SetHeight (ANewHeight: Integer);
|
||||
begin
|
||||
fHeight:= ANewHeight;
|
||||
fProgressBar.Height:= fHeight;
|
||||
end;
|
||||
{Left}
|
||||
procedure TTaskProgressBar.SetLeft (ANewLeft: Integer);
|
||||
begin
|
||||
fLeft:= ANewLeft;
|
||||
fProgressBar.Left:= fLeft;
|
||||
end;
|
||||
{Progress}
|
||||
procedure TTaskProgressBar.SetProgress(ANewValue: Integer);
|
||||
begin
|
||||
fProgress:= ANewValue;
|
||||
if Assigned(fTaskBarList) then
|
||||
fTaskBarList.SetProgressValue(fHandle, fProgress, fProgressMax);
|
||||
fProgressBar.Position:= fProgress;
|
||||
end;
|
||||
{ProgressMax}
|
||||
procedure TTaskProgressBar.SetProgressMax(ANewValue: Integer);
|
||||
begin
|
||||
fProgressMax:= ANewValue;
|
||||
fProgressBar.Max:= fProgressMax;
|
||||
end;
|
||||
{Smooth}
|
||||
procedure TTaskProgressBar.SetSmooth (ANewSmooth: Boolean);
|
||||
begin
|
||||
fSmooth:= ANewSmooth;
|
||||
fProgressBar.Smooth:= fSmooth;
|
||||
end;
|
||||
{State}
|
||||
procedure TTaskProgressBar.SetState(ANewState: TTaskProgressState);
|
||||
function TTPStoTBPF (AValue: TTaskProgressState): TBPFLAG;
|
||||
begin
|
||||
Result:= TBPF_NOPROGRESS;
|
||||
case AValue of
|
||||
tpsNoProgress: Result:= TBPF_NOPROGRESS;
|
||||
tpsIndeterminate: Result:= TBPF_INDETERMINATE;
|
||||
tpsNormal: Result:= TBPF_NORMAL;
|
||||
tpsError: Result:= TBPF_ERROR;
|
||||
tpsPaused: Result:= TBPF_PAUSED;
|
||||
end;
|
||||
end;
|
||||
begin
|
||||
fState:= ANewState;
|
||||
if Assigned(fTaskBarList) then
|
||||
fTaskBarList.SetProgressState(fHandle, TTPStoTBPF(ANewState));
|
||||
if ANewState = tpsIndeterminate then
|
||||
fProgressBar.Style:= pbstMarquee
|
||||
else
|
||||
fProgressBar.Style:= pbstNormal;
|
||||
end;
|
||||
{Step}
|
||||
procedure TTaskProgressBar.SetStep (ANewStep: Integer);
|
||||
begin
|
||||
fStepDef:= ANewStep;
|
||||
fProgressBar.Step:= fStepDef;
|
||||
end;
|
||||
{Top}
|
||||
procedure TTaskProgressBar.SetTop (ANewTop: Integer);
|
||||
begin
|
||||
fTop:= ANewTop;
|
||||
fProgressBar.Top:= fTop;
|
||||
end;
|
||||
{Width}
|
||||
procedure TTaskProgressBar.SetWidth (ANewWidth: Integer);
|
||||
begin
|
||||
fWidth:= ANewWidth;
|
||||
fProgressBar.Width:= fWidth;
|
||||
end;
|
||||
{proc: StepBy}
|
||||
procedure TTaskProgressBar.StepBy (const ADelta: Integer);
|
||||
begin
|
||||
fProgress:= fProgress + ADelta;
|
||||
Progress:= fProgress;
|
||||
end;
|
||||
{proc: StepIt}
|
||||
procedure TTaskProgressBar.StepIt;
|
||||
begin
|
||||
StepBy(fStepDef);
|
||||
end;
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('ANB Soft Team', [TTaskProgressBar]);
|
||||
end;
|
||||
end.
|
||||
46
TaskedProgressBar/taskedpb.lpk
Normal file
46
TaskedProgressBar/taskedpb.lpk
Normal file
@@ -0,0 +1,46 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="taskedpb"/>
|
||||
<Author Value="Александр Бабаев"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="data"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Description Value="ProgressBar с отображением прогресса на панели задач Windows 7+"/>
|
||||
<License Value="КАК ЕСТЬ"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="data\TaskedProgressBar.pas"/>
|
||||
<UnitName Value="TaskedProgressBar"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item2>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
20
TaskedProgressBar/taskedpb.pas
Normal file
20
TaskedProgressBar/taskedpb.pas
Normal file
@@ -0,0 +1,20 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit taskedpb;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
TaskedProgressBar, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('taskedpb', @Register);
|
||||
end.
|
||||
Reference in New Issue
Block a user