You've already forked lazarus-ccr
jvcllaz: Add JvSpecialProgress
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6294 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
1
components/jvcllaz/design/JvMM/images/images.txt
Normal file
1
components/jvcllaz/design/JvMM/images/images.txt
Normal file
@ -0,0 +1 @@
|
||||
tjvspecialprogress.bmp
|
||||
1
components/jvcllaz/design/JvMM/images/make_res.bat
Normal file
1
components/jvcllaz/design/JvMM/images/make_res.bat
Normal file
@ -0,0 +1 @@
|
||||
lazres ../../../resource/jvmmreg.res @images.txt
|
||||
BIN
components/jvcllaz/design/JvMM/images/tjvspecialprogress.bmp
Normal file
BIN
components/jvcllaz/design/JvMM/images/tjvspecialprogress.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
29
components/jvcllaz/design/JvMM/jvmmreg.pas
Normal file
29
components/jvcllaz/design/JvMM/jvmmreg.pas
Normal file
@ -0,0 +1,29 @@
|
||||
unit JvMMReg;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$R ../../resource/jvmmreg.res}
|
||||
|
||||
uses
|
||||
Classes, JvDsgnConsts,
|
||||
PropEdits, Controls,
|
||||
JvSpecialProgress;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents(RsPaletteJvcl, [
|
||||
TJvSpecialProgress
|
||||
]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
192
components/jvcllaz/examples/JvSpecialProgress/main.lfm
Normal file
192
components/jvcllaz/examples/JvSpecialProgress/main.lfm
Normal file
@ -0,0 +1,192 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 258
|
||||
Height = 340
|
||||
Top = 127
|
||||
Width = 459
|
||||
Caption = 'JvSpecialProgress Demo'
|
||||
ClientHeight = 340
|
||||
ClientWidth = 459
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '1.9.0.0'
|
||||
object Bevel1: TBevel
|
||||
Left = 20
|
||||
Height = 44
|
||||
Top = 12
|
||||
Width = 176
|
||||
end
|
||||
object JvSpecialProgress1: TJvSpecialProgress
|
||||
Left = 32
|
||||
Height = 15
|
||||
Top = 24
|
||||
Width = 150
|
||||
Caption = 'JvSpecialProgress1'
|
||||
Position = 50
|
||||
end
|
||||
object ScrollBar1: TScrollBar
|
||||
Left = 31
|
||||
Height = 17
|
||||
Top = 88
|
||||
Width = 150
|
||||
PageSize = 0
|
||||
TabOrder = 0
|
||||
OnChange = ScrollBar1Change
|
||||
end
|
||||
object CbStartColor: TColorBox
|
||||
Left = 328
|
||||
Height = 22
|
||||
Top = 22
|
||||
Width = 100
|
||||
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbPrettyNames]
|
||||
ItemHeight = 16
|
||||
OnChange = CbStartColorChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 245
|
||||
Height = 15
|
||||
Top = 26
|
||||
Width = 57
|
||||
Caption = 'Start color:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 245
|
||||
Height = 15
|
||||
Top = 60
|
||||
Width = 57
|
||||
Caption = 'Start color:'
|
||||
ParentColor = False
|
||||
end
|
||||
object CbEndColor: TColorBox
|
||||
Left = 328
|
||||
Height = 22
|
||||
Top = 56
|
||||
Width = 100
|
||||
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbPrettyNames]
|
||||
ItemHeight = 16
|
||||
OnChange = CbEndColorChange
|
||||
TabOrder = 2
|
||||
end
|
||||
object CbGradientBlocks: TCheckBox
|
||||
Left = 245
|
||||
Height = 19
|
||||
Top = 96
|
||||
Width = 102
|
||||
Caption = 'Gradient blocks'
|
||||
OnChange = CbGradientBlocksChange
|
||||
TabOrder = 3
|
||||
end
|
||||
object CbSolid: TCheckBox
|
||||
Left = 245
|
||||
Height = 19
|
||||
Top = 128
|
||||
Width = 46
|
||||
Caption = 'Solid'
|
||||
OnChange = CbSolidChange
|
||||
TabOrder = 4
|
||||
end
|
||||
object CbBorder: TCheckBox
|
||||
Left = 245
|
||||
Height = 19
|
||||
Top = 159
|
||||
Width = 55
|
||||
Caption = 'Border'
|
||||
OnChange = CbBorderChange
|
||||
TabOrder = 5
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 31
|
||||
Height = 15
|
||||
Top = 64
|
||||
Width = 128
|
||||
Caption = 'Please drag the scrollbar'
|
||||
ParentColor = False
|
||||
end
|
||||
object CbBorderColor: TColorBox
|
||||
Left = 328
|
||||
Height = 22
|
||||
Top = 166
|
||||
Width = 100
|
||||
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbPrettyNames]
|
||||
ItemHeight = 16
|
||||
OnChange = CbBorderColorChange
|
||||
TabOrder = 6
|
||||
end
|
||||
object CbFlat: TCheckBox
|
||||
Left = 245
|
||||
Height = 19
|
||||
Top = 176
|
||||
Width = 39
|
||||
Caption = 'Flat'
|
||||
OnChange = CbFlatChange
|
||||
TabOrder = 7
|
||||
end
|
||||
object CbTextOption: TComboBox
|
||||
Left = 328
|
||||
Height = 23
|
||||
Top = 208
|
||||
Width = 100
|
||||
ItemHeight = 15
|
||||
Items.Strings = (
|
||||
'toCaption'
|
||||
'toFormat'
|
||||
'toNoText'
|
||||
'toPercent'
|
||||
)
|
||||
OnChange = CbTextOptionChange
|
||||
TabOrder = 8
|
||||
Text = 'CbTextOption'
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 245
|
||||
Height = 15
|
||||
Top = 212
|
||||
Width = 62
|
||||
Caption = 'Text option:'
|
||||
ParentColor = False
|
||||
end
|
||||
object CbTextCentered: TCheckBox
|
||||
Left = 245
|
||||
Height = 19
|
||||
Top = 296
|
||||
Width = 91
|
||||
Caption = 'Text centered'
|
||||
OnChange = CbTextCenteredChange
|
||||
TabOrder = 9
|
||||
end
|
||||
object EdFormat: TEdit
|
||||
Left = 328
|
||||
Height = 23
|
||||
Top = 236
|
||||
Width = 100
|
||||
TabOrder = 10
|
||||
Text = '%d%% done.'
|
||||
end
|
||||
object LblFormat: TLabel
|
||||
Left = 247
|
||||
Height = 15
|
||||
Top = 240
|
||||
Width = 38
|
||||
Caption = 'Format'
|
||||
FocusControl = EdFormat
|
||||
ParentColor = False
|
||||
end
|
||||
object CbTextColor: TColorBox
|
||||
Left = 328
|
||||
Height = 22
|
||||
Top = 264
|
||||
Width = 100
|
||||
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbPrettyNames]
|
||||
ItemHeight = 16
|
||||
OnChange = CbTextColorChange
|
||||
TabOrder = 11
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 245
|
||||
Height = 15
|
||||
Top = 268
|
||||
Width = 54
|
||||
Caption = 'Text color:'
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
151
components/jvcllaz/examples/JvSpecialProgress/main.pas
Normal file
151
components/jvcllaz/examples/JvSpecialProgress/main.pas
Normal file
@ -0,0 +1,151 @@
|
||||
unit main;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ColorBox,
|
||||
ExtCtrls, JvSpecialProgress;
|
||||
|
||||
type
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
TMainForm = class(TForm)
|
||||
Bevel1: TBevel;
|
||||
CbBorderColor: TColorBox;
|
||||
CbTextColor: TColorBox;
|
||||
CbTextCentered: TCheckBox;
|
||||
CbStartColor: TColorBox;
|
||||
CbEndColor: TColorBox;
|
||||
CbGradientBlocks: TCheckBox;
|
||||
CbSolid: TCheckBox;
|
||||
CbBorder: TCheckBox;
|
||||
CbFlat: TCheckBox;
|
||||
CbTextOption: TComboBox;
|
||||
EdFormat: TEdit;
|
||||
JvSpecialProgress1: TJvSpecialProgress;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
Label4: TLabel;
|
||||
Label5: TLabel;
|
||||
LblFormat: TLabel;
|
||||
ScrollBar1: TScrollBar;
|
||||
procedure CbBorderChange(Sender: TObject);
|
||||
procedure CbBorderColorChange(Sender: TObject);
|
||||
procedure CbTextColorChange(Sender: TObject);
|
||||
procedure CbEndColorChange(Sender: TObject);
|
||||
procedure CbFlatChange(Sender: TObject);
|
||||
procedure CbGradientBlocksChange(Sender: TObject);
|
||||
procedure CbSolidChange(Sender: TObject);
|
||||
procedure CbStartColorChange(Sender: TObject);
|
||||
procedure CbTextCenteredChange(Sender: TObject);
|
||||
procedure CbTextOptionChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure ScrollBar1Change(Sender: TObject);
|
||||
private
|
||||
FSavedCaption: String;
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
MainForm: TMainForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
procedure TMainForm.ScrollBar1Change(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.Position := Scrollbar1.Position;
|
||||
end;
|
||||
|
||||
procedure TMainForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FSavedCaption := JvSpecialProgress1.Caption;
|
||||
Scrollbar1.Position := JvSpecialProgress1.Position;
|
||||
CbStartColor.Selected := JvSpecialProgress1.StartColor;
|
||||
CbEndcolor.Selected := JvSpecialProgress1.EndColor;
|
||||
CbGradientBlocks.Checked := JvSpecialProgress1.GradientBlocks;
|
||||
CbSolid.Checked := JvSpecialProgress1.Solid;
|
||||
CbBorder.Checked := JvSpecialProgress1.BorderStyle <> bsNone;
|
||||
CbBorderColor.Selected := JvSpecialProgress1.BorderColor;
|
||||
CbFlat.Checked := JvSpecialProgress1.Flat;
|
||||
CbFlat.Enabled := CbBorder.Checked;
|
||||
CbBorderColor.Visible := CbBorder.Checked and CbFlat.Checked;
|
||||
CbTextOption.ItemIndex := Ord(JvSpecialProgress1.TextOption);
|
||||
CbTextCentered.Checked := JvSpecialProgress1.TextCentered;
|
||||
if JvSpecialProgress1.Font.Color = clDefault then
|
||||
CbTextColor.Selected := GetDefaultColor(dctFont)
|
||||
else
|
||||
CbTextColor.Selected := JvSpecialProgress1.Font.Color;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbStartColorChange(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.StartColor := CbStartColor.Selected;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbTextCenteredChange(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.TextCentered := CbTextCentered.Checked;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbTextOptionChange(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.TextOption := TJvTextOption(CbTextOption.ItemIndex);
|
||||
if JvSpecialProgress1.TextOption = toFormat then
|
||||
JvSpecialProgress1.Caption := EdFormat.Text
|
||||
else
|
||||
JvSpecialProgress1.Caption := FSavedCaption;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbEndColorChange(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.EndColor := CbEndColor.Selected;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbFlatChange(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.Flat := CbFlat.Checked;
|
||||
CbBorderColor.Visible := CbBorder.Checked and CbFlat.Checked;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbBorderChange(Sender: TObject);
|
||||
begin
|
||||
if CbBorder.Checked then
|
||||
JvSpecialProgress1.BorderStyle := bsSingle
|
||||
else
|
||||
JvSpecialProgress1.Borderstyle := bsNone;
|
||||
CbFlat.Enabled := CbBorder.Checked;
|
||||
CbBorderColor.Visible := CbBorder.Checked and CbFlat.Checked;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbBorderColorChange(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.BorderColor := CbBorderColor.Selected;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbTextColorChange(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.Font.Color := CbTextColor.Selected;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbGradientBlocksChange(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.GradientBlocks := CbGradientBlocks.Checked;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbSolidChange(Sender: TObject);
|
||||
begin
|
||||
JvSpecialProgress1.Solid := CbSolid.Checked;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -0,0 +1,81 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="specialprogress_demo"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="JvMMLazR"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="specialprogress_demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="main.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="MainForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="specialprogress_demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@ -0,0 +1,22 @@
|
||||
program specialprogress_demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, main
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Scaled:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
44
components/jvcllaz/packages/jvmmlazd.lpk
Normal file
44
components/jvcllaz/packages/jvmmlazd.lpk
Normal file
@ -0,0 +1,44 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="JvMMLazD"/>
|
||||
<Type Value="DesignTime"/>
|
||||
<Author Value="Various authors - see header of each unit for original author."/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="..\design\JvMM"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="..\design\JvMM\jvmmreg.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="JvMMReg"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<RequiredPkgs Count="4">
|
||||
<Item1>
|
||||
<PackageName Value="JvCoreLazD"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="JvMMLazR"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item4>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
39
components/jvcllaz/packages/jvmmlazr.lpk
Normal file
39
components/jvcllaz/packages/jvmmlazr.lpk
Normal file
@ -0,0 +1,39 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="JvMMLazR"/>
|
||||
<Author Value="Various authors - see header of each unit for original author."/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="..\run\JvMM"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Description Value="JVCL Multimedia Components (Runtime)."/>
|
||||
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
||||
<Version Major="1" Release="4"/>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="..\run\JvMM\JvSpecialProgress.pas"/>
|
||||
<UnitName Value="JvSpecialProgress"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="JvCoreLazR"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item2>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
BIN
components/jvcllaz/resource/jvmmreg.res
Normal file
BIN
components/jvcllaz/resource/jvmmreg.res
Normal file
Binary file not shown.
731
components/jvcllaz/run/JvMM/JvSpecialProgress.pas
Normal file
731
components/jvcllaz/run/JvMM/JvSpecialProgress.pas
Normal file
@ -0,0 +1,731 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvSpecialProgress.PAS, released on 2001-02-28.
|
||||
|
||||
The Initial Developer of the Original Code is S�bastien Buysse [sbuysse att buypin dott com]
|
||||
Portions created by S�bastien Buysse are Copyright (C) 2001 S�bastien Buysse.
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s):
|
||||
Michael Beck [mbeck att bigfoot dott com].
|
||||
[eldorado]
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI home page,
|
||||
located at http://www.delphi-jedi.org
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id$
|
||||
|
||||
unit JvSpecialProgress;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, // for Frame3D
|
||||
JvComponent;
|
||||
|
||||
type
|
||||
TJvTextOption = (toCaption, toFormat, toNoText, toPercent);
|
||||
|
||||
TJvSpecialProgress = class(TJvGraphicControl)
|
||||
private
|
||||
FBorderColor: TColor;
|
||||
FBorderStyle: TBorderStyle;
|
||||
FEndColor: TColor;
|
||||
FFlat: Boolean;
|
||||
FGradientBlocks: Boolean;
|
||||
FMaximum: Integer;
|
||||
FMinimum: Integer;
|
||||
FPosition: Integer;
|
||||
FSolid: Boolean;
|
||||
FStartColor: TColor;
|
||||
FStep: Integer;
|
||||
FTextCentered: Boolean;
|
||||
FTextOption: TJvTextOption;
|
||||
FBuffer: TBitmap;
|
||||
FBlock: Integer;
|
||||
{ FIsChanged indicates if the buffer needs to be redrawn }
|
||||
FIsChanged: Boolean;
|
||||
FStart: TColor;
|
||||
FEnd: TColor;
|
||||
{ If Solid = False then the values of the following vars are valid: }
|
||||
{ FBlockCount is # of blocks }
|
||||
FBlockCount: Integer;
|
||||
{ FBlockWidth is length of block in pixels + 1 (seperator) }
|
||||
FBlockWidth: Integer;
|
||||
{ FLastBlockPartial indicates whether the last block is of length
|
||||
FBlockWidth; if FLastBlockPartial is True the progressbar is totally
|
||||
filled and the last block is *not* of length FBlockWidth, but of
|
||||
length FLastBlockWidth; if FLastBlockPartial is False the progressbar
|
||||
is not totally filled or the last block is of length FBlockWidth }
|
||||
FLastBlockPartial: Boolean;
|
||||
{ FLastBlockWidth specifies the length of the last block if the
|
||||
progressbar is totally filled, note: *not* +1 for seperator }
|
||||
FLastBlockWidth: Integer;
|
||||
function GetPercentDone: Longint;
|
||||
procedure SetBorderColor(const Value: TColor);
|
||||
procedure SetBorderStyle(const Value: TBorderStyle);
|
||||
procedure SetEndColor(const Value: TColor);
|
||||
procedure SetFlat(const Value: Boolean);
|
||||
procedure SetGradientBlocks(const Value: Boolean);
|
||||
procedure SetMaximum(const Value: Integer);
|
||||
procedure SetMinimum(const Value: Integer);
|
||||
procedure SetPosition(const Value: Integer);
|
||||
procedure SetSolid(const Value: Boolean);
|
||||
procedure SetStartColor(const Value: TColor);
|
||||
procedure SetTextCentered(const Value: Boolean);
|
||||
procedure SetTextOption(const Value: TJvTextOption);
|
||||
procedure PaintRectangle;
|
||||
procedure PaintNonSolid;
|
||||
procedure PaintSolid;
|
||||
procedure DoEraseBackground;
|
||||
procedure PaintText;
|
||||
protected
|
||||
function ColorOrDefaultColor: TColor;
|
||||
procedure Paint; override;
|
||||
procedure Loaded; override;
|
||||
procedure ColorChanged; override;
|
||||
procedure FontChanged; override;
|
||||
procedure TextChanged; override;
|
||||
procedure UpdateBuffer;
|
||||
procedure UpdateBlock;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure StepIt;
|
||||
property PercentDone: Longint read GetPercentDone;
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
property BorderColor: TColor read FBorderColor write SetBorderColor default clWindowFrame;
|
||||
property BorderSpacing;
|
||||
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
|
||||
property Caption;
|
||||
property Color;
|
||||
property EndColor: TColor read FEndColor write SetEndColor default clBlack;
|
||||
property Flat: Boolean read FFlat write SetFlat default true;
|
||||
property Font;
|
||||
property GradientBlocks: Boolean read FGradientBlocks write SetGradientBlocks default False;
|
||||
property HintColor;
|
||||
property Maximum: Integer read FMaximum write SetMaximum default 100;
|
||||
property Minimum: Integer read FMinimum write SetMinimum default 0;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property Position: Integer read FPosition write SetPosition default 0;
|
||||
property ShowHint;
|
||||
property Solid: Boolean read FSolid write SetSolid default False;
|
||||
property StartColor: TColor read FStartColor write SetStartColor default clWhite;
|
||||
property Step: Integer read FStep write FStep default 10;
|
||||
property TextCentered: Boolean read FTextCentered write SetTextCentered default False;
|
||||
property TextOption: TJvTextOption read FTextOption write SetTextOption default toNoText;
|
||||
property Visible;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnDragOver;
|
||||
property OnDragDrop;
|
||||
property OnEndDock;
|
||||
property OnStartDock;
|
||||
property OnEndDrag;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnResize;
|
||||
property OnStartDrag;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnParentColorChange;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
constructor TJvSpecialProgress.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FBuffer := TBitmap.Create;
|
||||
|
||||
ControlStyle := ControlStyle + [csOpaque]; // SMM 20020604
|
||||
FBorderColor := clWindowFrame;
|
||||
FBorderStyle := bsNone;
|
||||
FMaximum := 100;
|
||||
FMinimum := 0;
|
||||
FStartColor := clWhite;
|
||||
FStart := clWhite;
|
||||
FEndColor := clBlack;
|
||||
FEnd := clBlack;
|
||||
FFlat := true;
|
||||
FPosition := 0;
|
||||
FSolid := False;
|
||||
FTextOption := toNoText;
|
||||
FTextCentered := False;
|
||||
FGradientBlocks := False;
|
||||
FStep := 10;
|
||||
|
||||
Width := 150;
|
||||
Height := 15;
|
||||
FIsChanged := True;
|
||||
end;
|
||||
|
||||
destructor TJvSpecialProgress.Destroy;
|
||||
begin
|
||||
FBuffer.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.ColorChanged;
|
||||
begin
|
||||
//inherited ColorChanged; calls CM_COLORCHANGED in VCL
|
||||
{ No need to call inherited; Repaint is called in UpdateBuffer }
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.FontChanged;
|
||||
begin
|
||||
//inherited FontChanged; calls CM_COLORCHANGED in VCL
|
||||
{ No need to call inherited; Repaint is called in UpdateBuffer }
|
||||
FBuffer.Canvas.Font := Font;
|
||||
|
||||
{ Only update if text is visible }
|
||||
if TextOption = toNoText then
|
||||
Exit;
|
||||
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
|
||||
function TJvSpecialProgress.ColorOrDefaultColor: TColor;
|
||||
begin
|
||||
if Color = clDefault then
|
||||
Result := GetDefaultColor(dctBrush)
|
||||
else
|
||||
Result := Color;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.TextChanged;
|
||||
begin
|
||||
if TextOption in [toCaption, toFormat] then
|
||||
begin
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
inherited TextChanged;
|
||||
end;
|
||||
|
||||
function TJvSpecialProgress.GetPercentDone: Longint;
|
||||
begin
|
||||
if FMaximum - FMinimum = 0 then
|
||||
Result := 0
|
||||
else
|
||||
Result := MulDiv(FPosition - FMinimum, 100, FMaximum - FMinimum);
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
UpdateBlock;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.Paint;
|
||||
begin
|
||||
if (FBuffer.Width <> ClientWidth) or (FBuffer.Height <> ClientHeight) then
|
||||
begin
|
||||
FIsChanged := True;
|
||||
UpdateBlock;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
if (ClientWidth > 2) and (ClientHeight > 2) then
|
||||
begin
|
||||
BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
|
||||
FBuffer.Canvas.Handle, 0, 0, SRCCOPY);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.DoEraseBackground;
|
||||
begin
|
||||
if FBlock >= ClientWidth - 2 then
|
||||
Exit;
|
||||
|
||||
FBuffer.Canvas.Brush.Color := ColorOrDefaultColor;
|
||||
FBuffer.Canvas.Brush.Style := bsSolid;
|
||||
FBuffer.Canvas.FillRect(Rect(FBlock + 1, 1, ClientWidth - 1, ClientHeight - 1));
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.PaintNonSolid;
|
||||
var
|
||||
RedInc, GreenInc, BlueInc: Real;
|
||||
Red, Green, Blue: Real;
|
||||
X: Integer;
|
||||
I, J: Integer;
|
||||
LBlockCount: Integer;
|
||||
begin
|
||||
if (FBlock = 0) or (FBlockWidth = 0) then
|
||||
Exit;
|
||||
|
||||
X := 1;
|
||||
|
||||
{ LBlockCount equals # blocks of size FBlockWidth }
|
||||
if FLastBlockPartial then
|
||||
LBlockCount := FBlockCount - 1
|
||||
else
|
||||
LBlockCount := FBlockCount;
|
||||
|
||||
{ Are the start and end colors equal? }
|
||||
if FStart = FEnd then
|
||||
begin
|
||||
{ No gradient fill because the start color equals the end color }
|
||||
FBuffer.Canvas.Brush.Color := FStart;
|
||||
FBuffer.Canvas.Brush.Style := bsSolid;
|
||||
for I := 0 to LBlockCount - 1 do
|
||||
begin
|
||||
{ Width of block is FBlockWidth -1 [-1 for seperator] }
|
||||
FBuffer.Canvas.FillRect(Bounds(X, 1, FBlockWidth - 1, ClientHeight - 2));
|
||||
Inc(X, FBlockWidth);
|
||||
end;
|
||||
if FLastBlockPartial then
|
||||
{ Width of last block is FLastBlockWidth [no seperator] }
|
||||
FBuffer.Canvas.FillRect(Bounds(X, 1, FLastBlockWidth, ClientHeight - 2));
|
||||
end
|
||||
else
|
||||
begin
|
||||
RedInc := (GetRValue(FEnd) - GetRValue(FStart)) / FBlock;
|
||||
GreenInc := (GetGValue(FEnd) - GetGValue(FStart)) / FBlock;
|
||||
BlueInc := (GetBValue(FEnd) - GetBValue(FStart)) / FBlock;
|
||||
|
||||
Red := GetRValue(FStart);
|
||||
Green := GetGValue(FStart);
|
||||
Blue := GetBValue(FStart);
|
||||
|
||||
FBuffer.Canvas.Brush.Style := bsSolid;
|
||||
|
||||
for I := 0 to LBlockCount - 1 do
|
||||
begin
|
||||
if not FGradientBlocks then
|
||||
begin
|
||||
FBuffer.Canvas.Brush.Color := RGB(Round(Red), Round(Green), Round(Blue));
|
||||
Red := Red + RedInc * FBlockWidth;
|
||||
Blue := Blue + BlueInc * FBlockWidth;
|
||||
Green := Green + GreenInc * FBlockWidth;
|
||||
{ Width of block is FBlockWidth -1 [-1 for separator] }
|
||||
FBuffer.Canvas.FillRect(Bounds(X, 1, FBlockWidth - 1, ClientHeight - 2));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Fill the progressbar with slices of 1 width }
|
||||
for J := 0 to FBlockWidth - 2 do
|
||||
begin
|
||||
FBuffer.Canvas.Brush.Color := RGB(Round(Red), Round(Green), Round(Blue));
|
||||
Red := Red + RedInc;
|
||||
Blue := Blue + BlueInc;
|
||||
Green := Green + GreenInc;
|
||||
FBuffer.Canvas.FillRect(Bounds(X + J, 1, 1, ClientHeight - 2));
|
||||
end;
|
||||
{ Seperator is not filled, but increase the colors }
|
||||
Red := Red + RedInc;
|
||||
Blue := Blue + BlueInc;
|
||||
Green := Green + GreenInc;
|
||||
end;
|
||||
Inc(X, FBlockWidth);
|
||||
end;
|
||||
if FLastBlockPartial then
|
||||
begin
|
||||
if not FGradientBlocks then
|
||||
begin
|
||||
FBuffer.Canvas.Brush.Color := RGB(Round(Red), Round(Green), Round(Blue));
|
||||
{ Width of last block is FLastBlockWidth [no seperator] }
|
||||
FBuffer.Canvas.FillRect(Bounds(X, 1, FLastBlockWidth, ClientHeight - 2));
|
||||
end
|
||||
else
|
||||
{ Width of last block is FLastBlockWidth [no seperator] }
|
||||
for J := 0 to FLastBlockWidth - 1 do
|
||||
begin
|
||||
FBuffer.Canvas.Brush.Color := RGB(Round(Red), Round(Green), Round(Blue));
|
||||
Red := Red + RedInc;
|
||||
Blue := Blue + BlueInc;
|
||||
Green := Green + GreenInc;
|
||||
FBuffer.Canvas.FillRect(Bounds(X + J, 1, 1, ClientHeight - 2));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Draw the block seperators }
|
||||
X := FBlockWidth;
|
||||
FBuffer.Canvas.Brush.Color := ColorOrDefaultColor;
|
||||
for I := 0 to LBlockCount - 1 do
|
||||
begin
|
||||
FBuffer.Canvas.FillRect(Bounds(X, 1, 1, ClientHeight - 2));
|
||||
Inc(X, FBlockWidth);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.PaintRectangle;
|
||||
var
|
||||
Rect: TRect;
|
||||
begin
|
||||
Rect := ClientRect;
|
||||
if BorderStyle = bsNone then
|
||||
begin
|
||||
FBuffer.Canvas.Brush.Color := ColorOrDefaultColor;
|
||||
FBuffer.Canvas.FrameRect(Rect);
|
||||
end
|
||||
else
|
||||
if FFlat then
|
||||
begin
|
||||
FBuffer.Canvas.Brush.Style := bsClear;
|
||||
FBuffer.Canvas.Pen.Color := FBorderColor;
|
||||
FBuffer.Canvas.Rectangle(Rect);
|
||||
end else
|
||||
begin
|
||||
Frame3D(FBuffer.Canvas, Rect, clBtnFace, clBtnFace, 1);
|
||||
Frame3D(FBuffer.Canvas, Rect, clBtnShadow, clBtnHighlight, 1);
|
||||
Frame3D(FBuffer.Canvas, Rect, cl3DDkShadow, clBtnFace, 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.PaintSolid;
|
||||
var
|
||||
RedInc, BlueInc, GreenInc: Real;
|
||||
I: Integer;
|
||||
begin
|
||||
if FBlock = 0 then
|
||||
Exit;
|
||||
|
||||
if FStart = FEnd then
|
||||
begin
|
||||
{ No gradient fill because the start color equals the end color }
|
||||
FBuffer.Canvas.Brush.Color := FStart;
|
||||
FBuffer.Canvas.Brush.Style := bsSolid;
|
||||
FBuffer.Canvas.FillRect(Rect(1, 1, 1 + FBlock, ClientHeight - 1));
|
||||
end
|
||||
else
|
||||
begin
|
||||
RedInc := (GetRValue(FEnd) - GetRValue(FStart)) / FBlock;
|
||||
GreenInc := (GetGValue(FEnd) - GetGValue(FStart)) / FBlock;
|
||||
BlueInc := (GetBValue(FEnd) - GetBValue(FStart)) / FBlock;
|
||||
FBuffer.Canvas.Brush.Style := bsSolid;
|
||||
{ Fill the progressbar with slices of 1 width }
|
||||
for I := 1 to FBlock do
|
||||
begin
|
||||
FBuffer.Canvas.Brush.Color := RGB(
|
||||
Round(GetRValue(FStart) + ((I - 1) * RedInc)),
|
||||
Round(GetGValue(FStart) + ((I - 1) * GreenInc)),
|
||||
Round(GetBValue(FStart) + ((I - 1) * BlueInc)));
|
||||
FBuffer.Canvas.FillRect(Rect(I, 1, I + 1, ClientHeight - 1));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.PaintText;
|
||||
var
|
||||
S: string;
|
||||
X, Y: Integer;
|
||||
LBlock: Integer;
|
||||
begin
|
||||
case TextOption of
|
||||
toPercent:
|
||||
S := Format('%d%%', [PercentDone]);
|
||||
toFormat:
|
||||
S := Format(Caption, [PercentDone]);
|
||||
toCaption:
|
||||
S := Caption;
|
||||
else {toNoText}
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if TextCentered then
|
||||
LBlock := ClientWidth
|
||||
else
|
||||
LBlock := FBlock;
|
||||
|
||||
X := (LBlock - FBuffer.Canvas.TextWidth(S)) div 2;
|
||||
if X < 0 then
|
||||
X := 0;
|
||||
|
||||
Y := (ClientHeight - FBuffer.Canvas.TextHeight(S)) div 2;
|
||||
if Y < 0 then
|
||||
Y := 0;
|
||||
|
||||
SetBkMode(FBuffer.Canvas.Handle, LCLType.TRANSPARENT);
|
||||
// FBuffer.Canvas.Brush.Color := clNone;
|
||||
// FBuffer.Canvas.Brush.Style := bsClear;
|
||||
FBuffer.Canvas.TextOut(X, Y, S);
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetBorderColor(const Value: TColor);
|
||||
begin
|
||||
if FBorderColor <> Value then
|
||||
begin
|
||||
FBorderColor := Value;
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetBorderStyle(const Value: TBorderStyle);
|
||||
begin
|
||||
if FBorderStyle <> Value then
|
||||
begin
|
||||
FBorderStyle := Value;
|
||||
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetEndColor(const Value: TColor);
|
||||
begin
|
||||
if FEndColor <> Value then
|
||||
begin
|
||||
FEndColor := Value;
|
||||
FEnd := ColorToRGB(FEndColor);
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetFlat(const Value: Boolean);
|
||||
begin
|
||||
if FFlat <> Value then
|
||||
begin
|
||||
FFlat := Value;
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetGradientBlocks(const Value: Boolean);
|
||||
begin
|
||||
if Value <> FGradientBlocks then
|
||||
begin
|
||||
FGradientBlocks := Value;
|
||||
if not Solid then
|
||||
begin
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetMaximum(const Value: Integer);
|
||||
var
|
||||
OldPercentageDone: Integer;
|
||||
begin
|
||||
if FMaximum <> Value then
|
||||
begin
|
||||
OldPercentageDone := GetPercentDone;
|
||||
|
||||
FMaximum := Value;
|
||||
if FMaximum < FMinimum then
|
||||
FMaximum := FMinimum;
|
||||
if FPosition > Value then
|
||||
FPosition := Value;
|
||||
|
||||
{ If the percentage has changed we must update, otherwise check in
|
||||
UpdateBlock if we must update }
|
||||
FIsChanged := (TextOption in [toPercent, toFormat]) and (OldPercentageDone <> GetPercentDone);
|
||||
UpdateBlock;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetMinimum(const Value: Integer);
|
||||
var
|
||||
OldPercentageDone: Integer;
|
||||
begin
|
||||
if FMinimum <> Value then
|
||||
begin
|
||||
OldPercentageDone := GetPercentDone;
|
||||
|
||||
FMinimum := Value;
|
||||
if FMinimum > FMaximum then
|
||||
FMinimum := FMaximum;
|
||||
if FPosition < Value then
|
||||
FPosition := Value;
|
||||
|
||||
{ If the percentage has changed we must update, otherwise check in
|
||||
UpdateBlock if we must update }
|
||||
FIsChanged := (TextOption in [toPercent, toFormat]) and (OldPercentageDone <> GetPercentDone);
|
||||
UpdateBlock;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetPosition(const Value: Integer);
|
||||
var
|
||||
OldPercentageDone: Integer;
|
||||
begin
|
||||
if FPosition <> Value then
|
||||
begin
|
||||
OldPercentageDone := GetPercentDone;
|
||||
|
||||
FPosition := Value;
|
||||
if FPosition > FMaximum then
|
||||
FPosition := FMaximum
|
||||
else
|
||||
if FPosition < FMinimum then
|
||||
FPosition := FMinimum;
|
||||
|
||||
{ If the percentage has changed we must update, otherwise check in
|
||||
UpdateBlock if we must update }
|
||||
FIsChanged := (TextOption in [toPercent, toFormat]) and (OldPercentageDone <> GetPercentDone);
|
||||
UpdateBlock;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetSolid(const Value: Boolean);
|
||||
begin
|
||||
if FSolid <> Value then
|
||||
begin
|
||||
FSolid := Value;
|
||||
FIsChanged := True;
|
||||
UpdateBlock;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetStartColor(const Value: TColor);
|
||||
begin
|
||||
if FStartColor <> Value then
|
||||
begin
|
||||
FStartColor := Value;
|
||||
FStart := ColorToRGB(FStartColor);
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetTextCentered(const Value: Boolean);
|
||||
begin
|
||||
if FTextCentered <> Value then
|
||||
begin
|
||||
FTextCentered := Value;
|
||||
if TextOption <> toNoText then
|
||||
begin
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.SetTextOption(const Value: TJvTextOption);
|
||||
begin
|
||||
if FTextOption <> Value then
|
||||
begin
|
||||
FTextOption := Value;
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.StepIt;
|
||||
begin
|
||||
if FPosition + FStep > FMaximum then
|
||||
Position := FMaximum
|
||||
else
|
||||
if FPosition + FStep < FMinimum then
|
||||
Position := FMinimum
|
||||
else
|
||||
Position := FPosition + FStep;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.UpdateBuffer;
|
||||
begin
|
||||
if not FIsChanged or (csLoading in ComponentState) then
|
||||
Exit;
|
||||
FIsChanged := False;
|
||||
|
||||
if (ClientWidth <= 0) or (ClientHeight <= 0) then
|
||||
Exit;
|
||||
FBuffer.Width := ClientWidth;
|
||||
FBuffer.Height := ClientHeight;
|
||||
|
||||
if FSolid then
|
||||
PaintSolid
|
||||
else
|
||||
PaintNonSolid;
|
||||
|
||||
DoEraseBackground;
|
||||
PaintText;
|
||||
PaintRectangle;
|
||||
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
procedure TJvSpecialProgress.UpdateBlock;
|
||||
var
|
||||
NewBlock: Integer;
|
||||
NextBlockWidth: Integer;
|
||||
begin
|
||||
if csLoading in ComponentState then
|
||||
Exit;
|
||||
|
||||
if (FMaximum = FMinimum) or (ClientWidth < 2) then
|
||||
Exit;
|
||||
|
||||
{ Max width of the progressbar is ClientWidth -2 [-2 for the border],
|
||||
NewBlock specifies the new length of the progressbar }
|
||||
NewBlock := MulDiv(FPosition - FMinimum, ClientWidth - 2, FMaximum - FMinimum);
|
||||
if not FSolid then
|
||||
begin
|
||||
{ The Block of a solid bar can have a different size than the Block
|
||||
of a non-solid bar }
|
||||
FBlockWidth := Round(ClientHeight * 2 div 3);
|
||||
if FBlockWidth = 0 then
|
||||
NewBlock := 0
|
||||
else
|
||||
begin
|
||||
{ The block count equals 'Block div blockwidth'. We add 1 to
|
||||
that number if the Block is further than 1/2 of the next block.
|
||||
Note that the next block doesn't have to be of size FBlockWidth,
|
||||
because it can be the last block, which can be smaller than
|
||||
FBlockWidth }
|
||||
|
||||
FBlockCount := NewBlock div FBlockWidth;
|
||||
NextBlockWidth := ClientWidth - 2 - (FBlockCount * FBlockWidth);
|
||||
if NextBlockWidth > FBlockWidth then
|
||||
NextBlockWidth := FBlockWidth;
|
||||
|
||||
if 2 * (NewBlock mod FBlockWidth) > NextBlockWidth then
|
||||
begin
|
||||
Inc(FBlockCount);
|
||||
FLastBlockPartial := NextBlockWidth < FBlockWidth;
|
||||
FLastBlockWidth := NextBlockWidth;
|
||||
NewBlock := FBlockWidth * FBlockCount;
|
||||
{ If FLastBlockPartial equals True then the progressbar is totally
|
||||
filled: }
|
||||
if FLastBlockPartial then
|
||||
NewBlock := ClientWidth - 2;
|
||||
end
|
||||
else
|
||||
begin
|
||||
FLastBlockPartial := False;
|
||||
NewBlock := FBlockWidth * FBlockCount;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if NewBlock = FBlock then
|
||||
Exit;
|
||||
|
||||
FBlock := NewBlock;
|
||||
|
||||
FIsChanged := True;
|
||||
UpdateBuffer;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user