{----------------------------------------------------------------------------- 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: JvgProgress.PAS, released on 2003-01-15. The Initial Developer of the Original Code is Andrey V. Chudin, [chudin att yandex dott ru] Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin. All Rights Reserved. Contributor(s): Michael Beck [mbeck att bigfoot dott com]. 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: -----------------------------------------------------------------------------} // $Id: JvgProgress.pas 10612 2006-05-19 19:04:09Z jfudickar $ unit JvgProgress; {$I jvcl.inc} interface uses {$IFDEF USEJVCL} {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} {$ENDIF USEJVCL} Windows, Messages, Classes, Controls, Graphics, SysUtils, ExtCtrls, ImgList, {$IFDEF USEJVCL} JvComponent, JvThemes, {$ENDIF USEJVCL} JvgTypes, JvgCommClasses, JvgUtils, JvExControls; type {$IFDEF USEJVCL} TJvgProgress = class(TJvGraphicControl, IJvDenySubClassing) {$ELSE} TJvgProgress = class(TGraphicControl) {$ENDIF USEJVCL} private FBevelInner: TPanelBevel; FBevelOuter: TPanelBevel; FBevelBold: Boolean; FColors: TJvgSimleLabelColors; FGradient: TJvgGradient; FGradientBack: TJvgGradient; FPercent: Integer; FCaptionAlignment: TAlignment; FCaptionDirection: TglLabelDir; FCaptionStyle: TglTextStyle; FStep: Integer; FInterspace: Integer; FOptions: TglProgressOptions; FImage: TBitmap; FBackImage: TBitmap; FNeedRebuildBackground: Boolean; procedure SetBevelInner(Value: TPanelBevel); procedure SetBevelOuter(Value: TPanelBevel); procedure SetBevelBold(Value: Boolean); procedure SetPercent(Value: Integer); procedure SetCaptionAlignment(Value: TAlignment); procedure SetCaptionDirection(Value: TglLabelDir); procedure SetCaptionStyle(Value: TglTextStyle); procedure SetStep(Value: Integer); procedure SetInterspace(Value: Integer); procedure SetOptions(Value: TglProgressOptions); procedure OnSmthChanged(Sender: TObject); protected {$IFDEF USEJVCL} procedure TextChanged; override; {$ENDIF USEJVCL} procedure Loaded; override; procedure Paint; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvLowered; property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvNone; property BevelBold: Boolean read FBevelBold write SetBevelBold default False; property Colors: TJvgSimleLabelColors read FColors write FColors; property Gradient: TJvgGradient read FGradient write FGradient; property GradientBack: TJvgGradient read FGradientBack write FGradientBack; property Percent: Integer read FPercent write SetPercent; property CaptionAlignment: TAlignment read FCaptionAlignment write SetCaptionAlignment default taLeftJustify; property CaptionDirection: TglLabelDir read FCaptionDirection write SetCaptionDirection default fldLeftRight; property CaptionStyle: TglTextStyle read FCaptionStyle write SetCaptionStyle default fstShadow; property Step: Integer read FStep write SetStep default 3; property Interspace: Integer read FInterspace write SetInterspace default 1; property Options: TglProgressOptions read FOptions write SetOptions; property Anchors; property Align; property Caption; property Color default clBlack; property DragCursor; property DragMode; property Font; property Height default 15; property ParentShowHint; property ShowHint; property Visible; property Width default 150; property OnClick; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDrag; end; {$IFDEF USEJVCL} {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvgProgress.pas $'; Revision: '$Revision: 10612 $'; Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} {$ENDIF USEJVCL} implementation {$IFDEF USEJVCL} uses JvResources; {$ENDIF USEJVCL} {$IFNDEF USEJVCL} resourcestring RsProgressCaption = 'Progress...[%d%%]'; {$ENDIF !USEJVCL} constructor TJvgProgress.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := [csOpaque, csDoubleClicks]; FColors := TJvgSimleLabelColors.Create; FGradientBack := TJvgGradient.Create; FGradient := TJvgGradient.Create; if csDesigning in ComponentState then with FColors do begin FGradient.Orientation := fgdVertical; FGradientBack.Orientation := fgdVertical; FGradient.Active := True; FGradientBack.Active := True; FGradient.FromColor := clGreen; FGradient.ToColor := clYellow; FGradientBack.FromColor := 0; FGradientBack.ToColor := clGreen; FGradient.PercentFilling := FPercent; Delineate := clGray; Shadow := 0; Background := 0; Caption := RsProgressCaption; end; FColors.OnChanged := OnSmthChanged; FGradientBack.OnChanged := OnSmthChanged; FGradient.OnChanged := OnSmthChanged; FImage := TBitmap.Create; FBackImage := TBitmap.Create; Width := 150; Height := 15; FCaptionDirection := fldLeftRight; FCaptionAlignment := taLeftJustify; FStep := 3; FInterspace := 1; FCaptionStyle := fstShadow; FCaptionAlignment := taCenter; Font.Color := clWhite; FBevelInner := bvLowered; FBevelOuter := bvNone; Color := clBlack; end; destructor TJvgProgress.Destroy; begin FGradient.Free; FGradientBack.Free; FColors.Free; FBackImage.Free; FImage.Free; inherited Destroy; end; procedure TJvgProgress.Loaded; begin inherited Loaded; { FImage.Width := Width; FImage.Height := Height; FBackImage.Width := Width; FBackImage.Height := Height; if fpoTransparent in Options then GetParentImageRect(Self, Bounds(Left, Top, Width, Height), FImage.Canvas.Handle );} end; {$IFDEF USEJVCL} procedure TJvgProgress.TextChanged; begin Repaint; end; {$ENDIF USEJVCL} procedure TJvgProgress.Paint; const ShadowDepth = 2; var R: TRect; I, X, X2, Y: Integer; Size, TextSize: TSize; Capt: string; begin if (FImage.Width <> Width) or (FImage.Height <> Height) then begin FImage.Width := Width; FImage.Height := Height; FBackImage.Width := Width; FBackImage.Height := Height; FNeedRebuildBackground := True; end; R := ClientRect; if (fpoTransparent in Options) and FNeedRebuildBackground then begin (*{$IFDEF JVCLThemesEnabled} if ThemeServices.ThemesEnabled then PerformEraseBackground(Self, FBackImage.Canvas.Handle) else {$ENDIF JVCLThemesEnabled} GetParentImageRect(Self, Bounds(Left, Top, Width, Height), FBackImage.Canvas.Handle);*) FBackImage.Canvas.Brush.Color := Parent.Brush.Color; FBackImage.Canvas.FillRect(R); FNeedRebuildBackground := False; end; BitBlt(FImage.Canvas.Handle, 0, 0, Width, Height, FBackImage.Canvas.Handle, 0, 0, SRCCOPY); with FImage.Canvas do begin Dec(R.Bottom); Dec(R.Right); R := DrawBoxEx(Handle, R, [fsdLeft, fsdTop, fsdRight, fsdBottom], FBevelInner, FBevelOuter, FBevelBold, Colors.Background, fpoTransparent in Options); // PercentWidth := Round(Width * Percent / 100); // PercentWidth := Width; Brush.Color := Colors.Background; Inc(R.Top); if Percent > 0 then begin GradientBox(Handle, R, FGradientBack, Integer(psSolid), 1); GradientBox(Handle, R, FGradient, Integer(psSolid), 1); X := R.Left; if not (fpoTransparent in Options) then for I := R.Left to Width div (FStep + FInterspace) + 1 do begin X2 := X + FInterspace; if X2 > R.Right then if X < R.Right then X2 := R.Right else Break; FillRect(Rect(X, R.Top, X2, R.Bottom)); Inc(X, FStep + FInterspace); end; end; //...CALC POSITION try Capt := Format(Caption, [Percent]); except Capt := Caption; end; GetTextExtentPoint32(Self.Canvas.Handle, PChar(Capt), Length(Capt), Size); X := 2; Y := 0; // Size.cx:=Size.cx+2+trunc(Size.cx*0.01); // Size.cy := Size.cy+2; TextSize := Size; if (FCaptionStyle = fstShadow) or (FCaptionStyle = fstVolumetric) then begin Inc(Size.cy, ShadowDepth); Inc(Size.cx, ShadowDepth); end; if fpoDelineatedText in FOptions then begin Inc(Size.cy, 2); Inc(Size.cx, 2); end; case FCaptionDirection of fldLeftRight: begin case FCaptionAlignment of taCenter: X := (Width - Size.cx) div 2; taRightJustify: X := Width - Size.cx; end; Y := (Height - Size.cy) div 2; end; fldRightLeft: begin case FCaptionAlignment of taCenter: X := (Width + Size.cx) div 2; taLeftJustify: X := Width - (Size.cx - TextSize.cx) - 2; else X := TextSize.cx; end; Y := TextSize.cy; end; fldDownUp: case FCaptionAlignment of taCenter: Y := (Height + TextSize.cx - (Size.cy - TextSize.cy)) div 2; taRightJustify: Y := TextSize.cx - 4; else Y := Height - (Size.cy - TextSize.cy) - 2; end; fldUpDown: begin case FCaptionAlignment of taCenter: Y := (Height - Size.cx) div 2; taRightJustify: Y := Height - Size.cx; else Y := 1; end; X := TextSize.cy; end; end; //...CALC POSITION end ExtTextOutExt(Handle, X, Y, GetClientRect, Capt, FCaptionStyle, fpoDelineatedText in FOptions, False, Self.Font.Color, FColors.Delineate, FColors.Highlight, FColors.Shadow, nil, nil, Self.Font); end; FImage.Transparent := fpoTransparent in FOptions; FImage.TransparentColor := Parent.Brush.Color; Canvas.Draw(0, 0, FImage); {$IFDEF JVCLThemesEnabled} if BevelBold and ((BevelInner <> bvNone) or (BevelOuter <> bvNone)) and ThemeServices.ThemesEnabled then DrawThemedBorder(Self); {$ENDIF JVCLThemesEnabled} end; procedure TJvgProgress.OnSmthChanged(Sender: TObject); begin Repaint; end; procedure TJvgProgress.SetBevelOuter(Value: TPanelBevel); begin FBevelOuter := Value; Repaint; end; procedure TJvgProgress.SetBevelInner(Value: TPanelBevel); begin FBevelInner := Value; Invalidate; end; procedure TJvgProgress.SetBevelBold(Value: Boolean); begin FBevelBold := Value; Repaint; end; procedure TJvgProgress.SetPercent(Value: Integer); begin if (FPercent <> Value) and (Value >= 0) and (Value <= 100) then begin FPercent := Value; FGradient.PercentFilling := FPercent; end; end; procedure TJvgProgress.SetCaptionAlignment(Value: TAlignment); begin if FCaptionAlignment <> Value then begin FCaptionAlignment := Value; Repaint; end; end; procedure TJvgProgress.SetCaptionDirection(Value: TglLabelDir); begin if FCaptionDirection <> Value then begin FCaptionDirection := Value; Repaint; end; end; procedure TJvgProgress.SetCaptionStyle(Value: TglTextStyle); begin if FCaptionStyle <> Value then begin FCaptionStyle := Value; Repaint; end; end; procedure TJvgProgress.SetStep(Value: Integer); begin if FStep <> Value then begin FStep := Value; Repaint; end; end; procedure TJvgProgress.SetInterspace(Value: Integer); begin if FInterspace <> Value then begin FInterspace := Value; Repaint; end; end; procedure TJvgProgress.SetOptions(Value: TglProgressOptions); begin FOptions := Value; if fpoTransparent in FOptions then begin ControlStyle := ControlStyle - [csOpaque]; {$IFDEF USEJVCL} IncludeThemeStyle(Self, [csParentBackground]); {$ENDIF USEJVCL} end else begin ControlStyle := ControlStyle + [csOpaque]; {$IFDEF USEJVCL} ExcludeThemeStyle(Self, [csParentBackground]); {$ENDIF USEJVCL} end; Repaint; end; {$IFDEF USEJVCL} {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} {$ENDIF USEJVCL} end.