{----------------------------------------------------------------------------- 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: JvXPProgress.PAS, released on 2004-04-05. The Initial Developer of the Original Code is Stefano Pessina [stefano dott pessina sanbiagiomonza dott it] Portions created by Stefano Pessina are Copyright (C) 2004 Stefano Pessina. All Rights Reserved. Contributor(s): Last Modified: 2004-04-07 You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Known Issues: -----------------------------------------------------------------------------} {$I jvcl.inc} unit JvXPProgressBar; interface {$IFDEF USEJVCL} uses {$IFDEF USEJVCL} {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} {$ENDIF USEJVCL} Windows, SysUtils, Classes, Graphics, JvProgressBar; type TJvCustomXPProgressBar = class(TJvBaseGradientProgressBar) private procedure DrawBlock(ACanvas: TCanvas; ARect: TRect); protected procedure DrawLine(ACanvas: TCanvas; X1, Y1, X2, Y2, AColor: TColor); procedure DrawBar(ACanvas: TCanvas; BarSize: Integer); override; public constructor Create(AOwner: TComponent); override; end; TJvXPProgressBar = class(TJvCustomXPProgressBar) published property BarColorFrom default $31D329; property BarColorTo default $ADEFAD; property Max; property Min; property Orientation; property Position; property Smooth; property Align; property Anchors; property Color default clWindow; property Constraints; {$IFDEF VCL} property DragCursor; property DragKind; property OnCanResize; property OnEndDock; property OnStartDock; {$ENDIF VCL} property DragMode; property Enabled; property Hint; property ParentColor default False; property PopupMenu; property ParentShowHint; property ShowHint; property Visible; property OnClick; property OnConstrainedResize; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnMouseDown; property OnMouseMove; property OnMouseUp; {$IFDEF COMPILER6_UP} property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; {$ENDIF COMPILER6_UP} property OnStartDrag; end; {$ENDIF USEJVCL} {$IFDEF USEJVCL} {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvXPProgressBar.pas $'; Revision: '$Revision: 10811 $'; Date: '$Date: 2006-07-11 15:07:07 +0200 (mar., 11 juil. 2006) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} {$ENDIF USEJVCL} implementation {$IFDEF USEJVCL} uses Controls, Forms, ComCtrls, JvJVCLUtils, JvJCLUtils; //=== { TJvXPProgressBar } =================================================== constructor TJvCustomXPProgressBar.Create(AOwner: TComponent); begin inherited Create(AOwner); Steps := 7; ParentColor := False; Color := clWindow; BarColorFrom := $31D329; BarColorTo := $ADEFAD; end; procedure TJvCustomXPProgressBar.DrawLine(ACanvas: TCanvas; X1, Y1, X2, Y2, AColor: TColor); begin ACanvas.Pen.Color := AColor; ACanvas.MoveTo(X1, Y1); ACanvas.LineTo(X2, Y2); end; procedure TJvCustomXPProgressBar.DrawBlock(ACanvas: TCanvas; ARect: TRect); var ARect2: TRect; begin ARect2 := ARect; if Orientation = pbHorizontal then begin Inc(ARect2.Top, RectHeight(ARect) div 2); Dec(ARect.Bottom, RectHeight(ARect) div 2); GradientFillRect(ACanvas, ARect, BarColorFrom, BarColorTo, fdBottomToTop, 255); GradientFillRect(ACanvas, ARect2, BarColorTo, BarColorFrom, fdBottomToTop, 255); end else begin Inc(ARect2.Left, RectWidth(ARect) div 2); Dec(ARect.Right, RectWidth(ARect) div 2); GradientFillRect(ACanvas, ARect, BarColorFrom, BarColorTo, fdRightToLeft, 255); GradientFillRect(ACanvas, ARect2, BarColorTo, BarColorFrom, fdRightToLeft, 255); end; end; type TWinControlAccessProtected = class(TWinControl); procedure TJvCustomXPProgressBar.DrawBar(ACanvas: TCanvas; BarSize: Integer); const cColor1 = $BEBEBE; cColor2 = $686868; cColor3 = $EFEFEF; var X, Y: Integer; R: TRect; Bmp: TBitmap; AColor: TColor; LBlockSize: Integer; begin if Parent <> nil then AColor := TWinControlAccessProtected(Parent).Color else if GetParentForm(Self) <> nil then AColor := GetParentForm(Self).Color else AColor := clBtnFace; Bmp := TBitmap.Create; try Bmp.Width := Width; Bmp.Height := Height; Bmp.Canvas.Brush.Color := clFuchsia; R := ClientRect; Bmp.Canvas.FillRect(R); InflateRect(R, -3, -2); Bmp.Canvas.Brush.Color := Color; Bmp.Canvas.FillRect(R); // draw the frame // left side X := 0; DrawLine(Bmp.Canvas, X, 1, X, Height - 1, cColor1); DrawLine(Bmp.Canvas, X, 2, X, Height - 2, cColor2); // right side X := Width - 1; DrawLine(Bmp.Canvas, X, 1, X, Height - 1, cColor1); DrawLine(Bmp.Canvas, X, 2, X, Height - 2, cColor2); // left side X := 0; DrawLine(Bmp.Canvas, X, 1, X, Height - 1, cColor1); DrawLine(Bmp.Canvas, X, 2, X, Height - 2, cColor2); // right side X := Width - 1; DrawLine(Bmp.Canvas, X, 1, X, Height - 1, cColor1); DrawLine(Bmp.Canvas, X, 2, X, Height - 2, cColor2); // left side X := 1; DrawLine(Bmp.Canvas, X, 0, X, Height, cColor1); DrawLine(Bmp.Canvas, X, 1, X, Height - 1, cColor2); DrawLine(Bmp.Canvas, X, 2, X, Height - 2, cColor1); // right side X := Width - 2; DrawLine(Bmp.Canvas, X, 0, X, Height, cColor1); DrawLine(Bmp.Canvas, X, 1, X, Height - 1, cColor2); DrawLine(Bmp.Canvas, X, 2, X, Height - 2, cColor1); // left side X := 2; DrawLine(Bmp.Canvas, X, 0, X, Height, cColor2); DrawLine(Bmp.Canvas, X, 1, X, Height - 1, cColor1); DrawLine(Bmp.Canvas, X, 3, X, Height - 1, cColor3); // right side X := Width - 3; DrawLine(Bmp.Canvas, X, 0, X, Height, cColor2); DrawLine(Bmp.Canvas, X, 1, X, Height - 1, cColor1); DrawLine(Bmp.Canvas, X, 3, X, Height - 1, cColor3); // top side Y := 0; DrawLine(Bmp.Canvas, 3, Y, Width - 3, Y, cColor2); DrawLine(Bmp.Canvas, 3, Y + 1, Width - 3, Y + 1, cColor1); DrawLine(Bmp.Canvas, 3, Y + 2, Width - 3, Y + 2, cColor3); // bottom side Y := Height - 1; DrawLine(Bmp.Canvas, 3, Y, Width - 2, Y, cColor2); DrawLine(Bmp.Canvas, 3, Y - 1, Width - 3, Y - 1, cColor3); // draw the blocks LBlockSize := BlockSize - 3; if Orientation = pbHorizontal then begin if Smooth then begin R.Right := R.Left + BarSize; InflateRect(R, -1, -1); if R.Right > Width - 3 then R.Right := Width - 3; if R.Right > R.Left then DrawBlock(Bmp.Canvas, R); end else begin R := Rect(2, 2, LBlockSize + 1, Height - 4); OffsetRect(R, 2, 1); while BarSize > 2 do begin if R.Right > Width - 3 then R.Right := Width - 3; if R.Right - R.Left > 0 then DrawBlock(Bmp.Canvas, R); OffsetRect(R, LBlockSize + 1, 0); Dec(BarSize, LBlockSize + 1); end; end; end else begin if Smooth then begin R.Top := R.Bottom - BarSize; if R.Top < 3 then R.Top := 3; InflateRect(R, -1, -1); DrawBlock(Bmp.Canvas, R); end else begin R := Rect(2, 2, Width - 4, LBlockSize + 1); OffsetRect(R, 1, 0); OffsetRect(R, 0, Height - LBlockSize - 4); while BarSize > 2 do begin if R.Top < 3 then R.Top := 3; if R.Bottom - R.Top > 0 then DrawBlock(Bmp.Canvas, R); OffsetRect(R, 0, -LBlockSize - 1); Dec(BarSize, LBlockSize + 1); end; end; end; ACanvas.Brush.Color := AColor; with ACanvas do BrushCopy({$IFDEF VisualCLX} ACanvas, {$ENDIF} ClientRect, Bmp, ClientRect, clFuchsia); finally Bmp.Free; end; end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} {$ENDIF USEJVCL} end.