写了两个小工具

最近学了不少程序方面的技巧,包括数据库三层结构的搭建,以前全是写的C/S两层模式的程序,了解三层结构后,确实要高级得多。

将所有事件全封装在中间件上,客户端通过中间件访问数据库,从安全方面,从效率和速度上都有很大的优势。

另外显示数据的容器用StringGrid而不用DBGrid也是一大优势,前者功能强大,后者就要弱很多,技巧性。灵活性方面,DBgrid的劣势就显露出来了。

最近写了一个动态菜单,通过数据库信息来动态生成菜单。

另外写了一个数据库日志清理工具,随着使用SQL的时间越来越长,数据表的系统日志就会越来越大,这个工具就可以清理LOG文件。


menu.jpg

log.jpg

Posted in Web开发 at April 28, 2006. by 傻猫 .    Views: 4972    4 Comments

成都历险记

8年前,初中毕业后,一个人来到这座陌生的城市求学.

5年前,完成学业,踏入社会,第一份打字员的工作,每月400元的工资让我心喜若狂.我,我终于开始赚钱了.

在打字复印店里做了9个月后,慢慢地,越来越不能适应环境,过完春节后,在老板的一再挽留下,挥袖离开.

在打字复印店里,让我学会了如何使用打印机,复印机,传真机.并学会了简单的维护维修.也学会了操作系统的安装(ps:当时有两台电脑,其中之一经常出问题,所以也给了我练手的机会.呵呵)

4年前,我进入好棒食品公司,一边做电脑方面的工作,另一方面也进车间做工.他们主要生产调味品,全手工制作,还出口美国.工资每月也就6,7百.其中有两个月要赶货,连续加班.从早上7点就开始上班,晚上要做到8点左右.

那是夏天的时候,每天的衣服都要湿透好几次.或许是太苦的原因吧,我决定再去上学.

进入电子科大自考班后,在学校玩游戏比较多吧,每次考试基本上都是60分,全班六零炮最多的就是我.班上有近120人,我认识的可能也就20个人吧,由于是自考,老师上课时,想去就去,不想去就在寝室睡觉.

我自己都有很多次睡觉不去上课的经历,班主任是位女老师,到寝室来教我们去上课,把被子包住头不理她,反正她也不会来掀开被子.

游混的日子中,上课听老师讲课不是我的最爱.

我喜欢自己弄本书来看,喜欢在网上游,喜欢自己学点东西. 就在那段时候,我自己搞游戏私服,有传奇2,传奇3.

收获最大的是传奇3, 由于它的数据库跟传奇2不一样, 要用到SQL2000. 花了我周末两天时间,才把它数据库调通,由此我也学会了SQL2000的基本操作. 平时喜欢下载一些Delphi源代码来看,慢慢地, 开始搞点小程序.

最有代表的是那个时候写的<网页助手>,一个收集了近千种网页特效的工具软件.

自考毕业后, 准确地说,还不算毕业,因为还有几本功课还没考过, 毕业证还没有拿到. 我凭着一股初生牛犊不怕虎的劲进入艾普网络公司.

或许是我太幸运了吧, 在招聘会遇到了公司很好的谢总. 他给我机会让我到公司面试.

到公司后又遇到了跟我年龄稍微大点的波哥, 他给了我机会让我做公司的网站. 两个星期的时候, 我在网上找了一个韩国模板,把公司网站改了一下版. 从版面,美工各方面较以前相比是唤然一新.

所以公司让我留了下来.后来又给公司搞了一个管理软件.

在艾普的点点滴滴让我成长, 走过将近两年时间, 让我各方面都长进了很多.有空再把其中的经历慢慢道来.

三个星期前, 我离开了艾普,进入了一个蓝冰软件公司.

进入软件公司作为一名程序员,心里无比的高兴,同时又再一次站在了起跑线上,等待更多的挑战.

天生我才必有用, 站在巨人的肩上, 才能让我看得更高更远.

Posted in 我的生活 at April 27, 2006. by 傻猫 .    Views: 4197    2 Comments

黄桷兰的芳香又回来了

不经意地,搜索到一张黄桷兰的图片,让我顿时欣喜若狂。看着那碧绿水灵的叶子,妩媚洁白的花朵,我似乎又隐隐嗅到了那直沁心脾的清香。
  爱黄桷兰,就是缘于爱黄桷兰的清香,丝毫不做作的清香。忽而浓,忽而淡,在浓和淡之间让人捉摸不定,但又感觉的的确确地在透过口鼻,浸进肺腑,又在经络里弥漫开来,一种心旷神怡的清爽油然而生。
  每到黄桷兰开花的季节,大街小巷就会出现许多走窜着贩卖黄桷兰的花农,挽着一个编织得细密的竹蓝,用一块潮湿的毛巾覆盖了约莫半蓝子的花朵。竹蓝的边沿插上一枝剃尽了叶子的竹枝,挑上数挂细线穿成的花串,人还未走近,一阵清香就会迎面拂来。
  那些串成串的花朵,常被爱美的人们用来挂在胸口的纽扣上熏染自己。如若再配上一两叶青嫩的黄桷兰树叶,走起路来绿和白一起晃动,越发的相得益彰了。


 

黄桷兰:木兰科、木兰属、落叶乔木。

黄桷兰怎样栽培管理?

黄桷兰是早春色、香俱全的观花树种,栽植时,要掌握好时机,不能过早、也不能过晚,以早春发芽前10天或花谢后展叶前栽植最为适宜。移栽时,无论苗木大小,根须均需带着泥团,并注意尽量不要损伤根系。以求确保成活。栽植前,应在穴内施足充分腐熟的有机肥作底肥。栽好后封土压紧,并及时浇足水。

黄桷兰花较喜肥,但忌大肥;生长期一般施两次肥即可有利于花芽分化和促进生长。一次是在早春时施,再一次是在5-6月份进行。肥料多用充分腐熟的有机肥。新栽植的树苗可不必施肥,待落叶后或翌年春天再施肥。黄桷兰的根系肉质根,不耐积水。开花生长期宜保持土壤稍湿润。入秋后应减少浇水,延缓黄桷兰生根,促使枝条成熟,以利越冬。冬季一般不浇水,只有在土壤过干时浇一次水。黄桷兰枝干伤口愈合能力较差,故一般不进行修剪。但为了树形的合理,对徒长枝、枯枝、病虫枝以及有碍树形美观的枝条,仍应在展叶初期剪除。此外,花谢后,如不留种,还应将残花和蓇葖果穗剪掉,以免消耗养分,影响来年开花。

黄桷兰多为地栽,盆栽时宜培植成桩景。

 


1.jpg

2.jpg

3.jpg

Posted in 我的生活 at April 20, 2006. by 傻猫 .    Views: 5169    No Comments

唉,圈养的金鱼又死了

以前也有过好几次,去年买过好几条金鱼,每次都是一对一对的,到西天极乐世界也很快,买回来没多久,就死咯。

有被太阳晒死的,有被食物撑死的(饲料放的太多),有被丑死的(N久没换水),这次更怪了,刚刚买回来的时候,我就跟MM开玩话说,这条大的金鱼代表偶,这条小的金鱼代表你,看看那个的命更长,买回来没隔几个小时,那条小金鱼就上天了,555555555

小金鱼上天后,我发现那条大的身上有很明显的伤痕,难道他们曾经有过一场恶战么?

这几天,我每天早上起来/晚上下班回来第一件事情就是给金鱼换水,卖金鱼的老板说的,要经常换水,不然就容易死。

前天去一个朋友家里,他们也喂了好几天金鱼,她给偶说,不能换的太勤了,水太冷它可能受不了的,经常换水让他每次都要适合环境,要放到通风的地方,一个星期换一次水就可以,她还特地买了一条吃金鱼屎的鱼,叫什么名字我记不起来了,居然在家里搞起了生态循环了,呵呵。

这时想到金鱼老板说的话,我......倒......

 


015o.jpg

Posted in 我的生活 at April 20, 2006. by 傻猫 .    Views: 3239    No Comments

delphi中TreeView的一些应用

一. 如何初始化一个TreeView?


弄一个窗口,放上一个TreeView和一个Button,分别取名为TV1和Btn1。如果需要
在每个节点前有个图,请在窗口上放上一个ImageList,取名为ImageList1,双击
它,加入六个图标。还要记得记得将TV1的Images属性改为ImageList1噢。双击按
钮Btn1,在里面填入以下代码,然后按F9运行,点击Btn1就可以看到效果了。


procedure TForm1.Btn1Click(Sender: TObject);
Const
MyDocDir = 'C:\My Documents';
PersonDir = '3hSoft';
Var
Var
I : Word;
SubNodeName : array [1..5] of ShortString;
RootNode, SubNode : TTreeNode;
P : PString;
begin
SubNodeName[1] := '便笺';
SubNodeName[2] := '发件箱';
SubNodeName[3] := '联系人';
SubNodeName[4] := '任务';
SubNodeName[5] := '日记';
TV1.Items.Clear;
TV1.Items.BeginUpdate;
New(P);
P^ := MyDocDir + '\' + PersonDir;
RootNode := TV1.Items.AddObject(Nil, '个人文件夹', P);
// 此 Node 的图标已对 Images 属性中取第 0 个了。
For I := 1 to 5 do
begin
New(P);
P^ := MyDocDir + '\' + PersonDir + '\' + SubNodeName[I];
SubNode := TV1.Items.AddChildObject(RootNode, SubNodeName[I], P)
;
;
// 如果不想使用图标的话请删除以下两行
SubNode.ImageIndex := I;
SubNode.SelectedIndex := I;
end;
TV1.Items.EndUpdate;
end;

 

二.在TreeView中如何设置选中结点


var
i:integer; {i为设置的选中结点的索引值}


begin
if i>treeview1.items.count then
treeview1.items[i].selected:=true;


treeview1.selected:=treeview1.items[i];

三。设置TreeView结点的图形


1. 设置TreeView的images属性为已存在的images对象

treeview1.images:=imagelist1;


2. 在加入结点后执行:

var
anode:TTreeNode;
begein
anode:=Treeview1.add(nil,'item1');
anode.imageindex:=0; {结点未选中时显示的图标}
anode.selectedindex:=1; {结点选中时显示的图标}
end
3. 如果结点图形在改变后未发生变化,可以执行:
treeview1.refresh;

 

四。如何批量处理TreeView结点


使用TreeView的items属性的BeginUpdate和EndUpdate方法,例:


TreeView1.items.BeginUpdate;
for i:=0 to TreeView1.items.count-1 do
begin
file ://将每个结点的文字改成为小写字母
TreeView1.items[i].text:=lowercase(TreeView1.items[i].text);
end;
TreeView1.items.EndUpdate;

五。实现TreeView结点拖拽的实例


下面的程序片段演示了如何实现拖拽treeview构件结点的例子

{鼠标按下时执行的语句}
procedure TForm1.Treeview1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

{判断左键按下并且鼠标点在一个结点上开始实现拖拽}
if ( Button = mbLeft ) and
( htOnItem in Treeview1.GetHitTestInfoAt( X, Y ) ) then
begin
Treeview1.BeginDrag( False );
end;
end;

{鼠标拖动执行语句}
procedure TForm1.Treeview1DragOver( Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
Node : TTreeNode;
begin
if Source = Treeview1 then
begin
Node := Treeview1.GetNodeAt( X, Y ); {取当前结点}
if Node <> nil then {当前结点不为空才能实现拖拽,accept:=true}

Accept := true;
end;
end;

{鼠标释放时执行的语句}
procedure TForm1.Treeview1DragDrop( Sender, Source: TObject;
X, Y : Integer );
var
TempNode : TTreeNode;
AttachMode : TNodeAttachMode;
begin
if Treeview1.Selected = nil then
Exit;

AttachMode := naAddChild; {设置结点移动模式,设移动结点为子结点}


{ 注意在这里存在一个bug,当移动结点时,如果目标结点没有子结点,}
{ 则加入的新的子结点会失败,所以先在当前目标结点的下面 }
{ 加入一个临时子结点,移动完毕后,再将临时结点删除 }

Treeview1.Items.BeginUpdate;
try
TempNode := Treeview1.Items.AddChild( Treeview1.DropTarget,
'Temp' );
try
{ 移动选中的结点到目标结点 }
Treeview1.Selected.MoveTo( Treeview1.DropTarget, AttachMode );
finally
TempNode.Free; { 不要忘了释放临时结点 }
end;
finally
Treeview1.Items.EndUpdate;
end;
end;

Posted in 软件开发 at April 19, 2006. by 傻猫 .    Views: 6541    1 Comment

尝试银行存款机

以前用过很多次取款机(ATM),昨天去工商银行去存款,好在网上买本书,找遍磨子桥到数码广场的几条街,其它银行全都有,唯独没有工商银行,简直气煞我也.

回头在路边问了一非常热心的小贩,她告诉我就在川大对面有一个,我急忙跑过去,已经是8:15了,银行要8:30才开始营业,郁闷了,还要等一段时间,又怕一会到公司迟到.后来,偶发现银行旁边有好几个柜员机,进去一看,有一个存款机,哈哈,马上看了一下使用说明,放了三张钞票和银行卡进去,咕噜咕噜一阵声音后,柜员机点钞完毕,要偶确认.正确无误,嘿嘿.存完钱后,大摇大摆走出银行,直奔公司.

科学技术就是第一生产力啊,节省了时间,24小时营业,存款机太方便了,尽量不要出什么错误就OK啦.

Posted in 我的生活 at April 19, 2006. by 傻猫 .    Views: 3814    1 Comment

Delphi的消息处理

Delphi是Borland公司的一种面向对象的可视化软件开发工具。 Delphi集中了Visual C++和Visual Basic两者的优点:容易上手、功能强大,特别是在界面设计、数据库编程、网络编程方面更有其独特的优势。

Delphi中的消息

消息是Windows发出的一个通知,它告诉应用程序某个事件发生了。在Delphi中,大多数情况下Windows的消息被封装在VCL的事件中,我们只需处理相应的VCL事件就可以了,但如果我们需要编写自己的控件、截获或过滤消息就必须深入研究Win32的消息处理机制。

在Delphi中消息以TMessage记录的方式定义。打开Message.pas文件,我们可以看到Tmessage是这样定义的:

type

TMessage = packed record

Msg: Cardinal;

case Integer of

0: ( WParam: Longint;

LParam: Longint;

Result: Longint);

1: ( WParamLo: Word;

WParamHi: Word;

LParamLo: Word;

LParamHi: Word;

ResultLo: Word;

ResultHi: Word);

end;

其中,Msg是区别于其他消息的常量值,这些常量值可以是Windows单元中预定义的常量,也可以是用户自己定义的常量。Wparam通常是一个与消息有关的常量值,也可以是窗口或控件的句柄。LParam通常是一个指向内存中数据的指针。

Result是消息处理的返回值。Wparam、Lparam和Result都是32位的,如果想访问其中的低16位或高16位可以分别使用WparamLo、WparamHi、 LParamLo、LparamHi、ResultLo和ResultHi。

在Delphi中除了通用的Tmessage外,还为每个Windows定义了一个特殊的消息记录。我们可以浏览Message.pas文件,下面是键盘的消息记录:

TWMKey = packed record

Msg: Cardinal;

CharCode: Word;

Unused: Word;

KeyData: Longint;

Result: Longint;

与键盘相关的消息如:WM_KEYDOWN、 WM_KEYUP、 WM_CHAR、 WM_SYSKEYDOWN WM_SYSKEYUP、 WM_SYSCHAR的记录也被定义为TWMkey。在Message.pas文件中有以下声明:

TWMChar=TWMkey; TWMKeyDown=

TWMkey;TWMKeyUp=TWMkey; TWMSys

-KeyDown=TWMkey; TWMSysKeyUp=

TWMkey;TWMSysChar=TWMkey;

消息的发送

消息处理就是定义应用程序如何响应Windows的消息。在Delphi中每一个消息都有自己的处理过程,它必须是一个对象中的方法,且只能传递一个Tmessage或其他特殊的消息记录,方法声明后要有一个message命令,后接一个在0到32767之间的常量。

前面我们提到的消息都是标准的Windows消息(WM_X),除此之外还有VCL内部消息、通知消息和用户自定义消息。

VCL内部消息通常以“CM_”开头,用于管理VCL内部的事物。如果改变了某个属性值或组件的其他一些特性后,需要通过内部消息将该变化通知其他组件。例如,激活输入焦点消息是向被激活的或被停用的组件发送的,用于接受或放弃输入焦点。

另外还有通知消息,一个窗口内的子控件发生了一些事情,需要通知父窗口,这是通过通知消息实现的。它只适用于标准的窗口控件,如按钮、列表框、编辑框等等。打开Message.pas文件,在标准的Windows后就是通知消息的声明:

const

{$EXTERNALSYM BN_CLICKED}

BN_CLICKED = 0;

{$EXTERNALSYM BN_PAINT}

BN_PAINT = 1;

{$EXTERNALSYM BN_HILITE}

BN_HILITE = 2;

以上是按钮的通知消息,分别表示用户单击了按钮、按钮应当重画、用户加亮了按钮。

用户也可以自己定义消息、给自己发送消息和编写消息处理过程。消息的常量值为WM_USER+100到$7FFF, 这个范围是Windows为用户自定义消息保留的。

Delphi消息的发送有三种方法:

1.Tcontrol类的Perform对象方法。可以向任何一个窗体或控件发送消息,只需要知道窗体或控件的实例。其声明如下:

function Tcontrol.Perform(Msg:Cardinal;Wparam,Lparam:Longint):Longint

2.Windows的API函数SendMessage()和Postmessage()。其声明如下:

function SendMessage(hWnd: HWND; Msg: UINT;wParam:WPARAM; lParam: LPARAM):LRESULT;stdcall;

function SendMessage(hWnd: HWND; Msg: UINT;wParam: WPARAM; lParam:LPARAM):LRESULT;stdcall

PostMessage函数将消息添加到应用程序的消息队列中去。应用程序的消息循环会从消息队列中提取登记的该消息,再发送到相应的窗口中。

SendMessage函数可以越过消息队列直接向窗口过程发送。所以当Windows需要立刻返回值时使用SendMessage,当需要不同的应用程序依次处理消息时使用PostMessage。而Perform从本质上和SendMessage相似,它们直接向窗口过程发送。SendMessage、Postmessage函数只需要知道窗口的句柄就可以发送消息,所以它们可以向非Delphi窗体发送一条消息,但而Perform必须知道窗体或控件的实例。

VCL消息处理机制

在Delphi应用程序的源代码中有语句Application.Run,它的作用是启动消息循环,然后调用Application.ProcessMessage,该函数会在应用程序的消息队列中查找一条消息。当在消息队列中检索到一条消息后,触发Application.OnMessage事件。这样在Windows本身对消息处理之前,就会响应OnMessage事件的处理过程,它优于任何消息处理,而且只接收登记的消息,即前面所述的由PostMessage发送的消息。响应Application.OnMessage事件的处理过程必须是TmessageEvent类型,其声明如下:

type TMessageEvent = procedure (var Msg: TMsg; var Handled: Boolean) of object;

其中TMsg是Windows中定义的消息记录,我们可以这样声明:

Procedure OnMyMessage(var Msg:TMsg;var Handled:Boolean);

然后把此方法赋给Application.OnMessage事件:

Application.OnMessage :=OnMyMessage;

OnMessage事件将捕获发送给应用程序的所有消息,这是一个非常繁忙的事件,因此在处理OnMessage事件的处理过程中设置断点进行消息处理是不明智的。

VCL对象用于接收消息的方法叫MainWndProc。它是定义在Twincontrol类中的静态方法,不能被重载。它不直接处理消息,当消息离开MainWndProc后,消息被传递给对象的WndProc方法,WndProc方法是在Tcontrol类中定义的一个虚拟方法,由它调用Dispatch方法。Dispatch根据传入的Message来寻找相应的处理方法,如果最后找不到,就继续向上到父类中寻找消息处理方法,一直到找到为止,如果找不到则调用Defaulthandler。Defaulthandler方法对消息进行最后的处理,然后把消息传递给Windows的DefWindowProc函数或其他默认的窗口过程。

Posted in 软件开发 at April 18, 2006. by 傻猫 .    Views: 3307    No Comments

动态生产控件的方法和应用

一、Delphi中生成控件的两种方法
---- 1、 Form(表单)设计中生成控件
---- 在进行Form设计时,直接在控件工具箱选择所需控件,再设置其属性与响应事件,这种方法比较常见。
---- 2、 程序中动态生成控件
---- 有时候,我们需要在程序运行时动态生成控件,这样做有两大优点:一是可以增加程序的灵活性;二是如果生成控件的多少与程序中间运行结果相关,显然方法一是无法的实现的,必须用程序中动态生成方法。
---- 程序中动态生成控件的方法分为三步,首先,定义生成的控件类型,再用Create函数生成控件,最后对控件的相关属性赋值。以TButton控件为例,步骤如下:
---- (1) 定义控件类型
  var
     Button1:TButton;
---- (2) 生成控件
  Button1:=TButton. Create(self);
  Button1.Parent:=Self;  
 //一般将其父控件设置为Self,如果不设置Parent的值,则控件不会在屏幕显示出来
---- (3) 设置其它属性及定义相关事件响应函数,如Caption, Left, Top, Height, Width, Visible, Enabled, Hint和onClick事件响应函数等。

二、动态生成控件方法的应用
---- 在开发生产调度与管理系统中,需要动态生成排产计划图,以甘特图表示,应用Shape控件来显示零件的加工状况(每道工序的加工开始时间与结束时间)是非常适合的。应用Chart控件,对加工设备利用率以三维直方图显示,非常直观。现分别将在程序中动态生成Shape控件和Chart控件的过程加以说明。
---- 1、动态生成Shape控件显示排产计划图(甘特图)
    procedure TCreateMultiCharts.ProcCreateCharts;
    var
      i,j,Rows,Columns,RowSpace,ChartsHeight:Integer;
      ShapeChart:array of array of TShape;
    begin
      Rows:=16;        //Shape控件数组行数
      Columns:=8;      // Shape控件数组列数
      RowSpace:=20;   // Shape控件行间距
      ChartsHeight:=20; // Shape控件高度
      SetLength(ShapeChart,Rows,Columns);
      //设置ShapeChart数组大小
      for i:=0 to Rows do
        for j:=0 to Columns do
        begin
      ShapeChart[i][j]:=TShape.Create(self);
      with ShapeChart[i,j] do
      begin
        Parent:=Self;  //此行必不可少,否则Shape控件在屏幕显示不出
        Shape:=stRectangle; // Shape控件形状为矩形
        Top:=45+i*(RowSpace+ChartsHeight);
        Left:=Round(180+Q[i,j].StartTime); //因Q[i,j].StartTime为实数,故需进行四舍五入取整
        Width:=Round(Q[i,j].Value)
        Height:=ChartsHeight;        
        Brush.Color:=RandomColor; //自定义函数,说明附后
        Brush.Style:=bsSolid; //设置填充方式
        Enabled:=True;
      end;
    end;
end;
 
---- 注:
---- (1)Q为一记录型二维数组,定义如下:
  type
     TempData=Record
     Value:Real;
     StartTime:Real;
   end;
   Q:array of array of TempData
---- 并且在另一过程已对Q的分量进行赋值。
---- (2)为了区分不同的零件,Shape以不同颜色显示,此时,调用了函数RandomColor。该函数为:
   function TCreateMultiCharts.RandomColor;
   var
     red,green,blue:byte;
   begin
     red:=random(255);
     green:=random(255);
     blue:=random(255);
     result:=red or (green shl 8) or (blue shl 16);
   end;
---- 2、动态生成Charts控件的ChartSeries组件,显示设备利用率
   procedure TFormMultiMachinesBurthen.
   ShowMachineBurthenCharts;
   var
    i:Integer;
    Burthen:Real;
    SeriesClass:TChartSeriesClass;
    NewSeries:array of TChartSeries;
  begin
    SetLength(NewSeries,CreateMultiCharts.Rows);
    MachinesBurthenCharts.height:=200;
    MachinesBurthenCharts.Width:=550;
    for i:=0 to CreateMultiCharts.Rows do
    begin
      SeriesClass:=TBarSeries;  //设置形状为三维条形图
      NewSeries[i]:=SeriesClass.Create(Self);
      NewSeries[i].ParentChart:=MachinesBurthenCharts;
      NewSeries[i].Clear;
      Burthen:=MachineBurthen[i];
      Burthen:=Round(Burthen*100)/100;  //只取小数点后两位数字
      NewSeries[i].add(Burthen,'',NewSeries[i].SeriesColor);
    end;
  end;
 
---- 注:
---- (1) MachineBurthen[i]为一实型数组,其值为对应设备的利用率,已在另一函数中计算得到;
---- (2) MachinesBurthenCharts为TChart控件,在type段说明。


 

2004-4-6 10:59:32   

 2004-4-6 11:29:16   动态创建菜单全接触

[基本认识]:
      在Delphi的程序开发环境中,封装的VCL减化了我们许多的开发工作,由在界面的设计上使开发的进度很快,但在很多的时候,我们需要自己来设计可视化的用户界面,而且是在程序的运行中,这时我们就得利用Delphi给我们提供的类来完成我们需要的工作了,下面笔者就和朋友们浅入的讨论一下动态创建"菜单"的基本知识,希望本文给那些刚入门的朋友来个抛砖引玉的作用。  
      在delphi的菜单设计中,有两个Delphi的菜单控件:
      1:Tmainmenu;
      2:Tpopupmenu;
      前者是创建窗口的菜单,后者是创建右键弹出式菜单的控件,但在Delphi庞大的类库中有一个类与这两个控件密切相关,它就是:TMenuItem,窗口的菜单和右键弹出式菜单的每个条目都是TMenuItem类的一个对象。此TMenuItem类不出现在控件板上,在程序中用代码可创建其实例。

[基本知识]:
      在tmainmenu,tpopupmenu控件中有一个属性是items,此属性是数组型,里面的参数为菜单项的索引值。
文件 编辑 查看 插入 格式 帮助
---- ---- ---- ---- ---- ----
新建 撤消 标尺 对象 字体 关于
打开 拷贝 源码 公式 颜色 
      相信您看过上面的菜单简单表示之后是非常熟悉的,在此菜单中菜单头的索引值代表如下:
      "文件"的菜单的items值为0;
      "编辑"的菜单的items值为1;以此类推。
      items属性是tmenuitem类型,而在此类型中还有一个属性,是items,如果您略懂"类"的关系,您就不难明白此类似"嵌套"的关系。"新建"菜单选项是"文件"菜单选项的子类,用代码表示为tmainmenu.items[0].items[0],"打开"菜单选项为tmainmenu.items[0].items[1],以此类推,而代表"编辑"菜单中的"拷贝"菜单选项的代码为tmainmenu.items[1].items[1],其它菜单代码表示以此类推。

[基本实例]:
      知道了菜单的items结构之后,我们就可以进一步大胆的创建自己有序的菜单了。
      上面讨论到窗口的菜单和右键弹出式菜单的每个条目都是TMenuItem类的一个对象。那么我们就可以create它的一个实例,来添加自己想要的菜单了。

[示例过程]:
1:新建一个工程。
2:添加一个tmainmenu控件。
3:添加一个button控件,并在button的onclick事件中写入如下代码:
procedure TForm1.Button1Click(Sender: TObject);
var
    files,edit:tmenuitem;{要有实例的声明}
begin
    files:=tmenuitem.Create(self);
    edit:=tmenuitem.create(self);
    files.Caption:='文件';
    edit.caption:='编辑';
    mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键}
    form1.MainMenu1.Items.Add(files);
    form1.mainmenu1.items.add(edit);
end;  
      运行后,出现如上面例举的菜单的部分结构,如此看来动态创建菜单项的方法是非常简单的,这无疑于Delphi把系统的函数进行了封装。菜单头我们创建完了,接下来就该创建菜单里的菜单项了,由"items属性是tmenuitem类型,而在此类型中还有一个属性,是items"此句话的意思我们可以创建菜单项,代码如下:
1:新建一个工程。
2:添加一个tmainmenu控件。
3:添加一个button控件,并在button的onclick事件中写入如下代码:
procedure TForm1.Button1Click(Sender: TObject);
var
   files,edit:tmenuitem;
   new,copy:tmenuitem;
begin
   files:=tmenuitem.Create(self);
   edit:=tmenuitem.create(self);
   files.Caption:='文件';
   edit.caption:='编辑';
   mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键}
   form1.MainMenu1.Items.Add(files);
   form1.mainmenu1.items.add(edit);
   {上部代码为创建菜单头}
   new:=tmenuitem.create(self);
   copy:=tmenuitem.create(self);
   new.Caption:='新建';
   copy.caption:='拷贝';
   files.Add(new);
   edit.add(copy);
  {上部代码为创建菜单项}
end;
      运行效果和上面菜单结构表中基本一样,但此时点击菜单项时不出现任何的事件,显然这样的软件出售量不算理想,我们可以略改代码加个事件上去。
代码如下:
1:新建一个工程。
2:添加一个tmainmenu控件。
3:
private
  procedure abc(sender:tobject);
  { Private declarations }
var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure tform1.abc(sender:tobject);
begin
   showmessage('welcome you click me!! :) xixi');
end;
procedure TForm1.Button1Click(Sender: TObject);
var
   files,edit:tmenuitem;
   new,copy:tmenuitem;
begin
   files:=tmenuitem.Create(self);
   edit:=tmenuitem.create(self);
   files.Caption:='文件';
   edit.caption:='编辑';
   mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键}
   form1.MainMenu1.Items.Add(files);
   form1.mainmenu1.items.add(edit);
   {上部代码为创建菜单头}
   new:=tmenuitem.create(self);
   copy:=tmenuitem.create(self);
   new.Caption:='新建';
   copy.caption:='拷贝';
   copy.onClick:=abc;
   new.onClick:=abc;
   files.Add(new);
   edit.add(copy);
   {上部代码为创建菜单项}
end;
      这时这个软件就有了交互的功能。
      有时菜单项中出现一个横的条线和出现一个子的菜单,那么这样的效果怎么用代码实现的呢,下面就是此效果的代码示例:
1:新建一个工程。
2:添加一个tmainmenu控件。
3:
procedure TForm1.Button1Click(Sender: TObject);
var
   files,edit:tmenuitem;
   new,copy:tmenuitem;
   sub1,sub2,sub3,lines:tmenuitem;
begin
   files:=tmenuitem.Create(self);
   edit:=tmenuitem.create(self);
   files.Caption:='文件';
   edit.caption:='编辑';
   mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键}
   form1.MainMenu1.Items.Add(files);
   form1.mainmenu1.items.add(edit);
  {上部代码为创建菜单头}
   new:=tmenuitem.create(self);
   copy:=tmenuitem.create(self);
   new.Caption:='新建';
   copy.caption:='拷贝';
   files.Add(new);
   edit.add(copy);
  {上部代码为创建菜单项}
   sub1:=tmenuitem.create(self);
   sub2:=tmenuitem.create(self);
   sub3:=tmenuitem.create(self);
   lines:=tmenuitem.create(self);
   lines.caption:='-';
   sub1.caption:='子菜单1';
   sub2.caption:='子菜单2';
   sub3.caption:='子菜单3';
   new.Add(sub1);
   new.add(lines);
   new.add(sub3);
   copy.Add(sub2);
  {上面代码出现多项子菜单和横线的效果}
end;

      到此讨论的内容就要结束,菜单的创建在Delphi中是非常简单的事,在tmenuitem类中还有许多的事件和方法及属性,如Add, Clear, Click, Create, Delete, Destroy, Find, IndexOf, Insert, Remove等方法的使用都是非常简单的.

 

 2004-4-6 11:30:34   TPagecontrol TTablesheet 动态创建

动态创建TPagecontrol, TTablesheet
var
  T : TTabSheet;
  P : TPageControl;
begin
   // Create the PageControl
   // need to reference the page control so we need a reference to it.

  P := TPageControl.Create(application);
  with P do begin
    Parent := Form1;  // set how controls it.
    Top := 30;
    Left := 30;
    Width := 200;
    Height := 150;
    end;  // with TPageControl

    // Create 3 pages
  T := TTabSheet.Create(P);
  with T do begin
    Visible := True;   // This is necessary or form does not repaint
                       // correctly
    Caption := 'Page 1';
    PageControl := P;  // Assign Tab to Page Control
    end;  // with

  T := TTabSheet.Create(P);
  with T do begin
    Visible := True;   // This is necessary or form does not repaint
                       // correctly
    Caption := 'Page 2';
    PageControl := P;  // Assign Tab to Page Control
    end;  // with

  T := TTabSheet.Create(P);
  with T do begin
    Visible := True;   // This is necessary or form does not repaint
                       // correctly
    Caption := 'Page 3';
    PageControl := P;  // Assign Tab to Page Control

    end;  // with

    // Create 3 buttons, 1 per page
  with tbutton.create(application) do begin
    Parent := P.Pages[0];  // Tell which page owns the Button
    Caption := 'Hello Page 1';
    Left := 0;
    Top := 0;
    end; // with

  with tbutton.create(application) do begin
    Parent := P.Pages[1];  // Tell which page owns the Button
    Caption := 'Hello Page 2';
    Left := 50;
    Top := 50;
    end; // with

  with tbutton.create(application) do begin

    Parent := P.Pages[2];  // Tell which page owns the Button
    Caption := 'Hello Page 3';
    Left := 100;
    Top :=  90;
    end; // with

    // This needs to be done or the Tab does not sync to the
    // correct page, initially.  Only if you have more then
    // one page.
  P.ActivePage := P.Pages[1];
  P.ActivePage := P.Pages[0];  // page to really show
end;
 

 

 2004-4-6 11:32:23   动态创建控件依次显示数据库值

var
  Edit1: TEdit;
  i: integer;
begin
  table1.First;
  for i := 0 to table1.RecordCount - 1 do begin
    Edit1 := TEdit.Create(Self);
    Edit1.Parent := aForm;
    Edit1.Left := 20;
    Edit1.Top := 20 * i;
    Edit1.Text := table1.fieldbyname('姓名').asString;
    table1.next;
  end;
  edit1.Destroy;
end;

 

 2004-4-6 11:40:25   动态加减pagecontrol的页数 --- 配合《TPagecontrol TTablesheet 动态创建》使用

动态添加:
  tabsheet2:=ttabsheet.Create(self);
  tabsheet2.Caption:='fkjsd';
  tabsheet2.PageControl:=pagecontrol1;

删除:
  tabsheet1.PageControl:=nil;

 

 2004-4-6 11:43:25   快速动态创建MenuItem --- 配合《动态创建菜单全接触》使用

在设计程序时,有时我们需要动态地创建菜单, 通常我们使用以下的语句
  PopupMenu1 := TPopupMenu.Create(Self);
  Item := TMenuItem.Create(PopupMenu1);
  Item.Caption := 'First Menu';
  Item.onClick := MenuItem1Click;
  PopupMenu1.Items.Add(Item);

  Item := TMenuItem.Create(PopupMenu1);
  Item.Caption := 'Second Menu';
  Item.onClick := MenuItem2Click;
  PopupMenu1.Items.Add(Item);

  Item := TMenuItem.Create(PopupMenu1);
  Item.Caption := 'Third Menu';
  Item.onClick := MenuItem3Click;
  PopupMenu1.Items.Add(Item);

  Item := TMenuItem.Create(PopupMenu1);
  Item.Caption := '-';
  PopupMenu1.Items.Add(Item);

  Item := TMenuItem.Create(PopupMenu1);
  Item.Caption := 'Fourth Menu';
  Item.onClick := MenuItem4Click;
  PopupMenu1.Items.Add(Item);

其实我们可以使用一种更快的方法达到同样的功能, 但使用很少的代码, 那就是用NewLine和NewItem, 看看下面的例子, 是不是很简单?
PopupMenu1 := TPopupMenu.Create(Self);
with PopUpMenu1.Items do
begin
  Add(NewItem('First Menu',0,False,True,MenuItem1Click,0,'MenuItem1'));
  Add(NewItem('Second Menu',0,False,True,MenuItem2Click,0,'MenuItem2'));
  Add(NewItem('Third Menu',0,False,True,MenuItem3Click,0,'MenuItem3'));
  Add(NewLine); // 增加一个分割棒
  Add(NewItem('Fourth Menu',0,False,True,MenuItem4Click,0,'MenuItem4'));
  ...
end;

 

 2004-4-6 11:45:54   [作者:guosoong]在QuickRep上面的动态报表建立

相信每一个到这里的人,都在100多页中寻找过帮助,或多或少都会感到痛苦的,如果你看到本文之后,如果有一丝快乐,就是我最大的快乐了。
话归正题!

[项目要求]:一个字段动态建立的数据库文件(.dbf),用户要求查询打印或者把整个数据库都打印出来。

[解决方法]:
1.首先把当前Table或Query中的数据提取出来。
2.用户决定一页报表打印多少列,把提取的数据建立数据库文件。
3.建立一个QuickQep窗体,在程序运行时动态建立,并动态建立TQRDBText。
下面提供每个工作的源码。望大家修改并通知我谢谢。
1.首先把当前Table或Query中的数据提取出来。
首先定义数据库内有效数据的数据结构
type
  printvalue = record
  fidlecount: integer;  //当前数据库的行号(从0开始,完全是个人习惯)
  fidlename: string;   //字段名称
  fidlevalue: string;  //字段内容
  end;
pNowPrintvalue = ^printvalue;  //定义指针
这个结构大家可以随意修改

//这个命令是TTable的,用于把一个数据库文件全部提取出来  TQuery就留给大家自己做吧
procedure TForm1.CreateQRTlistByTTable(filename: string; ValueTlist: Tlist);
var
  temppoint: pNowPrintvalue;
  tempTStrings: Tstrings;
  temploop1,temploop2: integer;
  temptable: TTable;
  tempTString: Tstrings;
begin
  if filename = '' then exit;
  if ValueTlist = nil then ValueTlist := Tlist.Create;
  ValueTlist.Clear;
  temptable := TTable.Create(nil);
  tempTStrings := Tstringlist.Create;
  try
    if sysutils.FileExists(filename) then
    begin
      temptable.Close;
      temptable.DatabaseName := sysutils.ExtractFilePath(filename);
      temptable.TableName := sysutils.ExtractFileName(filename);
      temptable.Open;

      temptable.First;
      tempTStrings := temptable.FieldList;
      if tempTStrings.Count <= 0 then exit;
      for temploop2 := 0 to temptable.RecordCount -1 do
      begin
        for temploop1 := 0 to tempTStrings.Count -1 do
        begin
          if tempTStrings[temploop1] <> '' then
          begin
            new(temppoint);
            temppoint.fidlecount := temploop2;
            temppoint.fidlename := tempTStrings[temploop1];
            if temptable.FieldValues[tempTStrings[temploop1]] = null then
            temppoint.fidlevalue := ' '
            else
            temppoint.fidlevalue := temptable.FieldValues[tempTStrings[temploop1]];
            ValueTlist.Add(temppoint);
          end;
        end;
        temptable.Next;
      end;
    end;
  finally
    temptable.Free;
  end;
end;

//上面程序里的TLIST就是下面函数的需要的ValueTlist
//QRCOLcount 就是用户决定一页打印的列数

function TForm1.WriteQRTempDBF(ValueTlist: Tlist;
  QRCOLcount: integer): integer;
var
  templist: Tlist;
  tempint: integer;
  temptable: TTable;
  temploop1,temploop2,temploop3: integer;
  temppoint: pNowPrintvalue;
  tempvalue: array of string;
  modint,endint:integer;
const
  tempdbname = 'temprint.DBF';
  FieldNames = 'TEMPFD';
begin
  result := 0;
  if QRCOLcount <= 0 then exit;
  if ValueTlist = nil then exit;
  if ValueTlist.Count <= 0 then exit;
  temploop3 := QRCOLcount;
  temploop1 := QRCOLcount;
  temploop2 := ValueTlist.Count div temploop3;

 if ValueTlist.Count mod temploop3 <> 0 then
  begin
    temploop2 := temploop2 +1;
    modint := ValueTlist.Count mod temploop3;
  end;

  endint := temploop2;
  templist := Tlist.Create;
  temptable := TTable.Create(nil);
  try
    tempint := CreateTempQRFieldList(QRCOLcount,templist); //这里是建立有效数据的数据库文件的命令
    if tempint >0 then
    begin
     tempint := CreateDatebases(temptable,BDEName,tempdbname,ttDBase,templist,false);//这里是建立空数据库的命令
     if tempint >0 then
     begin
       temptable.Close;
       temptable.DatabaseName := BDEName;  //这里是一个全局的数据库别名,大家可以自己定义
       temptable.TableName := tempdbname;
       temptable.Open;//下面就是把带入的有效数据,填入数据库的工作
       with temptable do
       begin
         Append;
         for temploop2 := 0 to temploop2-1 do
         begin
           if (temploop2 <> endint-1) then
           begin
           Insert;
           tempvalue := nil;
           setlength(tempvalue,QRCOLcount);
           for temploop3 := 0 to temploop3-1 do
           begin
             temppoint := ValueTlist.Items[temploop2*QRCOLcount+temploop3];

             FieldByName(FieldNames+inttostr(temploop3)).AsString :=temppoint.fidlename;
             tempvalue[temploop3] := temppoint.fidlevalue;


             if temploop3 = QRCOLcount-1 then
             begin
               Post;
               inc(result);
               Insert;
               for temploop1 := 0 to temploop1-1 do
               FieldByName(FieldNames+inttostr(temploop1)).AsString :=tempvalue[temploop1];
               Post;
               inc(result);
             end;

           end;
           end
           else
           begin
             if (modint > 0) then
             begin
             Insert;
             tempvalue := nil;
             setlength(tempvalue,modint);
             for temploop3 := 0 to modint-1 do
             begin
               temppoint := ValueTlist.Items[temploop2*QRCOLcount+temploop3];

               FieldByName(FieldNames+inttostr(temploop3)).AsString :=temppoint.fidlename;
               tempvalue[temploop3] := temppoint.fidlevalue;


               if temploop3 = modint-1 then
               begin
                 Post;
                 inc(result);
                 Insert;
                 for temploop1 := 0 to modint-1 do
                 FieldByName(FieldNames+inttostr(temploop1)).AsString :=tempvalue[temploop1];
                 Post;
                 inc(result);
               end;
             end;
             end
             else
             begin
               Insert;
               tempvalue := nil;
               setlength(tempvalue,QRCOLcount);
               for temploop3 := 0 to temploop3-1 do
               begin
                 temppoint := ValueTlist.Items[temploop2*QRCOLcount+temploop3];

                 FieldByName(FieldNames+inttostr(temploop3)).AsString :=temppoint.fidlename;
                 tempvalue[temploop3] := temppoint.fidlevalue;


                 if temploop3 = QRCOLcount-1 then
                 begin
                   Post;
                   inc(result);
                   Insert;
                   for temploop1 := 0 to temploop1-1 do
                   FieldByName(FieldNames+inttostr(temploop1)).AsString :=tempvalue[temploop1];
                   Post;
                   inc(result);
                 end;

               end;
             end;

           end;

         end;  //for temploop2 := 0 to temploop2-1 do

       end;
     end;
    end;
  finally
    templist.Free;
    temptable.Free;
  end;
end;

//接着就是动态建立TQRDBTEXT控件
//SenderParent: TGSQuickReport  只是一个普通的TQuickRep
//TGSQuickReport = class(TQuickRep) 只是程序建立时不要让它自动建立
//Cols是用户定义的列数
procedure TForm1.FormatQRFormWithDataset(NowDataset: TDataset; Cols: integer; SenderParent: TGSQuickReport);
var
  tempqredit: TQRDBText;
  temploop1: integer;

  nowtop,nowleft: integer; //当前的起点
  nowDetailWidth: extended;
  everylabwidth:extended;  //每个Lable的宽度和高度
  nowcol: integer;
const
  FieldNames = 'tempfd';
begin
  if SenderParent = nil then exit;
  nowcol := Cols;
  nowtop := 0;
  nowleft := 0;
  nowDetailWidth := trunc(SenderParent.DetailBand1.Size.Width);

  everylabwidth := trunc(nowDetailWidth / nowcol);
  for temploop1 := 0 to nowcol -1 do
  begin
    tempqredit := TQRDBText.Create(self);
    tempqredit.AutoSize := false;
    tempqredit.AutoStretch := false;
    tempqredit.Color := clskyblue;//clmoneygreen
    tempqredit.Parent := SenderParent.DetailBand1;
    tempqredit.Top := nowtop;
    tempqredit.Left := nowleft;
    tempqredit.Size.Width := everylabwidth;
    tempqredit.DataSet := NowDataset;
    tempqredit.DataField := FieldNames + inttostr(temploop1);

    nowleft:= nowleft + tempqredit.Width;
  end;
end;


//当以上三个步骤作完之后就基本成功了
下面一个是一个Button下的命令过程
procedure TForm1.BitBtn11Click(Sender: TObject);
var
  temptlist: Tlist;
  tempcount: integer;
  temppoint: pNowPrintvalue;
  tempQR: TGSQuickReport;
  temptable: TTable;
const
  tempdbname = 'temprint.DBF';
begin
  temptlist := Tlist.Create;
  temptable := TTable.Create(nil);
  tempQR := TGSQuickReport.Create(nil);
  try
    self.OpenDialog1.InitialDir := projectpath;
    self.OpenDialog1.Title := '';
    self.OpenDialog1.Filter := '';
    if self.OpenDialog1.Execute then
    begin
      CreateQRTlistByTTable(self.OpenDialog1.FileName,temptlist);
      if temptlist.Count <= 0 then exit;
      tempcount := WriteQRTempDBF(temptlist,4);
      if tempcount > 0 then
      begin
        temptable.Close;
        temptable.DatabaseName := BDEName;
        temptable.TableName := tempdbname;
        temptable.Open;
        tempQR.DataSet := temptable;
        FormatQRFormWithDataset(temptable,4,tempQR);
      end;
      tempQR.PreviewModal;
    end;
  finally
    temptable.Close;
    temptable.Free;
    temptlist.Free;
  end;
end;


//这里再补充两个函数,一个是建立数据库字段信息的函数,一个是动态建立数据库的函数
Function CreateTempQRFieldList(cols: integer;var resultlist: Tlist): integer; //建立打印数据库文件列表
var
  FieldNames: array of string;
  FieldDatas: pFieldDatas;
  Temploop: integer;
const
  FieldSize = 40;
  FieldType = ftString;
  tempfieldname = 'tempfd';
begin
  resultlist.Clear;
  result := 0;
  if cols <= 0 then exit;
  setlength(FieldNames,cols);
  for Temploop := 0 to cols-1 do
  begin
    New(FieldDatas);
    FieldDatas.DataFieldName := tempfieldname + inttostr(temploop);
    FieldDatas.DataFieldType := FieldType;
    FieldDatas.DataFieldSize := FieldSize;
    resultList.Add(FieldDatas);
  end;
  result := resultList.Count;

end;


Function CreateDatebases ( Tabless : TTable; //table控件名
                            DBNames : string;  //数据库别名
                            TNames : string;   //数据库名
                            TTypes : TTableType; //数据库类型
                            CreateDBFList: Tlist;    //数据库内容的列表
                            CreateIt: boolean): integer;
var
  TempDatas: pFieldDatas;
  TempCounts: integer;
begin
  result := 0;
  TempCounts := CreateDBFList.Count;
  if TempCounts <= 0 then exit;
  Tabless.Close;
  with Tabless do
  begin
     DatabaseName := DBNames;
     TableName := TNames;
     TableType := TTypes;

       with FieldDefs do
       begin
         //if Createit then Clear;
         clear;
         for TempCounts := 0 to TempCounts - 1 do
         begin
         TempDatas := CreateDBFList.Items[TempCounts];
         Add(TempDatas.DataFieldName,TempDatas.DataFieldType,TempDatas.DataFieldSize,false);
         inc(result);
         end;
       end;
     CreateTable;
  end;
  Tabless.Close;
end;


此前已经有转载。感谢作者提供学习的资料。

 

 2004-4-6 11:48:29   如何根据名字来动态创建对象

[问题的提出]:
    我希望根据一个字符串,来创建该类的对象,例如我给定'TButton',那么能在运行的时候,动态创建Button出来?不要告诉我用if来判断或者用case来判断等等~,那样的话,有几百个控件的话,岂不是晕倒?

[解决方案]:
    请参考下面的代码,下面的代码演示了三种控件的动态创建,若需要动态创建其他的,请修改那个数组常量即可:

function DynCreateControlByName(AClassName: string; AOwner: TWinControl = nil): TControl;

const
/// You can add any class if you want!
  ControlClass : array[0..2] of TPersistentClass = (TButton, TEdit, TLabel);

var
  Cls : TControlClass;

begin
  Result := nil;
  RegisterClasses(ControlClass);
  Cls := TControlClass(GetClass(AClassName));
  if Cls = nil then exit;
    Result := Cls.Create(AOwner);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Control : TControl;
begin
  Control := DynCreateControlByName(Edit1.Text);
  if Control <> nil then
    with Control do
    begin
      Parent := Self;
      Left := Random(Self.Width) - Width;
      Top := Random(Self.Width) - Height;
      Perform(WM_SETTEXT,Length(Edit1.Text),integer(pchar(Edit1.Text)));
      Show;
    end;
end;
---------------------------------------

procedure TForm1.Button2Click(Sender: TObject);
begin
  TWinControlClass(FindClass('TQRDBText')).Create(Self);
end;

initialization

RegisterClasses([TQRDBText]);

finalization
  UnregisterClasses([TQRDBText]);
end.

Posted in 软件开发 at April 18, 2006. by 傻猫 .    Views: 5609    2 Comments