// 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: 

   LPosthuma@COL.IB.COM. 

*) 

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 ; 

      property Width default ; 

      property MaxValue: Integer 

               read fMaxValue write SetMaxValue 

               default ; 

      property MinValue: Integer 

               read fMinValue write SetMinValue 

               default ; 

      property Progress: Integer 

               read fProgress write SetProgress 

               default ; 

      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      := ; 

 Width       := ; 

 fOrientation := BarHorizontal; 

 Font.Color  := clBlue; 

 Caption     := ' '; 

 fMinValue   := ; 

 fMaxValue   := ; 

 fProgress   := ; 

 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,,); 

                  end; 

   BarVertical  : begin 

                   if fWidth > fHeight 

                     then SwapWH(fWidth,fHeight); 

                   SetMinDims(fWidth,fHeight,,); 

                  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:= ; 

 Repaint;                                        { Always Repaint } 

end; 

{ This function solves for x in the equation "x 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 "x is y% of z". } 

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

begin 

 if Z =  

   then SolveForY:=  

   else SolveForY:= Trunc( (X * ) / 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:= ; 

         Pen.Color:= clBlack; 

         { Bounding rectangle in black } 

         Rectangle(Left,Top,Right,Bottom); 

         { Draw the inner bevel } 

         Pen.Color:= clGray; 

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

         Pen.Color:= clWhite; 

         MoveTo(Left + , Bottom - ); 

         LineTo(Right - , Bottom - ); 

         LineTo(Right - , Top + ); 

         { 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 >  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:= ; 

                            MoveTo(FillSize - , Top + ); 

                            LineTo(FillSize - , Bottom - ); 

                            LineTo(Left + , Bottom - ); 

                            { LowerLeft, UpperLeft, UpperRight } 

                            Pen.Color:= clWhite; 

                            Pen.Width:= ; 

                            MoveTo(Left + , Bottom - ); 

                            LineTo(Left + , Top + ); 

                            LineTo(FillSize - , Top + ); 

                           end; 

            BarVertical:   begin 

                            FillSize:= Height - FillSize; 

                            Rectangle(Left,FillSize,Right,Bottom); 

                            { Draw the 3D Percent stuff } 

                            { LowerLeft, UpperLeft, UpperRight } 

                            Pen.Color:= clGray; 

                            Pen.Width:= ; 

                            MoveTo(Left + , FillSize + ); 

                            LineTo(Right - , FillSize + ); 

                            LineTo(Right - , Bottom - ); 

                            { UpperRight, LowerRight, LowerLeft } 

                            Pen.Color:= clWhite; 

                            Pen.Width:= ; 

                            MoveTo(Left + ,FillSize + ); 

                            LineTo(Left + ,Bottom - ); 

                            LineTo(Right - ,Bottom - ); 

                           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 +  - TextWidth(TheText)) div ; 

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

           TextRect(ClientRect, X, Y, TheText); 

         end; 

       end; 

     end; 

     Canvas.CopyMode:= cmSrcCopy; 

     Canvas.Draw(,,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. 

有3D效果的进度条的更多相关文章

  1. 纯CSS炫酷3D旋转立方体进度条特效

    在网站制作中,提高用户体验度是一项非常重要的任务.一个创意设计不但能吸引用户的眼球,还能大大的提高用户的体验.在这篇文章中,我们将大胆的将前面所学的3D立方体和进度条结合起来,制作一款纯CSS3的3D ...

  2. [WPF]有滑动效果的进度条

    先给各位看看效果,可能不太完美,不过效果还是可行的. 我觉得,可能直接放个GIF图片上去会更好. 我这个不是用图片,而是用DrawingBrush画出来的.接着重做ProgressBar控件的模板,把 ...

  3. CSS3 中的按钮效果与进度条

    效果如图

  4. ReactJS尝鲜:实现tab页切换和菜单栏切换和手风琴切换效果,进度条效果

    前沿 对于React, 去年就有耳闻, 挺不想学的, 前端那么多东西, 学了一个框架又有新框架要学

  5. Android 三种方式实现自定义圆形页面加载中效果的进度条

    转载:http://www.eoeandroid.com/forum.php?mod=viewthread&tid=76872 一.通过动画实现 定义res/anim/loading.xml如 ...

  6. Android ProgressBar 进度条荧光效果

    http://blog.csdn.net/ywtcy/article/details/7878289 这段时间做项目,产品需求,进度条要做一个荧光效果,类似于Android4.0 浏览器中进度条那种样 ...

  7. 使用原生JS+CSS或HTML5实现简单的进度条和滑动条效果(精问)

    使用原生JS+CSS或HTML5实现简单的进度条和滑动条效果(精问) 一.总结 一句话总结:进度条动画效果用animation,自动效果用setIntelval 二.使用原生JS+CSS或HTML5实 ...

  8. BootStrap入门教程 (三) :可重用组件(按钮,导航,标签,徽章,排版,缩略图,提醒,进度条,杂项)

    上讲回顾:Bootstrap的基础CSS(Base CSS)提供了优雅,一致的多种基础Html页面要素,包括排版,表格,表单,按钮等,能够满足前端工程师的基本要素需求. Bootstrap作为完整的前 ...

  9. android圆形进度条ProgressBar颜色设置

    花样android Progressbar http://www.eoeandroid.com/thread-1081-1-1.html http://www.cnblogs.com/xirihanl ...

随机推荐

  1. windows python3 安装gittle

    1 从github clone gittle项目, git clone https://github.com/FriendCode/gittle.git 2 进行到下载的项目,执行安装 python ...

  2. bzoj1055玩具取名

    区间dp.记录可行性即可. #include<iostream> #include<cstdio> #include<cstring> using namespac ...

  3. Microsoft Dynamics CRM 2011 面向Internet部署 (IFD) CRM 登录出现会话超时的解决办法

    一.IFD 登录的时候,过了一段时间,会马上出现“您的会话已过期”,怎么解决这个问题呢,可以通过改变这个时间.具体图如二 Link to Dynamics CRM Wiki Home Page 二.S ...

  4. Android 禁止系统进入深度休眠

    在Linux系统中,wake_lock是一直锁机制,只要有驱动占用这个锁,系统就不会进入深度休眠. 获取此锁的方法有两种: 1.在adb中通过指令获取wake_lock,系统就不会进入深度休眠 ech ...

  5. ML(5):KNN算法

    K近邻算法,即K-Nearest Neighbor algorithm,简称KNN算法,可以简单的理解为由那离自己最近的K个点来投票决定待分类数据归为哪一类.这个算法是机器学习里面一个比较经典的算法, ...

  6. Delphi控件备份工具

    用途: 1.如果您需要重装Delphi,想省去重装控件的麻烦. 2.如果您把Delphi环境安装至另一台电脑上. 那么,您一定需要这个! 运行批处理后,自动在当前目录下生成备份目录. 批处理代码 @e ...

  7. 我的Quartz笔记

    代码: package com.smt.autorun; import java.io.File; import java.util.ArrayList; import java.util.Date; ...

  8. 在VS2010中配置ICE插件的步骤

    ICE为不同的IDE都提供了插件.本文介绍VS2010下的配置. 首先建立一个控制台工程,以此为例,进行介绍. 1.激活插件 选择工具-> IceConfiguration或者在工程右键选择Ic ...

  9. RmNet,CDC-ECM ,NDIS,RNDIS区别

    RmNet和CDC-ECM区别:更像是两种拨号方式的区别,RmNet获取公网IP,ECD-ECM获取局域网IP. 在高通平台上,rmnet driver 和标准的CDC-ECM是有区别的,rmnet ...

  10. SQL中select与set的区别

    转自 : http://www.cnblogs.com/4mylife/archive/2012/10/25/2738466.html 下表列出 SET 与 SELECT 的区别   SELECT S ...