您正在查看: Delphi 分类下的文章

在TListView中拖动图标

-->



实例149 在TListView中拖动图标

本实例演示如何在程序运行过程中动态拖动TListView组件中的图标。

在窗体中添加一个TImageList组件,并且为它添加3个图像文件。然后添加一个TListView组件,设置它的LargeImagesSmallImages属性为TImageList组件,为TListView组件添加3个列表项,并且设置列表项的ImageIndex属性分别对应TImageList组件中的图像索引编号。添加组件后的窗体如图8-47所示。

8-47 添加组件后的窗体

当用户在TListView组件中用鼠标左键选中一个列表项后,就通过调用BeginDrag函数进行拖动操作,响应代码如下:

procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if Button=mbleft then

begin

with Sender as TListView do

begin

if GetItemAt(X,Y)<>nil then

BeginDrag(False);

end;

end;

end;

在鼠标拖动过程中,要不停改变选中列表项的位置,代码如下:

procedure TForm1.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);

var

PosPoint:TPoint;

begin

PosPoint.x:=X;

PosPoint.y:=Y;

(Source As TListView).Selected.SetPosition(PosPoint);

end;

释放鼠标后,通过设置OnDragOver事件中的Accept参数来决定是否接受拖动操作。在本实例中如果拖动源为TListView组件,那么就设置Accept参数为True,即接受操作,响应代码如下:

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

Accept:=Source Is TListView;

end;

程序代码如下:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ImgList, ComCtrls, Menus, StdCtrls;

type

TForm1 = class(TForm)

ListView1: TListView;

ImageList1: TImageList;

procedure ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ListView1DragOver( Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);

var

PosPoint:TPoint;

begin

PosPoint.x:=x;

PosPoint.y:=Y;

(Source As TListView).Selected.SetPosition(PosPoint);

end;

procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if Button=mbleft then

begin

with Sender as TListView do

begin

if GetItemAt(X,Y)<>nil then

BeginDrag(False);

end;

end;

end;

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

Accept:=Source Is TListView;

end;

end.

保存文件,然后按F9键运行程序,程序运行的初始画面如图8-48所示。

8-48 程序运行的初始画面

TListView组件中可以动态拖动图标,程序运行的结果如图8-49所示。

8-49 程序运行结果


在组件中显示竖排的文本

-->



实例150 在组件中显示竖排的文本

本实例演示如何在程序运行过程中在TBitBtn组件和TButton组件上显示竖排的文本。

向窗体上添加一个TBitBtn组件和一个TButton组件。添加组件后的窗体如图8-50所示。

8-50 添加组件后的窗体

设置两个组件的Font属性为@System,如图8-51所示。

8-51 设置字体

添加程序初始化代码如下:

procedure TForm1.FormCreate(Sender: TObject);

begin

BitBtn1.Caption :=''+#13+''+#13+''+#13+'';

SetWindowLong(Button1.handle, GWL_STYLE,

GetWindowlong(Button1.Handle, GWL_STYLE) or

BS_MULTILINE);

Button1.Caption :=''+#13+''+#13+''+#13+'';

end;

对于TBitBtn组件而言,如果想要显示竖排文本,设置字体后,只需要在每个需要显示的字符后面加上#13后即可;但是对于TButton组件而言,设置字体后,必须为TButton组件所在窗口追加BS_MULTILINE风格,然后在每个需要显示的字符后面加上#13后才行。

程序代码如下:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons;

type

TForm1 = class(TForm)

BitBtn1: TBitBtn;

Button1: TButton;

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

BitBtn1.Caption :=''+#13+''+#13+''+#13+'';

SetWindowLong(Button1.handle, GWL_STYLE,

GetWindowlong(Button1.Handle, GWL_STYLE) or

BS_MULTILINE);

Button1.Caption :=''+#13+''+#13+''+#13+'';

end;

end.

保存文件,然后按F9键运行程序,程序运行结果如图8-52所示。

8-52 程序运行结果


制作渐变填充的进度条

-->



实例147 制作渐变填充的进度条

进度条经常用于表示程序运行的进度,本实例演示如何制作一个颜色渐变填充的进度条。

向窗体上添加一个TTimer组件和一个TProgressBar组件。TTimer组件用来改变进度条中的进度数值,并且控制进度条的颜色。添加组件后的窗体如图8-42所示。

8-42 添加组件后的窗体

为了达到动态控制进度条的效果,在程序运行过程中自动通过TTimer组件来设置进度条的进度数值,为此需要先设置TTimer组件的Interval属性值为100Enabled属性值为True,然后添加TTimer组件的响应代码如下:

procedure TForm1.Timer1Timer(Sender: TObject);

var

color:Integer;

begin

if self.ProgressBar1.Position<100 then

self.ProgressBar1.Position:=self.ProgressBar1.Position+1

else

self.ProgressBar1.Position:=0;

color:=Trunc(self.ProgressBar1.Position*$FF/100);

SendMessage(ProgressBar1.Handle,PBM_SETBARCOLOR,0,TColor(color));

end;

TTimerEnabled属性为True的前提下,程序每隔100毫秒就会改变进度条中的进度数值。如果进度数值小于100,那么就把进度数值加1,反之就设置进度数值为0。然后程序就根据进度数值来确定进度条的颜色,使得进度条的颜色在黑色和红色之间均匀变化。最后通过SendMessage函数发送一个改变进度条颜色的消息来设置进度条的颜色。

程序代码如下:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, ComCtrls, COMMCtrl;

type

TForm1 = class(TForm)

ProgressBar1: TProgressBar;

Timer1: TTimer;

procedure Timer1Timer(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var

color:Integer;

begin

if self.ProgressBar1.Position<100 then

self.ProgressBar1.Position:=self.ProgressBar1.Position+1

else

self.ProgressBar1.Position:=0;

color:=Trunc(self.ProgressBar1.Position*$FF/100);

SendMessage(ProgressBar1.Handle,PBM_SETBARCOLOR,0,TColor(color));

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

progressbar1.Min:=0;

progressbar1.Max:=100;

end;

end.

保存文件,然后按F9键运行程序,程序运行结果如图8-43所示。

8-43 程序运行结果


自动滚动的工具栏

-->



实例148 自动滚动的工具栏

本实例制作一个可以自动滚动的工具栏。

在窗体中添加一个TImageList组件,并且为它添加几个图像文件。然后添加一个TToolBar组件,设置TToolBar组件的Images属性为TImageList组件,在TToolBar组件上右击,在弹出的快捷菜单中选择New Button项,为TToolBar组件添加几个按钮,并设置按钮的ImageIndex属性分别对应TImageList组件中的图像索引编号。最后向窗体上添加一个TPageScroller组件,设置它的AutoScroll属性值为True,设置Control属性为TToolBar组件,如果TToolBar组件的尺寸大于TPageScroller组件的尺寸,就会显示一个按钮。

设计完成的窗体如图8-44所示。

8-44 界面

保存文件,然后按F9键运行程序,程序运行的初始画面如图8-45所示。

在程序运行的过程中,鼠标移动到按钮上时工具栏就会自动滚动以显示工具栏的其他部分,如图8-46所示。

8-45 程序运行的初始画面8-46 程序运行结果

如果设置TPageScroller组件的AutoScroll属性值为False,那么在程序运行的过程中,只有单击按钮时,工具栏才会自动滚动以显示工具栏的其他部分。


枚举窗体上的组件

-->



实例145 枚举窗体上的组件

本实例演示如何在程序运行过程中获得窗体上所有组件的名称和类名。

向窗体上添加一个TListView组件、一个TButton组件、一个TRadioButton组件和一个TListView组件,TListView组件用来显示窗体上所有组件名称和类名。添加组件后的窗体如图8-36所示。

8-36 添加组件后的窗体

TListView组件添加两列——ClassNameName,如图8-37所示。

8-37 设置TListView组件的属性

然后添加窗体初始化代码如下:

procedure TfrmMain.FormCreate(Sender: TObject);

var

ListItem:TListItem;

i:Integer;

begin

ListView1.ViewStyle:=vsReport;

for i:=0 to self.ComponentCount-1 do

begin

ListItem:=ListView1.Items.Add;

LIstItem.Caption:=self.Components[i].ClassName;

ListItem.SubItems.Add(self.Components[i].Name);

end;

end;

程序首先设置TListView组件的显示风格为vsReport,然后进入一个循环,窗体上的所有组件都存储在窗体的Components数组中,所以通过循环语句中的Components[i]就可以访问窗体上的各个组件,并且把组件的类名和名称显示在TListView组件中。

程序代码如下:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, StdCtrls;

type

TfrmMain = class(TForm)

ListView1: TListView;

Button1: TButton;

Memo1: TMemo;

RadioButton1: TRadioButton;

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);

var

ListItem:TListItem;

i:Integer;

begin

ListView1.ViewStyle:=vsReport;

for i:=0 to self.ComponentCount-1 do

begin

ListItem:=ListView1.Items.Add;

LIstItem.Caption:=self.Components[i].ClassName;

ListItem.SubItems.Add(self.Components[i].Name);

end;

end;

end.

保存文件,然后按F9键运行程序,程序运行结果如图8-38所示。

8-38 程序运行结果