如何制作滚动条(100分)

  • 主题发起人 主题发起人 tmnet
  • 开始时间 开始时间
T

tmnet

Unregistered / Unconfirmed
GUEST, unregistred user!
我想在窗体上自己绘制一个滚动条,而不要使用WINDOWS自己带的难看的滚动条,
请问,该如何用代码实现。(即:如何捕获鼠标,如何产生一系列的MOUSEDOWN事件)
 
有必要吗?什么事都你做,oop做什么?个人认为
 
滚动条其实就是一个窗口,你只要截获WM_MouseDown,WM_MouseUP等事件,判断鼠标的位置
就可以处理了。自定义滚动条在DOS的图形编程经常用到,如果你到图书馆找,说不定还
能找到介绍这方面的书(一般都有源程序,C写的)
 
写游戏时用得到,游戏一般都要自己弄一个GUI出来。
 
{*******************************************************}
{ }
{ 滚动条 }
{ 作者:antic_ant }
{ E-mail:antic_ant@hotmail.com }
{ http://antic_ant.delphibbs.com }
{ 日期:2002-06-17 }
{ }
{ }
{*******************************************************}
unit psiProgressBar;
interface
uses
Graphics, Controls, Classes, SysUtils, Forms;
type
TpsiProgressBar = class(TGraphicControl)
private
FCaptionPanelWidth: Integer;
FColor3DHighlight: TColor;
FColor3DShadow: TColor;
FColorBack: TColor;
FColorBar: TColor;
FFontCaption: TFont;
FLastProgress: integer;
FNumDone: integer;
FNumTodo: integer;
FProgress: integer;
FOnPaint: TNotifyEvent;
procedure PaintMainPanel;
procedure PaintCaption;
procedure PaintProgressBar;
procedure SetColor3DHighlight(Value: TColor);
procedure SetColor3DShadow(Value: TColor);
procedure SetColorBack(Value: TColor);
procedure SetColorBar(Value: TColor);
procedure SetFontCaption(Value: TFont);
procedure SetNumDone(Value: integer);
procedure SetNumTodo(Value: integer);
procedure SetProgress(Value: integer);
property CaptionPanelWidth: Integer read FCaptionPanelWidth write FCaptionPanelWidth;
property LastProgress: integer read FLastProgress write FLastProgress;
protected
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
property Canvas;
published
property Color3DHighlight: TColor read FColor3DHighlight write SetColor3DHighlight;
property Color3DShadow: TColor read FColor3DShadow write SetColor3DShadow;
property ColorBack: TColor read FColorBack write SetColorBack;
property ColorBar: TColor read FColorBar write SetColorBar;
property FontCaption: TFont read FFontCaption write SetFontCaption;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
property NumDone: integer read FNumDone write SetNumDone;
property NumTodo: integer read FNumTodo write SetNumTodo;
property Progress: integer read FProgress write SetProgress;
property Visible;
end;

procedure Register;
implementation
procedure Register;
begin
RegisterComponents('syz_component', [TpsiProgressBar]);
end;

constructor TpsiProgressBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
CaptionPanelWidth := 0;
Canvas.Font.Color := clBlack;
Canvas.Font.Height := -11;
Canvas.Font.Name := 'Arial';
Canvas.Font.Pitch := fpDefault;
Canvas.Font.Size := 8;
Canvas.Font.Style := [fsBold];
Color3DHighlight := clWhite;
Color3DShadow := clGray;
ColorBack := clSilver;
ColorBar := clNavy;
Cursor := crHourGlass;
FFontCaption := TFont.Create;
with FFontCaptiondo
begin
Color := clBlack;
Height := -11;
Name := 'Arial';
Pitch := fpDefault;
Size := 8;
Style := [fsBold];
end;
SetFontCaption(FFontCaption);
Height := 21;
NumDone := 0;
NumTodo := 0;
Progress := 0;
Visible := True;
Width := 261;
end;

destructor TpsiProgressBar.Destroy;
begin
inherited Destroy;
end;

procedure TpsiProgressBar.Paint;
begin
Canvas.Font.Color := FFontCaption.Color;
Canvas.Font.Height := FFontCaption.Height;
Canvas.Font.Name := FFontCaption.Name;
Canvas.Font.Pitch := FFontCaption.Pitch;
Canvas.Font.Size := FFontCaption.Size;
Canvas.Font.Style := FFontCaption.Style;
Self.Height := ((-Self.FontCaption.Height) + 10);
Self.CaptionPanelWidth := Self.Canvas.TextWidth('100%') + 11;
if Self.Width < Self.CaptionPanelWidth + (Self.Height * 2) then
Self.Width := Self.CaptionPanelWidth + (Self.Height * 2);
PaintMainPanel;
PaintCaption;
PaintProgressBar;
end;

procedure TpsiProgressBar.PaintMainPanel;
var
InPen: TPen;
InBrush: TBrush;
begin
with Self.Canvas as TCanvasdo
begin
InPen := Pen;
InBrush := Brush;
Brush.Color := ColorBack;
Brush.Style := bsSolid;
Pen.Color := Color3DShadow;
Pen.Width := 1;
Rectangle(0, 0, Width, Height);
Pen.Color := Color3DHighlight;
MoveTo(0, 0);
LineTo(0, Height);
MoveTo(0, 0);
LineTo(Width, 0);
Pen := InPen;
Brush := InBrush;
end;
end;

procedure TpsiProgressBar.PaintCaption;
var
InPen: TPen;
InBrush: TBrush;
s: string;
begin
InPen := Canvas.Pen;
InBrush := Canvas.Brush;
with Self.Canvas as TCanvasdo
begin
Pen.Color := ColorBack;
Brush.Color := ColorBack;
Brush.Style := bsSolid;
Rectangle(2, 2, CaptionPanelWidth, Height - 3);
Pen.Color := ColorBack;
Brush.Color := ColorBack;
Canvas.Font.Color := FontCaption.Color;
Canvas.Font.Height := FontCaption.Height;
Canvas.Font.Name := FontCaption.Name;
Canvas.Font.Pitch := FontCaption.Pitch;
Canvas.Font.Size := FontCaption.Size;
Canvas.Font.Style := FontCaption.Style;
s := IntToStr(Progress) + '%';
TextOut((CaptionPanelWidth - TextWidth(s) - 3), 3, s);
Pen.Color := Color3DShadow;
MoveTo(2, 2);
LineTo(CaptionPanelWidth, 2);
MoveTo(2, 2);
LineTo(2, Height - 3);
Pen.Color := Color3DHighlight;
MoveTo(CaptionPanelWidth, Height - 3);
LineTo(CaptionPanelWidth, 2);
MoveTo(CaptionPanelWidth, Height - 3);
LineTo(2, Height - 3);
end;
Canvas.Pen := InPen;
Canvas.Brush := InBrush;
end;

procedure TpsiProgressBar.PaintProgressBar;
var
InPen: TPen;
InBrush: TBrush;
TotBarWidth: Integer;
NumElements: LongInt;
PercentPerElement:do
uble;
NumToPaint: LongInt;
Painted: Integer;
ElementPoint: LongInt;
TotElementWidth: Integer;
ElementWidth: Integer;
begin
with Self.Canvas as TCanvasdo
begin
InPen := Pen;
InBrush := Brush;
if (Progress = 0) or (Progress < LastProgress)
or (csDesigning in ComponentState) then
begin
Brush.Color := ColorBack;
Brush.Style := bsSolid;
Rectangle(CaptionPanelWidth + 3, 2, Width - 2, Height - 2);
end;

Pen.Color := Color3DShadow;
MoveTo(CaptionPanelWidth + 3, 2);
LineTo(Width - 3, 2);
MoveTo(CaptionPanelWidth + 3, 2);
LineTo(CaptionPanelWidth + 3, Height - 3);
Pen.Color := Color3DHighlight;
MoveTo(Width - 3, Height - 3);
LineTo(Width - 3, 2);
MoveTo(Width - 3, Height - 3);
LineTo(CaptionPanelWidth + 3, Height - 3);
ElementWidth := Round(((Height - 9) / 3) * 2);
TotBarWidth := Width - CaptionPanelWidth - 9;
NumElements := Trunc((TotBarWidth - 4) / (ElementWidth + 2));
PercentPerElement := 100 / NumElements;
NumToPaint := Round(Progress / PercentPerElement);
if NumToPaint > NumElements then
NumToPaint := NumElements;
TotElementWidth := (NumElements * (ElementWidth + 2)) - 2;
ElementPoint := (CaptionPanelWidth + 5) + Trunc((TotBarWidth -
TotElementWidth) / 2);
if NumToPaint > 0 then
begin
Brush.Color := ColorBar;
Brush.Style := bsSolid;
Pen.Color := ColorBar;
Pen.Width := 1;
for Painted := 1 to NumToPaintdo
begin
Rectangle(ElementPoint, 4, ElementPoint + ElementWidth, Height - 4);
ElementPoint := ElementPoint + ElementWidth + 2;
end;
end;
Pen := InPen;
Brush := InBrush;
end;
end;

procedure TpsiProgressBar.SetNumDone(Value: Integer);
begin
if Value < 0 then
Value := 0;
if Value > 100 then
Value := 100;
FNumDone := Value;
if NumTodo > 0 then
Progress := Round((FNumDone / NumTodo) * 100);
end;

procedure TpsiProgressBar.SetNumTodo(Value: Integer);
begin
if Value < 0 then
Value := 0;
if Value > 100 then
Value := 100;
FNumTodo := Value;
if FNumTodo > 0 then
Progress := Round((NumDone / FNumTodo) * 100);
end;

procedure TpsiProgressBar.SetProgress(Value: Integer);
begin
LastProgress := Progress;
if Value < 0 then
Value := 0;
if Value > 100 then
Value := 100;
FProgress := Value;
if (GetParentForm(Self) <> nil) and (Visible = True) then
begin
PaintCaption;
PaintProgressBar;
end;
end;

procedure TpsiProgressBar.SetColor3DHighlight(Value: TColor);
begin
FColor3DHighlight := Value;
if Visible = True then
Self.Repaint;
end;

procedure TpsiProgressBar.SetColor3DShadow(Value: TColor);
begin
FColor3DShadow := Value;
if Visible = True then
Self.Repaint;
end;

procedure TpsiProgressBar.SetColorBack(Value: TColor);
begin
FColorBack := Value;
if Visible = True then
Self.Repaint;
end;

procedure TpsiProgressBar.SetColorBar(Value: TColor);
begin
FColorBar := Value;
if Visible = True then
Self.Repaint;
end;

procedure TpsiProgressBar.SetFontCaption(Value: TFont);
begin
with FFontCaptiondo
begin
Color := Value.Color;
Height := Value.Height;
Name := Value.Name;
Pitch := Value.Pitch;
Size := Value.Size;
Style := Value.Style;
end;
if Visible = True then
self.refresh;
end;

end.

 
可视化控件(VisualComponent)实际上就是一个类(class),要编写一个类,可以直接在*.pas文件中编写。但是要编写控件,则必须使用包(package)。从File菜单中选择New,新建一个Package,这就是存放和安装控件用的包。然后单击Package窗口中的Add按钮,添加一个元件(Unit)。
  在弹出的对话框最上方选择NewComponent。因为一个控件的所有属性、方法、事件不可能都由自己编,所以就需要选择祖先类(或者叫做"父类"或"基类"),然后再在其上面添加自己的属性、方法、事件。在Ancestortype后的下拉框中选择所需的祖先类。由于编写可视化控件必须要画图,所以选择TGraphicControl作为祖先类。再在ClassName框中输入新控件(类)的名称,一般以"T"开头。PalettePage是用来选择新控件在Delphi的窗口中的控件页面名称,例如"Standard",这个可以自己取。在UnitFileName中添好新控件文件的路径及文件名,单击OK按钮。新的控件便加入了。现在可以为该控件编写代码了。
  下面以编写一个可以自定义图片的滚动条为例,说明编写可视化控件的方法。
  按照上面的方法,选择TGraphicControl为祖先类,新控件的名称是TPigHorizontalScroller(小猪水平滚动条)。选择好文件路径和文件名后,单击OK按钮,开始编写代码。
  每一个控件,都会被创建(Create)和删除(Destroy),所以必须首先编写这两个过程。对于控件中的每一个过程,都必须在前面先定义,然后再在后面编写。定义的过程或属性有三种:一、在private后定义的是属于控件内部使用的,使用该控件的人无法看到;二、在protected后定义的一般是看不到的,只在别人使用该控件作为祖先类编写其它控件时才可见;三、在public后定义的只允许别人在程序中调用;四、在published后定义的可以在属性窗口(ObjectInspector)中看到。由于创建和删除过程除了在编程过程中建立控件时自动执行外,还可能在程序运行过程中动态创建控件时被调用,所以把它定义在public后⑴。(该序号表示次步骤在所附源程序中的代码的位置,下同)现在也许还不知到应该在这两个过程中编写什么,如何去编。我们在下面将会讲到。
  我们首先为这个控件添加一些属性。我们定义一个Max属性用于设置或读取滚动条的最大值。因为在程序中一般不直接使用属性,所以要定义一个变量,和该属性对应起来,一边修改或读取其值。因为它只在控件内部使用,所以我们把它定义在private后⑵。(一般与属性相关联的变量都以"F"开头,例如FMax)定义好变量后,再定义属性。这个属性需要再ObjectInspector窗口中可见,所以把它定义再published后⑶。定义的语法是:
  property<属性名>:<类型>read<读取该属性时对应的变量>write<写入该属性时对应的变量或过程>
  其它的变量和属性也类似的定义(例如Min最小值、Value当前值等)。下面我们定义几个属性和变量,用于设置滚动条的图片(因为图片变量比较特殊,所以单独讲一下)。我们把LeftButtonUpPicture(向左按钮图片)、LeftButtonDownPicture(向左按钮按下图片)等定义为TBitmap类型(一定要定义相对应的变量)。
  大家一定注意到了,在所附的源程序中,定义这几个属性时,read后所指定的读取属性时对应的变量是F…,而write后指定的写入该属性时对应的不是一个变量,而是一个Set…之类的东西,这是一个自定义的过程。作为该功能的过程的定义为:
  procedure<过程名>(Value:<被设置的属性的值的类型>)
  因为执行写入该类属性的时候需要做其它的事情,所以不能光用一个变量来处理,应该用一个过程来处理。这中过程一般定义在protected后。在该类过程中,使用一个在⑷处这样一个语句来给TBitmap类型的变量来赋值,这是由于该类型的变量不能直接赋值而采用的。
  定义完这些TBitmap类型的变量的属性后,上面讲的create过程和destroy过程中就需要编写代码了。因为TBitmap也是一个类,所以在create过程中必须创建⑸,在destroy过程中必须释放掉(free)⑹。这里⑺所指的inherited语句是用于指明该过程是从祖先类类中继承来的。(这个一定不能掉)。
  因为我们编写的是可视化控件,所以必须在控件上画图。我们这个控件的祖先类TGraphicControl中封装有一个Canvas(画布)对象,我们可以直接使用它来画图。如果你对画布的使用还不太熟悉,最好去找一本书来看一看。
  下面要做的工作就是画图了。如何在控件上画图呢?祖先类TGraphicControl中有一个Paint事件,当控件需要重画时便会自动触发。我们现在要做的就是要为这个事件编写一段程序。首先在protected后定义一个Canvas对象。由于它是祖先类中已有的,所以不需要加任何说明⑻。我们将使用这个对象来画图。接着,就要定义一个Paint过程,编写绘制控件的代码。先在public后定义Paint过程。由于它是由祖先类触发的,而不是由用户调用的,所以后面必须加上override,否则,该控件将会由于Paint过程永远不会被调用而不成为可视化控件⑼。下面我们就来编写Paint过程的代码⑽。
  该文章所附的源程序的Paint过程中的T_Height等变量是用来保存滚动条中按钮、滑块等的大小的,这部分程序和普通的Application中的程序差别不大,大部分都是对画布进行操作,相信大家一看就明白。值得注意的是下面对FAutoSize变量的判断⑾,FAutoSize是和该控件的属性AutoSize相关联的布尔型变量,是用来设置这个控件的大小是否随图片的大小而变化的。注意,在控件的代码中,一般都不直接调用属性,而是使用与其相对应的的变量。
  程序编到这里,就算是终于给自己的新控件做了一个外型了,不过它还不能滚动。现在我们来编写鼠标事件,让我们能够操纵它。鼠标事件的过程的定义和Paint过程很相似,只是后面要加上参数说明⑿,鼠标事件分为MouseDown、MouseMove和MouseUp三个,在定义后面都要加上override。接下来在后面编写它的代码。注意:这里的鼠标事件是Mouse…,而不是通常的OnMouse…。可是在⒀处的定义是干什么用的呢?这里的事件定义,都是给用户使用的,也就是说,当使用该控件时,会在ObjectInspector中的Event页面中显示出来。
  这些鼠标事件的代码也非常简单,判断鼠标的坐标,在画布上画出相应的图片等,并同时触发相应的事件。值得注意的是,在调用自定义事件时,都要先用⒁处的这样一个语句来判断用户是否已经为该事件编写代码。这一点非常重要,否则会调用出错。
  大家注意到了,刚才所调用的事件都是自定义的,定义的方法也很简单,和定义属性差不多,只是类型时TNotifyEvent罢了。     
  TNotifyEvent是默认事件,其定义为:
  TNotifyEvent=procedure(Sender:TObject)
  如果你要定义另外形式的事件,就必须这样:先在type后编写
  <事件类型名称>=procedure(<参数>:<类型>)
例如:
  TCustomEvent=procedure(a:Integer;b:String);
然后在public后定义:
  <事件名称>:<事件类型名称>
例如:
  AnEvent:TCustomEvent;
  看完这些,这整个程序你应该理解了吧。如果编译或运行出错,注意检查以下几点:
   1、create和destroy过程中是否有inherited语句;
    2、TBitmap类型的变量create和free了没有;
    3、过程前有没有控件名,例如:TPigHorizontalScroller.MoseMove
  判断鼠标是否进入或离开控件的方法:
定义如下的过程:
  procedureMouseEnter(varMsg:TMessage);messageCM_MOUSEENTER;
  procedureMouseLeave(varMsg:TMessage);messageCM_MOUSELEAVE;
  再在下面编写代码就行了
 
随便找一个什么控件 如Tbotton 在放一个滚动条 不可见
当Tbutton的left 或top变动时 滚动条跟着变。。。
这样可以实现任何你想要的滚动条。。。。。
甚至可以用TMediaPlayer哈哈哈
 
我有windows优化大师的全部控件,包括好看的滚动条,你要吗?
 
to rainsea :
能否把你的控件发给我一份:wb_l@eyou.com,qq:19713179,多谢.
 
能否发给我一份:moumoumou@sina.com
 
Windows优化大师的界面就是用 FlatStyle
www.flatstyle2k.net
 
我有一个很好的滚行条控件叫 zoomler,事件处理都写好了,我就改过成我自己想要的风格.
 
后退
顶部