diff --git a/components/jvcllaz/design/JvMM/images/images.txt b/components/jvcllaz/design/JvMM/images/images.txt
new file mode 100644
index 000000000..ca2b43a66
--- /dev/null
+++ b/components/jvcllaz/design/JvMM/images/images.txt
@@ -0,0 +1 @@
+tjvspecialprogress.bmp
diff --git a/components/jvcllaz/design/JvMM/images/make_res.bat b/components/jvcllaz/design/JvMM/images/make_res.bat
new file mode 100644
index 000000000..8ad19f992
--- /dev/null
+++ b/components/jvcllaz/design/JvMM/images/make_res.bat
@@ -0,0 +1 @@
+lazres ../../../resource/jvmmreg.res @images.txt
diff --git a/components/jvcllaz/design/JvMM/images/tjvspecialprogress.bmp b/components/jvcllaz/design/JvMM/images/tjvspecialprogress.bmp
new file mode 100644
index 000000000..53d9c1605
Binary files /dev/null and b/components/jvcllaz/design/JvMM/images/tjvspecialprogress.bmp differ
diff --git a/components/jvcllaz/design/JvMM/jvmmreg.pas b/components/jvcllaz/design/JvMM/jvmmreg.pas
new file mode 100644
index 000000000..83783f5f8
--- /dev/null
+++ b/components/jvcllaz/design/JvMM/jvmmreg.pas
@@ -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.
+
diff --git a/components/jvcllaz/examples/JvSpecialProgress/main.lfm b/components/jvcllaz/examples/JvSpecialProgress/main.lfm
new file mode 100644
index 000000000..daf4fde2d
--- /dev/null
+++ b/components/jvcllaz/examples/JvSpecialProgress/main.lfm
@@ -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
diff --git a/components/jvcllaz/examples/JvSpecialProgress/main.pas b/components/jvcllaz/examples/JvSpecialProgress/main.pas
new file mode 100644
index 000000000..7639d8d2d
--- /dev/null
+++ b/components/jvcllaz/examples/JvSpecialProgress/main.pas
@@ -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.
+
diff --git a/components/jvcllaz/examples/JvSpecialProgress/specialprogress_demo.lpi b/components/jvcllaz/examples/JvSpecialProgress/specialprogress_demo.lpi
new file mode 100644
index 000000000..744c073af
--- /dev/null
+++ b/components/jvcllaz/examples/JvSpecialProgress/specialprogress_demo.lpi
@@ -0,0 +1,81 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/examples/JvSpecialProgress/specialprogress_demo.lpr b/components/jvcllaz/examples/JvSpecialProgress/specialprogress_demo.lpr
new file mode 100644
index 000000000..96227357a
--- /dev/null
+++ b/components/jvcllaz/examples/JvSpecialProgress/specialprogress_demo.lpr
@@ -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.
+
diff --git a/components/jvcllaz/packages/jvmmlazd.lpk b/components/jvcllaz/packages/jvmmlazd.lpk
new file mode 100644
index 000000000..a6ab0a580
--- /dev/null
+++ b/components/jvcllaz/packages/jvmmlazd.lpk
@@ -0,0 +1,44 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/packages/jvmmlazr.lpk b/components/jvcllaz/packages/jvmmlazr.lpk
new file mode 100644
index 000000000..0782cc5a8
--- /dev/null
+++ b/components/jvcllaz/packages/jvmmlazr.lpk
@@ -0,0 +1,39 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/resource/jvmmreg.res b/components/jvcllaz/resource/jvmmreg.res
new file mode 100644
index 000000000..9ccb7bab8
Binary files /dev/null and b/components/jvcllaz/resource/jvmmreg.res differ
diff --git a/components/jvcllaz/run/JvMM/JvSpecialProgress.pas b/components/jvcllaz/run/JvMM/JvSpecialProgress.pas
new file mode 100644
index 000000000..59fd58da0
--- /dev/null
+++ b/components/jvcllaz/run/JvMM/JvSpecialProgress.pas
@@ -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.
+