最近学了不少程序方面的技巧，包括数据库三层结构的搭建，以前全是写的C/S两层模式的程序，了解三层结构后，确实要高级得多。
将所有事件全封装在中间件上，客户端通过中间件访问数据库，从安全方面，从效率和速度上都有很大的优势。
另外显示数据的容器用StringGrid而不用DBGrid也是一大优势，前者功能强大，后者就要弱很多，技巧性。灵活性方面，DBgrid的劣势就显露出来了。
最近写了一个动态菜单，通过数据库信息来动态生成菜单。
另外写了一个数据库日志清理工具，随着使用SQL的时间越来越长，数据表的系统日志就会越来越大，这个工具就可以清理LOG文件。
8年前,初中毕业后,一个人来到这座陌生的城市求学.
5年前,完成学业,踏入社会,第一份打字员的工作,每月400元的工资让我心喜若狂.我,我终于开始赚钱了.
在打字复印店里做了9个月后,慢慢地,越来越不能适应环境,过完春节后,在老板的一再挽留下,挥袖离开.
在打字复印店里,让我学会了如何使用打印机,复印机,传真机.并学会了简单的维护维修.也学会了操作系统的安装(ps:当时有两台电脑,其中之一经常出问题,所以也给了我练手的机会.呵呵)
4年前,我进入好棒食品公司,一边做电脑方面的工作,另一方面也进车间做工.他们主要生产调味品,全手工制作,还出口美国.工资每月也就6,7百.其中有两个月要赶货,连续加班.从早上7点就开始上班,晚上要做到8点左右.
那是夏天的时候,每天的衣服都要湿透好几次.或许是太苦的原因吧,我决定再去上学.
进入电子科大自考班后,在学校玩游戏比较多吧,每次考试基本上都是60分,全班六零炮最多的就是我.班上有近120人,我认识的可能也就20个人吧,由于是自考,老师上课时,想去就去,不想去就在寝室睡觉.
我自己都有很多次睡觉不去上课的经历,班主任是位女老师,到寝室来教我们去上课,把被子包住头不理她,反正她也不会来掀开被子.
游混的日子中,上课听老师讲课不是我的最爱.
我喜欢自己弄本书来看,喜欢在网上游,喜欢自己学点东西. 就在那段时候,我自己搞游戏私服,有传奇2,传奇3.
收获最大的是传奇3, 由于它的数据库跟传奇2不一样, 要用到SQL2000. 花了我周末两天时间,才把它数据库调通,由此我也学会了SQL2000的基本操作. 平时喜欢下载一些Delphi源代码来看,慢慢地, 开始搞点小程序.
最有代表的是那个时候写的<网页助手>,一个收集了近千种网页特效的工具软件.
自考毕业后, 准确地说,还不算毕业,因为还有几本功课还没考过, 毕业证还没有拿到. 我凭着一股初生牛犊不怕虎的劲进入艾普网络公司.
或许是我太幸运了吧, 在招聘会遇到了公司很好的谢总. 他给我机会让我到公司面试.
到公司后又遇到了跟我年龄稍微大点的波哥, 他给了我机会让我做公司的网站. 两个星期的时候, 我在网上找了一个韩国模板,把公司网站改了一下版. 从版面,美工各方面较以前相比是唤然一新.
所以公司让我留了下来.后来又给公司搞了一个管理软件.
在艾普的点点滴滴让我成长, 走过将近两年时间, 让我各方面都长进了很多.有空再把其中的经历慢慢道来.
三个星期前, 我离开了艾普,进入了一个蓝冰软件公司.
进入软件公司作为一名程序员,心里无比的高兴,同时又再一次站在了起跑线上,等待更多的挑战.
天生我才必有用, 站在巨人的肩上, 才能让我看得更高更远.
不经意地，搜索到一张黄桷兰的图片，让我顿时欣喜若狂。看着那碧绿水灵的叶子，妩媚洁白的花朵，我似乎又隐隐嗅到了那直沁心脾的清香。
爱黄桷兰，就是缘于爱黄桷兰的清香，丝毫不做作的清香。忽而浓，忽而淡，在浓和淡之间让人捉摸不定，但又感觉的的确确地在透过口鼻，浸进肺腑，又在经络里弥漫开来，一种心旷神怡的清爽油然而生。
每到黄桷兰开花的季节，大街小巷就会出现许多走窜着贩卖黄桷兰的花农，挽着一个编织得细密的竹蓝，用一块潮湿的毛巾覆盖了约莫半蓝子的花朵。竹蓝的边沿插上一枝剃尽了叶子的竹枝，挑上数挂细线穿成的花串，人还未走近，一阵清香就会迎面拂来。
那些串成串的花朵，常被爱美的人们用来挂在胸口的纽扣上熏染自己。如若再配上一两叶青嫩的黄桷兰树叶，走起路来绿和白一起晃动，越发的相得益彰了。
黄桷兰：木兰科、木兰属、落叶乔木。
黄桷兰怎样栽培管理?
黄桷兰是早春色、香俱全的观花树种，栽植时，要掌握好时机，不能过早、也不能过晚，以早春发芽前10天或花谢后展叶前栽植最为适宜。移栽时，无论苗木大小，根须均需带着泥团，并注意尽量不要损伤根系。以求确保成活。栽植前，应在穴内施足充分腐熟的有机肥作底肥。栽好后封土压紧，并及时浇足水。
黄桷兰花较喜肥，但忌大肥；生长期一般施两次肥即可有利于花芽分化和促进生长。一次是在早春时施，再一次是在5-6月份进行。肥料多用充分腐熟的有机肥。新栽植的树苗可不必施肥，待落叶后或翌年春天再施肥。黄桷兰的根系肉质根，不耐积水。开花生长期宜保持土壤稍湿润。入秋后应减少浇水，延缓黄桷兰生根，促使枝条成熟，以利越冬。冬季一般不浇水，只有在土壤过干时浇一次水。黄桷兰枝干伤口愈合能力较差，故一般不进行修剪。但为了树形的合理，对徒长枝、枯枝、病虫枝以及有碍树形美观的枝条，仍应在展叶初期剪除。此外，花谢后，如不留种，还应将残花和蓇葖果穗剪掉，以免消耗养分，影响来年开花。
黄桷兰多为地栽，盆栽时宜培植成桩景。
以前也有过好几次，去年买过好几条金鱼，每次都是一对一对的，到西天极乐世界也很快，买回来没多久，就死咯。
有被太阳晒死的，有被食物撑死的（饲料放的太多），有被丑死的（N久没换水），这次更怪了，刚刚买回来的时候，我就跟MM开玩话说，这条大的金鱼代表偶，这条小的金鱼代表你，看看那个的命更长，买回来没隔几个小时，那条小金鱼就上天了，555555555
小金鱼上天后，我发现那条大的身上有很明显的伤痕，难道他们曾经有过一场恶战么？
这几天，我每天早上起来/晚上下班回来第一件事情就是给金鱼换水，卖金鱼的老板说的，要经常换水，不然就容易死。
前天去一个朋友家里，他们也喂了好几天金鱼，她给偶说，不能换的太勤了，水太冷它可能受不了的，经常换水让他每次都要适合环境，要放到通风的地方，一个星期换一次水就可以，她还特地买了一条吃金鱼屎的鱼，叫什么名字我记不起来了，居然在家里搞起了生态循环了，呵呵。
这时想到金鱼老板说的话，我......倒......
一. 如何初始化一个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;
以前用过很多次取款机(ATM),昨天去工商银行去存款,好在网上买本书,找遍磨子桥到数码广场的几条街,其它银行全都有,唯独没有工商银行,简直气煞我也.
回头在路边问了一非常热心的小贩
,她告诉我就在川大对面有一个,我急忙跑过去,已经是8:15了,银行要8:30才开始营业,郁闷了,还要等一段时间,又怕一会到公司迟到.后来,偶发现银行旁边有好几个柜员机,进去一看,有一个存款机,哈哈,马上看了一下使用说明,放了三张钞票和银行卡进去,咕噜咕噜一阵声音后,柜员机点钞完毕,要偶确认.正确无误,嘿嘿.存完钱后,大摇大摆走出银行,直奔公司.
科学技术就是第一生产力啊,节省了时间,24小时营业,存款机太方便了,尽量不要出什么错误就OK啦.
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函数或其他默认的窗口过程。
一、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 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.
Borland is deprecating the use of the TServerSocket
and TClientSocket from the unit ScktComp. It is
recommended that you use the Indy components for
socket operations. The TServerSocket and
TClientSocket will no longer be installed on the
component palette by default. If you require the
use of these components then you can install
the design time package named dclsockets70.bpl,
found in your bin directory. For deployment with
runtime packages, you will need to deploy rtl70.bpl
and any other required packages
偶简单翻译了一下:TClientSocket 本来是D5默认安装的,但是D7使用的Indy组件后,就没有默认安装了,如果你喜欢这个组件,可以在D7的安装目录bin文件夹找到dclsockets70.bpl组件包,安装上去就OK了.rtl70.bpl是TCientSocket和TServerSocket必需的运行包.
procedure TFmMain.N3Click(Sender: TObject);
var
filename:string;
begin
filename:=ExtractFilePath(paramstr(0))+'dbconf.ini';
myinifile:=Tinifile.Create(filename);
ADOConnection1.Close;
EditConnectionString(ADOConnection1);
myinifile.WriteString('dbconf','connectstring',adoconnection1.ConnectionString);
myinifile.Free;
end;
