percnt3d.pas

有3D效果的进度条 。 developed by delphi

// The Unofficial Newsletter of Delphi Users - Issue #12 - February 23rd, 1996 

unit Percnt3d;

(*

   TPercnt3D by Lars Posthuma; December 26, 1995.

   Copyright 1995, Lars Posthuma.

   All rights reserved.



   This source code may be freely distributed and used. The author

   accepts no responsibility for its use or misuse.

   No warranties whatsoever are offered for this unit.



   If you make any changes to this source code please inform me at:

   [e-mail].

*)



interface



uses

  WinTypes, WinProcs, Classes, Graphics, Controls, ExtCtrls, Forms, SysUtils, Dialogs;



type

  TPercnt3DOrientation = (BarHorizontal,BarVertical);



  TPercnt3D = class(TCustomPanel)

    private

      { Private declarations }

      fProgress    : Integer;

      fMinValue    : Integer;

      fMaxValue    : Integer;

      fShowText    : Boolean;



      fOrientation : TPercnt3DOrientation;

      fHeight      : Integer;

      fWidth       : Integer;

      fValueChange : TNotifyEvent;



      procedure SetBounds(Left,Top,fWidth,fHeight: integer); override;

      procedure SetHeight(value: Integer); virtual;

      procedure SetWidth(value: Integer); virtual;



      procedure SetMaxValue(value: Integer); virtual;

      procedure SetMinValue(value: Integer); virtual;

      procedure SetProgress(value: Integer); virtual;

      procedure SetOrientation(value: TPercnt3DOrientation);

      procedure SetShowText(value: Boolean);

      function GetPercentDone: Longint;

    protected

      { Protected declarations }

      procedure Paint; override;

    public

      { Public declarations }

      constructor Create(AOwner: TComponent); override;

      destructor Destroy; override;

      procedure AddProgress(Value: Integer);

      property PercentDone: Longint read GetPercentDone;

      procedure SetMinMaxValue(Minvalue,MaxValue: Integer);

    published

      { Published declarations }

      property Align;

      property Cursor;

      property Color default clBtnFace;

      property Enabled;

      property Font;

      property Height default 25;

      property Width default 100;

      property MaxValue: Integer

               read fMaxValue write SetMaxValue

               default 100;

      property MinValue: Integer

               read fMinValue write SetMinValue

               default 0;

      property Progress: Integer

               read fProgress write SetProgress

               default 0;

      property ShowText: Boolean

               read fShowText write SetShowText

               default True;

      property Orientation: TPercnt3DOrientation             {}

               read fOrientation write SetOrientation

               default BarHorizontal;

      property OnValueChange: TNotifyEvent                   {Userdefined Method}

               read fValueChange write fValueChange;

      property Visible;

      property Hint;

      property ParentColor;

      property ParentFont;

      property ParentShowHint;

      property ShowHint;

      property Tag;



      property OnClick;

      property OnDragDrop;

      property OnDragOver;

      property OnEndDrag;

      property OnMouseDown;

      property OnMouseMove;

      property OnMouseUp;

  end;



procedure Register;



implementation



constructor TPercnt3D.Create(AOwner: TComponent);

begin

 inherited Create(AOwner);

 Color       := clBtnFace;                       {Set initial (default) values}

 Height      := 25;

 Width       := 100;

 fOrientation := BarHorizontal;

 Font.Color  := clBlue;

 Caption     := ' ';

 fMinValue   := 0;

 fMaxValue   := 100;

 fProgress   := 0;

 fShowText   := True;

end;



destructor TPercnt3D.Destroy;

begin

 inherited Destroy

end;



procedure TPercnt3D.SetHeight(value: integer);

begin

 if value <> fHeight then begin

   fHeight:= value;

   SetBounds(Left,Top,Width,fHeight);

   Invalidate;

 end

end;



procedure TPercnt3D.SetWidth(value: integer);

begin

 if value <> fWidth then begin

   fWidth:= value;

   SetBounds(Left,Top,fWidth,Height);

   Invalidate;

 end

end;



procedure TPercnt3D.SetBounds(Left,Top,fWidth,fHeight : integer);

 Procedure SwapWH(Var Width, Height: Integer);

 Var

  TmpInt: Integer;

 begin

  TmpInt:= Width;

  Width := Height;

  Height:= TmpInt;

 end;

 Procedure SetMinDims(Var XValue,YValue: Integer; XValueMin,YValueMin: Integer);

 begin

  if XValue < XValueMin

   then XValue:= XValueMin;

  if YValue < YValueMin

   then YValue:= YValueMin;

 end;

begin

 case fOrientation of

   BarHorizontal: begin

                   if fHeight > fWidth

                     then SwapWH(fWidth,fHeight);

                   SetMinDims(fWidth,fHeight,50,20);

                  end;

   BarVertical  : begin

                   if fWidth > fHeight

                     then SwapWH(fWidth,fHeight);

                   SetMinDims(fWidth,fHeight,20,50);

                  end;

 end;

 inherited SetBounds(Left,Top,fWidth,fHeight);

end;



procedure TPercnt3D.SetOrientation(value : TPercnt3DOrientation);

Var

 x: Integer;

begin

 if value <> fOrientation then begin

   fOrientation:= value;

   SetBounds(Left,Top,Height,Width);                       {Swap Width/Height}

   Invalidate;

 end

end;



procedure TPercnt3D.SetMaxValue(value: integer);

begin

 if value <> fMaxValue then begin

   fMaxValue:= value;

   Invalidate;

 end

end;



procedure TPercnt3D.SetMinValue(value: integer);

begin

 if value <> fMinValue then begin

   fMinValue:= value;

   Invalidate;

 end

end;



procedure TPercnt3D.SetMinMaxValue(MinValue, MaxValue: integer);

begin

 fMinValue:= MinValue;

 fMaxValue:= MaxValue;

 fProgress:= 0;

 Repaint;                                        { Always Repaint }

end;



{ This function solves for x in the equation &quotx is y% of z". }

function SolveForX(Y, Z: Longint): Integer;

begin

 SolveForX:= Trunc( Z * (Y * 0.01) );

end;



{ This function solves for y in the equation &quotx is y% of z". }

function SolveForY(X, Z: Longint): Integer;

begin

 if Z = 0

   then SolveForY:= 0

   else SolveForY:= Trunc( (X * 100) / Z );

end;





function TPercnt3D.GetPercentDone: Longint;

begin

 GetPercentDone:= SolveForY(fProgress - fMinValue, fMaxValue - fMinValue);

end;



procedure TPercnt3D.Paint;

var

 TheImage: TBitmap;

 FillSize: Longint;

 W,H,X,Y : Integer;

 TheText : string;

begin

 with Canvas do begin

   TheImage:= TBitmap.Create;

   try

     TheImage.Height:= Height;

     TheImage.Width := Width;

     with TheImage.Canvas do begin

       Brush.Color:= Color;

       with ClientRect do begin

         { Paint the background }

         { Select Black Pen to outline Window }

         Pen.Style:= psSolid;

         Pen.Width:= 1;

         Pen.Color:= clBlack;



         { Bounding rectangle in black }

         Rectangle(Left,Top,Right,Bottom);



         { Draw the inner bevel }

         Pen.Color:= clGray;

         Rectangle(Left + 3, Top + 3, Right - 3, Bottom - 3);

         Pen.Color:= clWhite;

         MoveTo(Left + 4, Bottom - 4);

         LineTo(Right - 4, Bottom - 4);

         LineTo(Right - 4, Top + 2);



         { Draw the 3D Percent stuff }

         { Outline the Percent Bar in black }

         Pen.Color:= clBlack;

         if Orientation = BarHorizontal

           then w:= Right - Left { + 1; }

           else w:= Bottom - Top;

         FillSize:= SolveForX(PercentDone, W);

         if FillSize > 0 then begin

           case orientation of

            BarHorizontal: begin

                            Rectangle(Left,Top,FillSize,Bottom);



                            { Draw the 3D Percent stuff }

                            { UpperRight, LowerRight, LowerLeft }

                            Pen.Color:= clGray;

                            Pen.Width:= 2;

                            MoveTo(FillSize - 2, Top + 2);

                            LineTo(FillSize - 2, Bottom - 2);

                            LineTo(Left + 2, Bottom - 2);



                            { LowerLeft, UpperLeft, UpperRight }

                            Pen.Color:= clWhite;

                            Pen.Width:= 1;

                            MoveTo(Left + 1, Bottom - 3);

                            LineTo(Left + 1, Top + 1);

                            LineTo(FillSize - 2, Top + 1);

                           end;

            BarVertical:   begin

                            FillSize:= Height - FillSize;

                            Rectangle(Left,FillSize,Right,Bottom);



                            { Draw the 3D Percent stuff }

                            { LowerLeft, UpperLeft, UpperRight }

                            Pen.Color:= clGray;

                            Pen.Width:= 2;

                            MoveTo(Left + 2, FillSize + 2);

                            LineTo(Right - 2, FillSize + 2);

                            LineTo(Right - 2, Bottom - 2);



                            { UpperRight, LowerRight, LowerLeft }

                            Pen.Color:= clWhite;

                            Pen.Width:= 1;

                            MoveTo(Left + 1,FillSize + 2);

                            LineTo(Left + 1,Bottom - 2);

                            LineTo(Right - 2,Bottom - 2);

                           end;

           end;

         end;

         if ShowText = True then begin

           Brush.Style:= bsClear;

           Font       := Self.Font;

           Font.Color := Self.Font.Color;

           TheText:= Format('%d%%', [PercentDone]);

           X:= (Right - Left + 1 - TextWidth(TheText)) div 2;

           Y:= (Bottom - Top + 1 - TextHeight(TheText)) div 2;

           TextRect(ClientRect, X, Y, TheText);

         end;

       end;

     end;

     Canvas.CopyMode:= cmSrcCopy;

     Canvas.Draw(0,0,TheImage);

     finally

       TheImage.Destroy;

   end;

 end;

end;



procedure TPercnt3D.SetProgress(value: Integer);

begin

 if (fProgress <> value) and (value >= fMinValue) and (value <= fMaxValue) then begin

   fProgress:= value;

   Invalidate;

 end;

end;



procedure TPercnt3D.AddProgress(value: Integer);

begin

 Progress:= fProgress + value;

 Refresh;

end;



procedure TPercnt3D.SetShowText(value: Boolean);

begin

 if value <> fShowText then begin

   fShowText:= value;

   Refresh;

 end;

end;



procedure Register;

begin

 RegisterComponents('DDG', [TPercnt3D]);

end;



end.