在Delphi编程中的文件操作 http://news.softhouse.com.cn/news/show/15723.html
delphi关于文件操作的函数 http://www.cncfan.com/cncfan_com_article.asp?art_id=2502&cat_id=74
关于文本文件http://www.75pc.com/viewthread.php?tid=2586，http://www.27a.cn/data/2006/0524/article_7616.html
还有一种比较方便的方法，利用TStringlist来读写文本文件，http://delphi.apub.org/doc/2006/05/15/16/44/36/157973.html，http://www.bczs.net/xml/2006/3/7/4597696.xml，http://www.xx0123.com/Article/Article_View_824.html
Delphi中根据分类数据生成树形结构的最优方法作者 http://www.delphiun.com/article_view.asp?id=680
《Delphi7完美经典》之第15章有delphi到各种数据库的连接(paradox,dBase,MSSQL,MySql,Access)－－实用过。不错！
另，该书第16章有delphi访问数据库的架构，perfect！
SQL SERVER跨库查询：因为程序里建立连接时已经有了服务器和数据库， 库 connGZ.Provider="SQLOLEDB.1" connGZ.ConnectionString="DATABASE=SMS_DB;SERVER=10.244.74.2;UID=sa;PWD=;" 那跨库查询时应该怎么建立连接才能同时访问两个数据库呢？ 请多多指教，谢谢！
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
如果两个数据库在同一个服务器，那不必改变连接，查询时用 select * from SMS_DB1..tablename select * from SMS_DB..tablename （以验证，注意SMS_DB1与tablename之间的两个点）
---------------------------------------------------------------
如果不是以管理员的身份连接数据库的话，牵涉用户授权的问题，估计就不会这么简单了
---------------------------------------------------------------
把你的程序修改一下，对另外一个数据库也连接。 可能要另外定义一个 connGZ connGZ.Provider="SQLOLEDB.1" connGZ.ConnectionString="DATABASE=SMS_DB;SERVER=10.244.74.2;UID=sa;PWD=;"
怎样对几个计算机上的数据库同时进行读写？？？？（未验证）
建立一个异构查询的一般步骤是这样的：
第一步，把一个TQuery构件放到窗体或数据模块上，让DatabaseName属性空着。
第二步，为要查询的每一个数据库建立一个单独的BDE别名。
第三步，设置SQL属性以指定要执行的SQL语句。在SQL语句中，表的名字前要加别名和冒号，并且用双引号括起来。字段名前要加表名和小圆点。例如：
SELECT Customer.CustNo, Orders.OrderNoFROM "Oracle1:CUSTOMER"JOIN "Sybase1:ORDERS"ON (Customer.CustNo = Orders.CustNo)WHERE (Customer.CustNo = 1503)
第四步，设置Params属性提供参数。
第五步，调用Prepare通知BDE或服务器做好准备，然后调用Open或ExecSQL执行查询。
如果显式地使用TDatabase构件连接数据库，并且设置了它的DatabaseName属性定义了应用程序专用的别名，在SQL语句中可以用专用的别名代替BDE别名。
Delphi中的INI文件编程 http://bbs.why99010.com/thread.jsp?boardid=13&threadid=727
http://www.cncfan.com/cncfan_com_article.asp?art_id=1980&cat_id=74
应用程序级信息 http://www.itfat.com/tech/delphitech/delphitech20060305/64359.htmlDelphi经验技巧集锦
http://www.5uwl.net/Article/msmir400/msmir501/msmir502/200601/5130.html
读注册表 http://www.delphibbs.com/keylife/iblog_show.asp?xid=4463
列出SQL SERVER数据库中所有表及字段信息 http://www.wangchao.net.cn/bbsshowlist.jsp?parent_id=26128&area_id=02&board_id=01
列出sql server数据库中所有数据库的所有表信息
sp_helpdb//获得数据库服务器上的所有的数据库的信息
use databasename//先将数据库服务器的默认数据库改为databasename
sp_tables//然后列出改数据库的表的信息
利用上面的三个语句可以完成目标.
在程序运行期动态改变控件位置和大小，http://www.evget.com/articles/evget_1317.html，http://iask.sina.com.cn/b/1342619.html （）第一篇文章中的prec的意义参见第二篇中的conprec
在使用qreport的时候，如果要动态改变page.papersize之类的属性，要引用QRPrntr单元。
在TTreeView中有三个结点，其父子关系为a->b->c，其中b还有很多其它的子结点，要选中c并且让treeview自动展开到c：treeview.selected := c; b.expand(true); (大概是这样。)
字体大小与像素的关系：n号字的意思好像是n磅字，1磅=1/72英寸，所以
font所占像素数：=round(font.pixelsPerInch*font.size/72);
QRPreview控件怎么用呢？
http://www.faq-it.org/archives/delphi_database/c1926d996859d003b788ba37adb4c5cd.php
在delphi中使用了异常捕捉机制后，在调试的过程中，在编译状态下会先出现系统的出错提示的，再运行一次，就会出现设置的异常提示。或者脱离编译状态运行可执行文件，就可以了。
在窗体按钮的单击事件中设置ModalResult := mrOK 后不用调用Close即可关闭窗口，若调用Close则导致ModalResut 为mrCancel
delphi 讀取 excel 範列
http://w2.sy3es.tnc.edu.tw/blogs/index.php?blog=3&title=delphi_er_a_excel_cm_a&more=1&c=1&tb=1&pb=1
请问如何用delphi读取excel文件的内容？
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1994205
Delphi与Excel的亲密接触
http://www.cn-doc.com/_soft_delphi_tech_doc/2005_08_18_01/20050818012558978.htm
用DELPHI把数据库中的数据导入excel中?
open application within Windows in Delphi
use shellAPI
var handle:Word
shellexecute(handle,'open',filename,nil,nil,SW_SHOW);
note:filename is as 'c:/tmp/1.html' or 'c:/tmp/1.txt' or ''
you can also use OLEObject to deal this problem
you can also use the components in the servers page of Delphi IDE to open application such as office.去掉窗口的标题栏：
今天考虑作界面的时候，想去掉窗体的标题栏，但设置 Form.BorderStyle := bsNone; 会导致窗体不可再 Sizeable （通过鼠标操作改变窗体大小），仔细翻看了相关Help也没找到解决办法。
在DFW里终于搜索到答案：
// 对指定窗体设置属性
SetWindowLong(Handle, // 当前窗体句柄
GWL_STYLE, // 表示当前是要设置新的窗体（普通）样式
// 得到指定窗体信息
GetWindowLong(Handle, GWL_STYLE)
and (not WS_CAPTION)); // 去掉样式(s)中的“标题”样式
Height := ClientHeight;
Width := ClientWidth;
去掉窗体中的最大化，最小化，关闭按钮
修改BorderIcons中的几个属性，即可。
自 定 义 快 速 报 表 的 打 印 预 览 窗 口
http://www.chinadz.com/~wzdz/free/free/delphi/def_preview.htm
there is a problem in the above artile.
It uses a private field 'pagecount' stands for the total page number.But in fact the field dosen't effect.
There is 'quickrep.qrprinter.pageCount' been defined to effect.
在Delphi中实现数据分析模块的动态报表
重庆 张仁平、双海军、卜淮原
一、问题的提出
---- Delphi作为强大的数据库开发工具，正被愈来愈多的编程人员所采用，"聪明的程序员用Delphi"更形象生动的道出广大程序员的心声，但这并不意味着所有功能的实现都非常容易，例如，笔者在开发军队的某个信息系统中，就在为数据分析模块中DecisionGrid1控件的数据进行报表输出时走了不少的弯路。广大的Delphi的爱好者在今后的学习或工作中也有可能会遇到类似的问题，而在许多参考书中，很少有甚至没有关于它们的解决方法，于是，我想花费一点时间把它整理出来，以供大家参考。本文中报表动态生成的公用模块具有很大的灵活性和易操作性，其中的思路、实现的功能和通用性等方面的优缺点就由大家看了本文后自有定论。
二、建立报表的动态输出公用模块
---- 下面，结合公司人事管理信息系统说明其实现的方法和技术。
---- 1、基本思路：首先从DecisionGrid1中获得报表所需数据，放到二维数组PA中，然后在C:/DataWork中动态创建一个数据表tjb.dbf，存放报表数据，最后用T able1与tjb.dbf相连接，以后工作就与一般的动态输出报表(如查询报表)相类似，在这里我就无须赘述了。
---- 2、建立窗体文件：放入六个用于数据分析的常用控件DecisionQuery1、DecisionSource1、DecisionCube1、DecisionGraph1、DecisionPivot1、DecisionGrid1，设置DecisionSource1的decisionCube属性为decisionCube1，decisionCube1的Dataset属性为decisionQuery1、decisionQuery1的DatabaseName属性为c:/datawork；一个Table1控件，用于连接数据表tjb.dbf；一个QuickRep1控件，用于数据的报表输出；两个Button1和Button2控件，其Caption分别设为"报表输出"和"返回"。分别设置decisionCube1的Dataset属性为decisionQuery1、decisionQuery1的DatabaseName属性为c:/datawork.。
---- 3、单元文件的主要控件代码 Button1控件的代码如下(定义变量部分略)，主要分以下8个功能块来加以说明：
---- ⑴删除同名或上一次建立的数据表
if FileExists('c:/DataWork/tjb.dbf') then
deletefile('c:/ DataWork /tjb.dbf');
---- ⑵根据DecisionGrid1控件的cells属性，获得报表所需数据，并将其默认的'Sum'值汉化成'总计'、'合计'、'小计'以符合汉语的习惯要求，所求得的数据存放于二维数组PA中
for i:=1-DecisionGrid1.FixedCols to DecisionGrid1.
ColCount-DecisionGrid1.FixedCols-1 do
for j:=0-DecisionGrid1.FixedRows to DecisionGrid1.
RowCount-DecisionGrid1.FixedRows-1 do
begin
pa[i,j]:=DecisionGrid1.cells[i,j];
//处理DecisionGrid1控件中固定列的值为'Sum'的数据项
if ((i=1-DecisionGrid1.fixedcols) and (pa[i,j]='Sum')) then
pa[i,j]:='总 计'
else if ((i = -1) and (pa[i,j]='Sum')) then
pa[i,j]:='小 计'
else if ((i<-1) and (i>1-DecisionGrid1
.FixedCols) and (pa[i,j]='Sum')) then
pa[i,j]:='合 计';
//处理DecisionGrid1控件中固定行的值为'Sum'的数据项
if (pa[i,j]='Sum' ) and (j=-1) then
pa[i,j]:='总 计';
end;
---- ⑶用T able1动态创建数据表tjb.dbf
Table1.Active:=false;
with Table1 do
begin
DatabaseName := 'c:/DataWork';
TableName := 'tjb';
TableType := ttDBase;
with FieldDefs do
begin
Clear;
for i:=1 to 40 do
Add(IntToStr(i),ftString,30, False);
end;
CreateTable;
end;
//下面将DecisionGrid1控件中的数据放入数据表中
Table1.Active:=true;
for j:=1-DecisionGrid1.FixedRows to DecisionGrid1.RowCount-DecisionGrid1.FixedRows-1 do
begin
K:=0;
Table1.Insert;
for i:=1-DecisionGrid1.FixedCols to DecisionGrid1.ColCount-DecisionGrid1.FixedCols-1 do
begin
Table1.Fields[K].AsString:=pa[i,j];
K:=K+1;
end;
Table1.Post;
Table1.Next;
end;
---- ⑷下面代码确定输出报表的每列宽度
SetLength(M,DecisionGrid1.ColCount);//动态设置数组
copy(M,1-DecisionGrid1.FixedCols,DecisionGrid1.ColCount-DecisionGrid1.FixedCols-1);
//重新设置动态数组的起始位置
for i:=1-DecisionGrid1.FixedCols to DecisionGrid1.ColCount-DecisionGrid1.FixedCols-1 do
begin
M[i]:=0;
for j:=1-DecisionGrid1.FixedRows to DecisionGrid1.RowCount-DecisionGrid1.FixedRows-1 do
IF M[i]< Length (Trim (PA[I,J]))*8 THEN M[i]:= Length (Trim (PA[I,J]))*8;
end;
---- ⑸如果要求输出报表的列宽相同(除DecisionGrid1控件的固定列，下同)，可将数据项的最大列宽作为输出报表的列度，如果不要求，可跳过下面代码
max:=0;
for i:=0 to DecisionGrid1.ColCount
-DecisionGrid1.FixedCols-1 do
if m[i]>max then max:=m[i];
for i:=0 to DecisionGrid1.ColCount-DecisionGrid1.FixedCols-1 do
m[i]:=max;
ZK:=0;//报表总宽
for i:=1-DecisionGrid1.FixedCols to DecisionGrid1
.ColCount-DecisionGrid1.FixedCols-1 do
ZK:=ZK+M[i]+1;
---- ⑹判断报表的宽度，超宽？横向报表？还是纵向报表？
if ZK>1123 then
begin
Application.MessageBox('报表超宽，
请调整再输出！','警告', 1);//输出对话框
exit;
end
else if ZK>794 then
QuickRep.Page.Orientation:=poLandscape //横向
else
QuickRep.Page.Orientation:=poPortrait;//纵向---- ⑺以下代码完成了动态数据报表，与一般的动态输出报表功能相类似，
for i:=1 to QuickRep.Bands.TitleBand.
ControlCount DO//取消系统对控件的控制，下同
QuickRep.Bands.TitleBand.RemoveControl
(QuickRep.Bands.TitleBand.Controls[0]);
for i:=1 to QuickRep.Bands.DetailBand.ControlCount DO
QuickRep.Bands.DetailBand.RemoveControl
(QuickRep.Bands.DetailBand.Controls[0]);
SetLength(QRShape,DecisionGrid1.ColCount); //动态设置数组
SetLength(QRDBText, DecisionGrid1.ColCount); //动态设置数组
K:=0;//动态生成对象的数，
Lx:=(QuickRep.Width-ZK)DIV 2;//生成对象的左坐标
//报表的动态生成
For j:=1-DecisionGrid1.FixedCols to DecisionGrid1.ColCount-DecisionGrid1.FixedCols-1 do
begin
QRShape[K]:=TQRSHAPE.Create(tj1);//自定义对象的创建(下同)
QRShape[K].Parent:=QuickRep.Bands.DetailBand;// 自定义对象的父类对象(下同)
QRDBText[K]:=TQRDBText.Create(tj1);
QRDBText[K].parent :=QuickRep.Bands.DetailBand;
QRShape[K].LEFT:=Lx;//生成对象的左坐标
QRShape[K].WIDTH:=M[J]+2; //生成对象的宽度
QRShape[K].HEIGHT:=QuickRep.Bands.DetailBand.Height+1; //生成对象的高度
QRShape[K].TOP:=-1; //生成对象的纵坐标
QRDBText[K].WIDTH:=QRShape[K].WIDTH-10;
QRDBText[K].Left :=QRShape[K].LEFT+1;
QRDBText[K].HEIGHT:=QRShape[K].Height div 2;
QRDBText[K].Top :=QRDBText[K].Height div 2+QRShape[K].Top;
QRDBText[K].AutoSize:=false;
QRDBText[K].Alignment:=taCenter; //生成对象居中
QRDBText[K].DataSet:=Table1;
QRDBText[K].DataField:=IntToStr(k+1);
Lx:=Lx+M[J]+1;
Inc(k);
end;
//动态生成报表的标题
Caption := TQRLabel.Create(tj1);
Caption.Parent := QuickRep.Bands.TitleBand;
Caption.Alignment:=taCenter;//标题居中
Caption.Width:= Length (Trim (ptitle))*8; //标题的宽度
Caption.Left:=(QuickRep.Width- Length (Trim (ptitle))*8)div 2; //标题的左坐标
Caption.Height:=QuickRep.Bands.TitleBand.Height-1; //标题的高度
Caption.Top:= 0;
Caption.Caption:=ptitle; //标题的名称
，ptitle为调用该公用模块时的输入参数
QuickRep.DataSet:=Table1;
QuickRep.Preview;
⑻动态生成对象的内存释放
k:=0;
for j:=1-DecisionGrid1.FixedCols to DecisionGrid1
.ColCount-DecisionGrid1.FixedCols-1 do
begin
QRShape[K].Free;
QRDBText[K].Free;
inc(k);
end;
Caption.Free;
Table1.Active:=false;//关闭数据表
end;
---- 以上程序是在Delphi 4.0中调试通过，其数据文件应放在C:/DataWork，类型为DB或DBF。
三、应注意以下几个问题
---- 1、QuickRep1的Bands中的HasColumnHeader、HasDetail、HasTitle三个属性必须设置为true；
---- 2、不能忘记公用模块中QuickRep对象的DataSet属性设置，即源代码中的QuickRep.DataSet:=Table1语句；
---- 3、动态生成组件的宽度计算必须放在定义其字体属性完成后进行；
---- 4、另外，动态数组给定的内存(即数组容量)以及指定动态数组的起始位置(不一定为0，根据DecisionGrid1控件的固定列确定)很重要，因为一方面当数据库很大时它会大大减少内存的消耗，另一方面便于操作该数组，大大增强了程序的灵活性和通用性。
---- 5、如果让QRDBText控件的数据居中，必须先设置其AutoSize属性为false，然后才能设置其Alignment属性为taCenter。这一点往往容易忽略，直接设置Alignment属性为taCenter，往往达不到数据居中的目的。
四、结束语
---- 当然，由于客户对数据报表的可能特殊要求，此公用模块或许不能完全解决。但是，作为公用模块，能实现实现代码的重复利用，提高我们开发程序的效率，当然可以在此模块的基础上进行一些修改或补充，以满足大多数用户的要求，用以下两点加以说明。
---- 1、如果要对数据表的字段进行动态选择输出，则可
用Delphi制作中国式报表
http://www.studynew.com/study/Delphi/20050416112107650521309.html
delphi中如何安装组件
http://zhidao.baidu.com/question/4403505.html
delphi中如何安装组件有五种情况： 1 只有一个DCU文件的组件。DCU文件是编译好的单元文件，这样的组件是作者不想把源码公布。一般来说，作者必须说明此组件适合Delphi的哪种版本，如果版本不对，在安装时就会出现错误。也正是因为没有源码，给使用者带来了不便，那就是一旦Delphi版本升级，此组件就不能再使用了，当然有的作者给出了几种版本的DCU文件，用户根据需要选择使用。这样的组件的安装方法是：在Component菜单中，选择install component，在对话框 "into existing package"页中，单击“Unit file name”后的“Browse”按扭，在打开的文件对话框中，将“文件类型”设定为*.dcu，找到要安装的DCU文件，按OK按钮返回"into existing package"页后再按OK按钮就可以安装了。注意，此时Delphi会提示dclusr40.dpk将被重建，是否继续，OK就可以了。这里是将组件安装到dclusr40.dpk包中，此包从文件名上可以看出是用户自定义组件包，先安装到这个包中吧，下面再讲有关注意事项。安装完毕会有已经将组件注册完的提示信息以及安装到哪个组件页中的信息等，到组件面板上看看，一般会出现一个新的组件页，其中有刚安装的组件。
2、 只有PAS文件或既有PAS又有DCU文件的组件。这种组件因为有PAS文件，也就是说作者提供了源码，这就好办多了。安装的方法和上面是一样的，在文件类型中可以设定为DCU也可以设定为PAS，建议设定为PAS，这样可用你的Delphi重新编译一下，看是否会出现问题。Delphi升级后只能选择PAS文件安装，这样才能重新编译，使得组件能适应新Delphi版本。这样的组件是很值得使用的，根据心铃的经验，没有源码的组件最好不要使用，一是存在Delphi版本升级后无法使用的问题，再者当程序出现问题后用户无法调试组件来判断是否是组件中存在BUG。
3、有dpk文件的组件包。带有dpk文件的组件包一般是有多个组件构成的，也就是说安装后会有多个组件供使用，如果只有一个组件作者一般不会制成DPK文件，使用上面的方式发布就可以了。对于这样的组件包，一般来说会有详细的安装说明文件，如上面提到的RXLIB，由于组件复杂且安装时有先后顺序，作者不提供安装说明用户根本无法正确安装。如果没有安装说明文件，那么用下面的方法安装：在File菜单下，选择”OPEN…”打开dpk文件(文件类型列表框中选*.dpk)，在出现的Package窗口中，工具栏上有Install按钮，按此按钮即可进行安装。如果Install按钮处于无效状态，那么先按Compile按钮编译，一般来说编译之后Install按钮就会处于有效状态，此时再按Install按钮就可以了。
4、 带有Bpl文件的组件包。一般来说这也是由多种组件构成的组件包，它其实是一个动态连接库文件（DLL）。对于这种组件包的安装方法是：在component菜单下选择“install packages”，然后单击Add按钮，在打开的文件对话框中找到相应的bpl文件打开返回后，再单击Ok按钮就可以了。
5、ActiveX控件的安装。要安装这类控件，需要先用regsvr32.exe注册，然后选择Component菜单中Import ActiveX Control项。在Import ActiveX Control打开的窗口中，只有已经注册的ActiveX控件才出现在列表中，选中一个然后按Install按钮就可以安装了。如果事先没有用regsvr32.exe注册也可以按ADD按钮找到OCX文件即时注册，注册后再进行安装。
在Delphi中使用自定义光标
2000-08-11 15:23 摘自:网易
开发者都希望自己的程序有一个友好的界面，此时，一个生动活泼、有表现力的光标就必不可少了。Windows 缺省提供22种标准光标供在程序中调用，但对一个求新求变的程序员来说，标准光标就不能满足要求了，需要使用自己的光标，那么，在程序中怎样使用自己的光标呢？
●光标资源的获得
要使用自定义光标，必须先得到这些光标。光标文件有两种：静态光标(.cur)和动态光标(.ani)。你可以使用现成的光标文件，比如Delphi 自带的一组光标文件(在C:/Program Files/Borland/Delphi 3/Images/Cursors目录中)，如果你安装了Windows98的桌面主题，则可在/Windows/plus! 目录下找到许多光标文件。你也可以自己创建光标文件，比如使用Delphi自带的Image Editor 就可创建静态光标文件(.cur），但Image Editor不能创建彩色光标，要创建彩色光标，必须使用其它工具，如Vc＋＋ 的资源编辑器。动态光标则必须使用专门的工具软件制作，使用动态光标可达到光标的动画效果，动态光标文件的文件结构与AVI文件结构相似，由文字描述区、信息区、时间控制区、数据区四部分构成。Windows通过按文件时间控制区中指定的时间一帧帧播放文件数据区中包含的光标或图标图像来实现动画效果。
其实，分析文件结构可以发现，静态光标文件(.cur)与图标文件(.ico)结构非常类似，两种文件的主要差别仅在于文件头的文件识别码和是否存在跟踪点(Hot Spot)。文件识别码放在文件的头三个字节，图标文件为00 00 01，光标文件为00 00 02；图标文件没有跟踪点，光标文件的跟踪点信息放在文件的00 0A－00 0D 四个字节中，00 0A － 00 0B记录跟踪点的X 坐标，00 0C－00 0D 记录Y 坐标，记录顺序都是高位在前，低位在后，图标文件的00 0A－00 0D 为保留位。知道了两者的差异，你就可以通过手工或编一个小程序来实现图标文件到光标文件的转换。相对于光标文件来说，图标文件要好找得多，颜色上也更丰富。
除了光标文件外，你也可以创建资源文件（.res ),在资源文件中包含光标资源, Delphi 同样可在程序中调用。可使用Image Editor 或Microsoft的资源编辑器创建资源文件(推荐使用Vc＋＋的资源编辑器）。Delphi 缺省为每一个项目创建一个与项目名同名的资源文件，如你的项目名为test.dpr ，则资源文件名为test.res。但你如果把光标放在这个文件中，在程序中是无法调用的，必须创建自己的资源文件。在给光标资源命名时注意不要与已有的资源重名，创建好后，再在程序中使用编译指令＄R将资源文件加在程序中，如资源文件为my.res,则在主窗体的Implementation下加上一行{＄R my.res} 就可以了。
●自定义光标在程序中的使用
Delphi 使用自定义光标是通过调用Windows的API函数实现的。Delphi 的Screen 对象定义有一个Cursors 属性，属性声明为Property Cursors[Index:Interger]:Hcursor;Cursors属性实际记录了应用程序中使用的全部光标资源的句柄，Index 为每项资源的索引号。Delphi缺省提供的22种光标资源也在其中，Index值为－21～0。要使用自己的光标，首先可调用API函数 Loadcursorfromfile(对于光标文件）或使用Loadcursor(对于资源文件）获得相应光标的句柄，这两个函数都定义在Windows单元中，函数声明为：
Function LoadCursorFromFile(lpFileName:PAnsiChar):HCURSOR;stdcall;
//lpFilename为光标文件名。(两种光标都适用，只需具体指定光标文件名就可以了。)
Function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR; stdcall;
//hInstance为应用程序的句柄，lpCursorName为光标资源的名字。在资源文件中只能包含静态光标资源，资源文件不支持动态光标这种格式的资源。两个函数的详细说明可参考Delphi的Win32帮助。得到光标的句柄后，将这个句柄值添加到Cursors数组中，注意Index不要与已有的索引号重复，否则将覆盖已有的光标。要使用这个光标时，只要将该光标的Index赋值给元件的Cursor属性就可以了，Delphi根据这个索引号查找Cursors数组，找到该光标的句柄，并用Setcursor函数将这个句柄赋给元件。需要指出的是，程序结束时，不必调用Deletecursor函数释放光标资源，Delphi会自动释放它们。
●程序示例
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{＄R ＊.DFM}
{＄R my.res}//加载资源文件my.res
procedure TForm1.FormCreate(Sender: TObject);
const
crmy1=1;
crmy2=2;
crmy3=3;
var
result1,result2,result3:integer;
begin
result1:=loadcursorfromfile(′my.cur′);
if result1<>0 then //如果返回值为0，则调用失败！
screen.cursors[crmy1]:=result1
else
showmessage(′加载静态光标文件出错！′);
result2:=loadcursorfromfile(′my.ani′);
if result2<>0 then
screen.cursors[crmy2]:=result2
else
showmessage(′加载动态光标文件错误！′);
result3:=loadcursor(Hinstance,′mycursor′);
Hinstance为定义在System单元中的一个长整变量，其值为应用程序的句柄，由Delphi自己维护。
在加载资源文件的光标资源时，如果光标的名字为整数（Vc＋＋的资源编辑器给资源的缺省名就为整数），就必须使用API函数Makeintresource将整数转换为PansiChar类型，再传递给Loadcursor函数。
例如：result:=Loadcursor(Hinstance,Makeintresource(101))}
if result3<>0 then
screen.cursors[crmy3]:=result3
else
showmessage(′加载资源文件中的光标资源出错！′);
//使用加载的光标，cursors[]数组为全局变量，可在程序的任何地方调用；
if result1<>0 then
screen.cursor:=crmy1;
if result2<>0 then
form1.cursor:=crmy2;
if result3<>0 then
screen.cursor:=crmy3;
end;
end.程序在Windows95 ,Delphi3.0中调试通过。
在Delphi6中或7中安装老组件会出现DsgnIntf单元引用问题,我的解决方法是,将该单元引用改为一个新的单元(DesignIntf)的引用,如果还是不行可能需要增加DesignEditors、Editors 和RTLConsts 这三个单元,除此之外需要在包的Requires列表中增加designide.一般基本都能搞定.
在Environment Options->Library->Library Path中增加对Delphi目录中ToolsAPI目录的引用,如果编译不过,说Proxies单元找不到,将DesignEditors.pas单元中将Proxies注释掉,然后到
function TCustomModule.ValidateComponentClass(ComponentClass:TComponentClass):
，把下面的代码注释了，
while IsProxyClass(ComponentClass) do
ComponentClass := TComponentClass(ComponentClass.ClassParent);SListIndexError 定义在unit RTLConsts
控件移动类的实现
http://www.daima.com.cn/Info/106/Info35071/
Delphi的IDE是本身就是一个非常精彩的软件，其中涵含了许多非常宝贵的软件知识。IDE中有一个窗体设计器，控件放在里面，就可以随意移动，以及调整大小，如果能够自己实现一个类似于这样的窗体设计器，那真是一件非常美妙事情。本文实现的就是窗体设计器中最重要的部分，一个移动控件的类，控件要求从TControl继承下来，在介绍如何实现之前，先说说这个类的用法：
其中有两个类：
TDragClass就是实现拉动的类
TDragPoint是控件周围出现的拉动点的类
用法很简单：
创建一个TDragClass对象
将要实现拉动的控件传进去就行了
比如：
myDrag.addControl(Edit1);
这样Edit1就能实现拉动和移动了。
另外有两个属性来控制移动的方式
isMoveStep:boolean
指定移动的方式，True为跳跃式，False为连续式，默认情况下是False，即连续式。
所谓跳跃式，即移动或拉动控件时，控件是以离散的方式在改变自己的位置和大小的，这个对窗体设计器中的控件对齐有帮助。而连续式，当然就是以连续的方式使控件的位置和大小得到改变。
MoveStep :integer
当移动方式为跳跃式时，该属性指定跳跃的大小，范围在5－20之间
另外还有一个方法：SetPointVisible(value:Boolean);用于指定移动点的可见性。在Delphi中，当你点击窗口时，控件周围的八个小点就消失了，即用此原理。
现在开始进入到具体实现的部分了，当你点击Delphi的窗体设计器中的控件时，控件周围出现了八个小点，这八个小点其实也是窗口类：TGrabHandle。预想中要实现控件移动，得有一个标识你正在移动或拉动的东西，这八个小点正是，Delphi的这种做法可以借鉴。于是我实现了一个移动点类：TDragPoint，该的对象将作为TDragClass的成员之一，具体等一下再讲。现在来看它的实现，其实非常简单，因为VCL给了我们一个有自绘能力的类TCustomControl，只要从这里继承下来，再重载其中的Paint方法，自己来画这个移动点就行了。
代码非常简单，这里就不多说了：
//---------TDragPoint--------------------------
unit UDragPoint;
interface
uses Windows, Messages,Controls,Classes,Graphics;
type
TDragPoint=class(TCustomControl)
protected
procedure Paint;override;
public
//处理移动时用变量
isDown:Boolean;
PrevP,NextP:TPoint;
constructor Create(AOwner: TComponent); override;
procedure CreateWnd; override;
published
property onm ouseMove;
property onm ouseDown;
property onm ouseUp;
end;
implementation
{ TDragPoint }
constructor TDragPoint.create;
begin
inherited Create(AOwner);
isDown:=False;
Width:=6;
Height:=6;
end;
procedure TDragPoint.CreateWnd;
begin
inherited;
//使该类位窗口最前
BringWindowToTop(self.Handle);
end;
procedure TDragPoint.Paint;
begin
Canvas.Brush.Color:=clBlack;
Canvas.Brush.Style:=bsSolid;
Canvas.Rectangle(0,0,width,Height);
end;
end.这里有必须谈到的一点是该类重载了WndCreate，并在其中写入BringWindowToTop(self.Handle);这样做目的是让这些移动点控件能够位于窗口的最前位置。另外在其中显化了三个鼠标事件：
property onm ouseMove;
property onm ouseDown;
property onm ouseUp;
目的是为了在TDragClass中实现移动这些点。
现在可以进入主题，来说明TDragClass的实现了。
其中有一个保存传进来的控件的列表类：FConList:TList;还有一个标识当前正在被移动或拉动的控件在FConList中的索引FCurActiveCon:Integer;
还有控件事件相关的成员
FConMouseDown:TMouseEvent;
FConMouseMove:TMouseMoveEvent;
FConMouseup:TMouseEvent;
这三个事件方法指针指向所有传进来的控件的鼠标事件的处理函数，在Create中将得到赋值。而所有控件的鼠标处理函数将在类中实现。
接下来就到了最重要的成员了：FPointRec:TPointRec;这是一个记录类型，其定义为：
TPointRec=record
LeftTop:TDragPoint;
LeftBottom:TDragPoint;
RightTop:TDragPoint;
RightButton:TDragPoint;
LeftMid:TDragPoint;
TopMid:TDragPoint;
RightMid:TDragPoint;
ButtonMid:TDragPoint;
end;这正是当前被移动控件边缘的八个点。这八个点会粘在被移动控件的边缘。
上面说过该类可以实现跳跃式移动或拉动则必定有相关的成员： FisMoveStep:Boolean;
FMoveStep:integer;
MoveX,MoveY:integer;
FisMoveStep指定是否为跳跃式，FMoveStep为跳跃的幅度，MoveX,MoveY标识控件移动或拉动的距离是否达到了FMoveStep，是就改变控件位置和大小，如此重复
除了上面那些成员，类中还定义了一些相类的方法，大概如下：
//-------对移动点类的操作—
//创建移动点类
procedure CreateDragPoint(PointParent:TWinControl);
//设定移动点类的位置
procedure SetPointPos(posRect:TRect);
//指定移动点类的父窗口
procedure SetPointParent(PointParent:TWinControl);
//设置移动点类的鼠标事件
procedure SetPointEvent;
//设置移动点类的可见性
procedure SetPointVisible(Visibled:Boolean);
//三个控件事件处理函数，所有控件的鼠标处理函数都将是这个，主要是解决控件的移动
//以及移动点类的位置，当你点击某一个控件的时候，移动点类会附着到这个控件的边缘
procedure ConMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ConMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ConMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
//移动点类的鼠标处理事件，解决移动点类的移动，以及当前控件的大小改变
procedure PointMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PointMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PointMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);最后一个重要方法是function addControl(AddCon:Pointer):Boolean;
控件从这里加入，就可以实现移动和拉动了。
下面就将类实现比较重要的几点略说一下吧（主要还是看代码吧）
在类的构造函数中，将上面的三个控件处理函数指定给三个指针成员：
FConMouseDown:=ConMouseDown;
FConMouseMove:=ConMouseMove;
FConMouseup:=ConMouseUp;
现在这三个成员就指定了三个处理函数的地址了，等一下就可以看到那些控件的鼠标消息是怎么和这三个处理函数联系在一起的，实现就在AddControl函数中。
AddControl是一个非常重要的方法，在控件加入之前，它要先判断控件是否有Parent值，没有则不能加入，更重要的一点是，在FConList是否已经有这个控件了，即该控件已经加入过了，如果已经加入了，则不能再加一次，代码如下：
//如果该控件已经在列表中了，则加入失败
for i:=0 to FConList.Count-1 do
if Integer(AddCon)=Integer(FConList.Items[i]) then
begin
result:=false;
exit;
end;如果可以加入则先加入列表类中，再指定当前活动控件：
FConList.Add(AddCon);
FCurActiveCon:=FConList.Count-1;
而AddControl中还有一个比较重要的TempCon.Parent.DoubleBuffered:=True;
即加入的控件的父窗口设为双缓冲模式，这样在移动控件或拉动控件大小的时候，不会出现闪烁现象。
接着就是为加入的控件指定鼠标处理函数了，但加入的是TControl，而他的鼠标事件指针被设为保护类型，因此无法获得，但他的子类把他们显化出来了。这里用了一种折衷的方案：
TButton(TempCon).OnMouseDown:=FconMouseDown;
TButton(TempCon).OnMouseMove:=FconMouseMove;
TButton(TempCon).OnMouseUp:=FconMouseUp;
这样做并不会出错，但显得怪怪的，但不理他了，能实现功能就行了。现在加入控件的鼠标事件都将会在这里的三个处理函数中处理了。
最后，将移动点类移动该控件的边缘去。
说得够杂的，各位可以和第二部分的原代码对照着看，这样会更好一些。
再稍微讲一下跳跃式移动或拉动控件的实现，FMoveStep指定跳跃的幅度，MoveX,MoveY:integer;用在移动点类和控件的鼠标事件中，累加鼠标移动的距离，当达到FMoveStep时，就移动控件，或改变控件的大小，然后将MoveX,MoveY变为0，又继续累加，如此循环
至于其他的就没有什么好说的了，各位还是看看源代码吧，也并不是很难理解。代码在第二部分给出。
控件移动类的实现之二 选择自 linzhengqun 的 Blog
关键字 控件移动类的实现之二
出处
下面是TDragClass的源代码,比如多，可以拷去机上试试，再慢慢看：
//------TDragClass------------------------
unit uDrag;
interface
uses Windows, Messages,Classes,SysUtils,Controls,Graphics,
uDragPoint,StdCtrls;
type
//控件的八个点，用于拉动大小
TPointRec=record
LeftTop:TDragPoint;
LeftBottom:TDragPoint;
RightTop:TDragPoint;
RightButton:TDragPoint;
LeftMid:TDragPoint;
TopMid:TDragPoint;
RightMid:TDragPoint;
ButtonMid:TDragPoint;
end;
TDragClass=class
private
FConList:TList; //保存控件的列表
FCurActiveCon:Integer; //当前活动控件
FPointRec:TPointRec; //当前控件的边缘的八个小点
//跳跃式移动的成员
FisMoveStep:Boolean;
FMoveStep:integer;
MoveX,MoveY:integer;
//控件事件相关的成员
FConMouseDown:TMouseEvent;
FConMouseMove:TMouseMoveEvent;
FConMouseup:TMouseEvent;
isDown:Boolean;
prevP,nextP:TPoint;
protected
//-------对移动点的操作--
procedure CreateDragPoint(PointParent:TWinControl);
procedure SetPointPos(posRect:TRect);
procedure SetPointParent(PointParent:TWinControl);
procedure SetPointEvent;
procedure SetCurActiveCon(curCon:Pointer);
//----------------------
procedure MoveLeftTopPoint;
procedure AlignLeftTop;
procedure MoveLeftBottomPoint;
procedure AlignLeftBottom;
procedure MoveRightTopPoint;
procedure AlignRightTop;
procedure MoveRightBottomPoint;
procedure AlignRightBottom;
procedure MoveLeftMidPoint;
procedure AlignLeftMid;
procedure MoveTopMidPoint;
procedure AlignTopMid;
procedure MoveRightMidPoint;
procedure AlignRightMid;
procedure MoveBottomMidPoint;
procedure AlignBottomMid;
procedure reSizeCon;
//当前控件事件和移动点事件处理------------
procedure ConMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ConMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ConMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PointMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PointMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PointMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SetisMoveStep(value:Boolean);
procedure SetMoveStep(value:integer);
public
constructor create(PointParent:TWinControl);
destructor destroy; override;
function addControl(AddCon:Pointer):Boolean; //important
procedure SetPointVisible(Visibled:Boolean);
property isMoveStep:Boolean read FisMoveStep write SetisMoveStep;
property MoveStep:Integer read FMoveStep write SetMoveStep;
end;
implementation
{ TDragClass }
constructor TDragClass.create(PointParent:TWinControl);
begin
inherited Create;
FConList:=TList.Create;
FCurActiveCon:=-1;
isDown:=False;
FisMoveStep:=False;
FMoveStep:=5;
FConMouseDown:=ConMouseDown;
FConMouseMove:=ConMouseMove;
FConMouseup:=ConMouseUp;
CreateDragPoint(PointParent);
SetPointVisible(false);
SetPointEvent;
end;
destructor TDragClass.destroy;
begin
FreeAndNil(FConList);
FPointRec.LeftTop.Free;
FPointRec.LeftBottom.Free;
FPointRec.RightTop.Free;
FPointRec.RightButton.Free;
FPointRec.LeftMid.Free;
FPointRec.TopMid.Free;
FPointRec.RightMid.Free;
FPointRec.ButtonMid.Free;
inherited;
end;
//加一个控件进入拖拉类
function TDragClass.addControl(AddCon: Pointer): Boolean;
var TempCon:TControl; R:TRect;
i:integer;
begin
result:=True;
if TControl(AddCon).Parent=nil then
begin
result:=false;
exit;
end;
//如果该控件已经在列表中了，则加入失败
for i:=0 to FConList.Count-1 do
if Integer(AddCon)=Integer(FConList.Items[i]) then
begin
result:=false;
exit;
end;
//将控件加入列表中，并指定当前的控件的索引
FConList.Add(AddCon);
FCurActiveCon:=FConList.Count-1;
TempCon:=TControl(AddCon);
TempCon.Cursor:=crSizeAll;
TempCon.Parent.DoubleBuffered:=True; //使用双缓冲技术
//折中方案，指定控件鼠标事件
TButton(TempCon).OnMouseDown:=FconMouseDown;
TButton(TempCon).OnMouseMove:=FconMouseMove;
TButton(TempCon).OnMouseUp:=FconMouseUp;
//画控件周围的八个小点
R.Left:=TempCon.Left;
R.Top:=TempCon.Top;
R.Right:=TempCon.Left+TempCon.Width;
R.Bottom:=TempCon.Top+TempCon.Height;
SetPointParent(TempCon.Parent);
SetPointPos(R);
SetPointVisible(true);
end;
//设置八小点的可见性
procedure TDragClass.SetPointVisible(Visibled: Boolean);
begin
FPointRec.LeftTop.Visible:=Visibled;
FPointRec.LeftBottom.Visible:=Visibled;
FPointRec.RightTop.Visible:=Visibled;
FPointRec.RightButton.Visible:=Visibled;
FPointRec.LeftMid.Visible:=Visibled;
FPointRec.TopMid.Visible:=Visibled;
FPointRec.RightMid.Visible:=Visibled;
FPointRec.ButtonMid.Visible:=Visibled;
end;
//设置小点事件
procedure TDragClass.SetPointEvent;
begin
FPointRec.LeftTop.OnMouseDown:=PointMouseDown;
FPointRec.LeftTop.OnMouseMove:=PointMouseMove;
FPointRec.LeftTop.onMouseUp:=PointMouseUp;
FPointRec.LeftBottom.OnMouseDown:=PointMouseDown;
FPointRec.LeftBottom.OnMouseMove:=PointMouseMove;
FPointRec.LeftBottom.onMouseUp:=PointMouseUp;
FPointRec.RightTop.OnMouseDown:=PointMouseDown;
FPointRec.RightTop.OnMouseMove:=PointMouseMove;
FPointRec.RightTop.onMouseUp:=PointMouseUp;
FPointRec.RightButton.OnMouseDown:=PointMouseDown;
FPointRec.RightButton.OnMouseMove:=PointMouseMove;
FPointRec.RightButton.onMouseUp:=PointMouseUp;
FPointRec.LeftMid.OnMouseDown:=PointMouseDown;
FPointRec.LeftMid.OnMouseMove:=PointMouseMove;
FPointRec.LeftMid.onMouseUp:=PointMouseUp;
FPointRec.TopMid.OnMouseDown:=PointMouseDown;
FPointRec.TopMid.OnMouseMove:=PointMouseMove;
FPointRec.TopMid.onMouseUp:=PointMouseUp;
FPointRec.RightMid.OnMouseDown:=PointMouseDown;
FPointRec.RightMid.OnMouseMove:=PointMouseMove;
FPointRec.RightMid.onMouseUp:=PointMouseUp;
FPointRec.ButtonMid.OnMouseDown:=PointMouseDown;
FPointRec.ButtonMid.OnMouseMove:=PointMouseMove;
FPointRec.ButtonMid.onMouseUp:=PointMouseUp;
end;
//确定控件边缘八个小点的位置
procedure TDragClass.SetPointPos(posRect: TRect);
begin
FPointRec.LeftTop.Left:=posRect.Left-6;
FPointRec.LeftTop.Top:=posRect.Top-6;
FPointRec.LeftBottom.Left:=PosRect.Left-6;
FPointRec.LeftBottom.Top:=PosRect.Bottom;
FPointRec.RightTop.Left:=posRect.Right;
FPointRec.RightTop.Top:=posRect.Top-6;
FPointRec.RightButton.Left:=PosRect.Right;
FPointRec.RightButton.Top:=PosRect.Bottom;
FPointRec.LeftMid.Left:=posRect.Left-6;
FPointRec.LeftMid.Top:=(posRect.Top+posRect.Bottom) div 2 - 3;
FPointRec.TopMid.Left:=(posRect.Left+posRect.Right) div 2 -3;
FPointRec.TopMid.Top:=PosRect.Top-6;
FPointRec.RightMid.Left:=posRect.Right;
FPointRec.RightMid.Top:=(posRect.Top+posRect.Bottom) div 2 - 3;
FPointRec.ButtonMid.Left:=(posRect.Left+posRect.Right) div 2 -3;
FPointRec.ButtonMid.Top:=PosRect.Bottom;
end;
//创建八个小点
procedure TDragClass.CreateDragPoint(PointParent:TWinControl);
begin
FPointRec.LeftTop:=TDragPoint.Create(nil);
FPointRec.LeftTop.Cursor:=crSizeNWSE;
FPointRec.LeftBottom:=TDragPoint.Create(nil);
FPointRec.LeftBottom.Cursor:=crSizeNESW;
FPointRec.RightTop:=TDragPoint.Create(nil);
FPointRec.RightTop.Cursor:=crSizeNESW;
FPointRec.RightButton:=TDragPoint.Create(nil);
FPointRec.RightButton.Cursor:=crSizeNWSE;
FPointRec.LeftMid:=TDragPoint.Create(nil);
FPointRec.LeftMid.Cursor:=crSizeWE;
FPointRec.TopMid:=TDragPoint.Create(nil);
FPointRec.TopMid.Cursor:=crSizeNS;
FPointRec.RightMid:=TDragPoint.Create(nil);
FPointRec.RightMid.Cursor:=crSizeWE;
FPointRec.ButtonMid:=TDragPoint.Create(nil);
FPointRec.ButtonMid.Cursor:=crSizeNS;
SetPointParent(PointParent);
end;
//------当前控件事件处理-------------------------
//处理点下的事件
procedure TDragClass.ConMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var TempCon:TControl; R:TRect;
begin
if Button=mbLeft then
begin
isDown:=True;
GetCursorPos(PrevP);
end;
TempCon:=TControl(Sender);
SetPointParent(TempCon.Parent);
R.Left:=TempCon.Left;
R.Top:=TempCon.Top;
R.Right:=TempCon.Left+TempCon.Width;
R.Bottom:=TempCon.Top+TempCon.Height;
MoveX:=0; MoveY:=0;
SetPointPos(R);
SetPointvisible(true);
SetCurActiveCon(TempCon);
end;
//处理当前控件移动的消息
procedure TDragClass.ConMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var offsetX,offsetY:integer; con:TControl;
r:TRect;
begin
if isDown and (Shift=[ssLeft])then
begin
GetCursorPos(nextP);
offsetX:=NextP.X-PrevP.X;
offSetY:=NextP.Y-PrevP.Y;
Con:=TControl(Sender);
if not FisMoveStep then
begin
Con.Left:=Con.Left+offSetX;
Con.Top:=Con.Top+offSetY;
end
else begin
MoveX:=MoveX+offsetX;
MoveY:=MoveY+offsetY;
if Abs(MoveX)>=FMoveStep then
begin
Con.Left:=Con.Left+MoveX;
MoveX:=0;
end;
if Abs(MoveY)>FMoveStep then
begin
Con.Top:=Con.Top+MoveY;
MoveY:=0;
end;
end;
R.Left:=Con.Left;
R.Top:=Con.Top;
R.Right:=Con.Left+Con.Width;
R.Bottom:=Con.Top+Con.Height;
SetPointPos(R);
prevP:=nextP;
end;
end;
//处理当前控件鼠标弹起的消息
procedure TDragClass.ConMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
isDown:=False;
end;
//－－－－－－－－－－－－－－－－－－－－－－－－
//设置八个点的父子关系
procedure TDragClass.SetPointParent(PointParent: TWinControl);
begin
FPointRec.LeftTop.Parent:=PointParent;
FPointRec.LeftBottom.Parent:=PointParent;
FPointRec.RightTop.Parent:=PointParent;
FPointRec.RightButton.Parent:=PointParent;
FPointRec.LeftMid.Parent:=PointParent;
FPointRec.TopMid.Parent:=PointParent;
FPointRec.RightMid.Parent:=PointParent;
FPointRec.ButtonMid.Parent:=PointParent;
end;
//得到当前活动窗口
procedure TDragClass.SetCurActiveCon(curCon: Pointer);
var i:integer;
begin
for i:=0 to FConList.Count-1 do
if Integer(curCon)=Integer(FConList.Items[i]) then
begin
FCurActiveCon:=i;
break;
end;
end;
//----------------------------------
//八个小点的处理消息
procedure TDragClass.PointMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
moveX:=0; moveY:=0;
if Sender=FPointRec.LeftTop then
begin
FpointRec.LeftTop.isDown:=True;
GetCursorPos(FPointRec.LeftTop.PrevP);
end
else if Sender=FPointRec.RightTop then
begin
FpointRec.RightTop.isDown:=True;
GetCursorPos(FPointRec.RightTop.PrevP);
end
else if Sender=FPointRec.LeftBottom then
begin
FpointRec.LeftBottom.isDown:=True;
GetCursorPos(FPointRec.LeftBottom.PrevP);
end
else if Sender=FPointRec.RightButton then
begin
FpointRec.RightButton.isDown:=True;
GetCursorPos(FPointRec.RightButton.PrevP);
end
else if Sender=FPointRec.LeftMid then
begin
FpointRec.LeftMid.isDown:=True;
GetCursorPos(FPointRec.LeftMid.PrevP);
end
else if Sender=FPointRec.TopMid then
begin
FpointRec.TopMid.isDown:=True;
GetCursorPos(FPointRec.TopMid.PrevP);
end
else if Sender=FPointRec.RightMid then
begin
FpointRec.RightMid.isDown:=True;
GetCursorPos(FPointRec.RightMid.PrevP);
end
else if Sender=FPointRec.ButtonMid then
begin
FpointRec.ButtonMid.isDown:=True;
GetCursorPos(FPointRec.ButtonMid.PrevP);
end;
end;
end;
procedure TDragClass.PointMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Shift=[ssLeft] then
begin
if FPointRec.LeftTop.isDown then
begin
MoveLeftTopPoint;
reSizeCon
end
else if FPointRec.LeftBottom.isDown then
begin
MoveLeftBottomPoint;
reSizeCon
end
else if FPointRec.RightTop.isDown then
begin
MoveRightTopPoint;
reSizeCon
end
else if FPointRec.RightButton.isDown then
begin
MoveRightBottomPoint;
reSizeCon
end
else if FPointRec.LeftMid.isDown then
begin
MoveLeftMidPoint;
reSizeCon
end
else if FPointRec.TopMid.isDown then
begin
MoveTopMidPoint;
reSizeCon
end
else if FPointRec.RightMid.isDown then
begin
MoveRightMidPoint;
reSizeCon
end
else if FPointRec.ButtonMid.isDown then
begin
MoveBottomMidPoint;
reSizeCon
end
end;
end;
procedure TDragClass.PointMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
if (FpointRec.LeftTop.isDown) and
(Sender=FpointRec.LeftTop) then
FpointRec.LeftTop.isDown:=False
else if (FpointRec.LeftBottom.isDown) and
(Sender=FpointRec.LeftBottom) then
FpointRec.LeftBottom.isDown:=False
else if (FpointRec.RightTop.isDown) and
(Sender=FpointRec.RightTop) then
FpointRec.RightTop.isDown:=False
else if (FpointRec.RightButton.isDown) and
(Sender=FpointRec.RightButton) then
FpointRec.RightButton.isDown:=False
else if (FpointRec.LeftMid.isDown) and
(Sender=FpointRec.LeftMid) then
FpointRec.LeftMid.isDown:=False
else if (FpointRec.TopMid.isDown) and
(Sender=FpointRec.TopMid) then
FpointRec.TopMid.isDown:=False
else if (FpointRec.RightMid.isDown) and
(Sender=FpointRec.RightMid) then
FpointRec.RightMid.isDown:=False
else if (FpointRec.ButtonMid.isDown) and
(Sender=FpointRec.ButtonMid) then
FpointRec.ButtonMid.isDown:=False;
end;
end;
//左顶点的移动
procedure TDragClass.MoveLeftTopPoint;
var offsetX,offsetY:Integer;
begin
GetCursorPos(FPointRec.LeftTop.NextP);
offsetX:=FPointRec.LeftTop.NextP.X-FPointRec.LeftTop.PrevP.X;
offSetY:=FPointRec.LeftTop.NextP.Y-FPointRec.LeftTop.PrevP.Y;
if not FisMoveStep then
begin
FPointRec.LeftTop.Left:=FPointRec.LeftTop.Left+offsetX;
FPointRec.LeftTop.Top:=FPointRec.LeftTop.Top+offsetY;
end
else begin
MoveX:=MoveX+offsetX;
MoveY:=MoveY+offsetY;
if Abs(moveX)>=FMoveStep then
begin
FPointRec.LeftTop.Left:=FPointRec.LeftTop.Left+moveX;
moveX:=0;
end;
if Abs(moveY)>=FMoveStep then
begin
FPointRec.LeftTop.Top:=FPointRec.LeftTop.Top+moveY;
moveY:=0;
end;
end;
FPointRec.LeftTop.PrevP:=FPointRec.LeftTop.NextP;
AlignLeftTop;
end;
//其他点对齐左右点
procedure TDragClass.AlignLeftTop;
begin
FPointRec.LeftBottom.Left:=FPointRec.LeftTop.Left;
FPointRec.RightTop.Top:=FPointRec.LeftTop.Top;
FPointRec.LeftMid.Left:=FPointRec.LeftTop.Left;
FPointRec.LeftMid.Top:=
(FPointRec.LeftBottom.Top+FPointRec.LeftTop.Top) div 2;
FPointRec.TopMid.Top:=FPointRec.LeftTop.Top;
FPointRec.TopMid.Left:=
(FPointRec.RightTop.Left+FPointRec.LeftTop.Left) div 2;
FPointRec.RightMid.Top:=
(FPointRec.RightTop.Top+FPointRec.RightButton.Top) div 2;
FPointRec.ButtonMid.Left:=
(FPointRec.LeftBottom.Left+FPointRec.RightButton.Left) div 2;
end;
//对齐点
procedure TDragClass.AlignLeftBottom;
begin
FPointRec.LeftTop.Left:=FPointRec.LeftBottom.Left;
FPointRec.RightButton.Top:=FPointRec.LeftBottom.Top;
FPointRec.LeftMid.Left:=FPointRec.LeftTop.Left;
FPointRec.LeftMid.Top:=
(FPointRec.LeftBottom.Top+FPointRec.LeftTop.Top) div 2;
FPointRec.TopMid.Top:=FPointRec.LeftTop.Top;
FPointRec.TopMid.Left:=
(FPointRec.RightTop.Left+FPointRec.LeftTop.Left) div 2;
FPointRec.RightMid.Top:=
(FPointRec.RightTop.Top+FPointRec.RightButton.Top) div 2;
FPointRec.ButtonMid.Top:=FPointrec.LeftBottom.Top;
FPointRec.ButtonMid.Left:=
(FPointRec.LeftBottom.Left+FPointRec.RightButton.Left) div 2;
end;
//移动左底点
procedure TDragClass.MoveLeftBottomPoint;
var offsetX,offsetY:Integer;
begin
GetCursorPos(FPointRec.LeftBottom.NextP);
offsetX:=FPointRec.LeftBottom.NextP.X-FPointRec.LeftBottom.PrevP.X;
offSetY:=FPointRec.LeftBottom.NextP.Y-FPointRec.LeftBottom.PrevP.Y;
if not FisMoveStep then
begin
FPointRec.LeftBottom.Left:=FPointRec.LeftBottom.Left+offsetX;
FPointRec.LeftBottom.Top:=FPointRec.LeftBottom.Top+offsetY;
end
else begin
MoveX:=MoveX+offsetX;
MoveY:=MoveY+offsetY;
if Abs(moveX)>=FMoveStep then
begin
FPointRec.LeftBottom.Left:=FPointRec.LeftBottom.Left+moveX;
moveX:=0;
end;
if Abs(moveY)>=FMoveStep then
begin
FPointRec.LeftBottom.Top:=FPointRec.LeftBottom.Top+moveY;
movey:=0;
end;
end;
FPointRec.LeftBottom.PrevP:=FPointRec.LeftBottom.NextP;
AlignLeftBottom;
end;
//对齐点
procedure TDragClass.AlignRightTop;
begin
FPointRec.LeftTop.Top:=FPointRec.RightTop.top;
FPointRec.RightButton.Left:=FPointRec.RightTop.Left;
FPointRec.LeftMid.Left:=FPointRec.LeftTop.Left;
FPointRec.LeftMid.Top:=
(FPointRec.LeftBottom.Top+FPointRec.LeftTop.Top) div 2;
FPointRec.TopMid.Top:=FPointRec.LeftTop.Top;
FPointRec.TopMid.Left:=
(FPointRec.RightTop.Left+FPointRec.LeftTop.Left) div 2;
FPointRec.RightMid.Left:=FPointRec.RightTop.Left;
FPointRec.RightMid.Top:=
(FPointRec.RightTop.Top+FPointRec.RightButton.Top) div 2;
FPointRec.ButtonMid.Top:=FPointrec.LeftBottom.Top;
FPointRec.ButtonMid.Left:=
(FPointRec.LeftBottom.Left+FPointRec.RightButton.Left) div 2;
end;
//移动右上点
procedure TDragClass.MoveRightTopPoint;
var offsetX,offsetY:Integer;
begin
GetCursorPos(FPointRec.RightTop.NextP);
offsetX:=FPointRec.RightTop.NextP.X-FPointRec.RightTop.PrevP.X;
offSetY:=FPointRec.RightTop.NextP.Y-FPointRec.RightTop.PrevP.Y;
if not FisMoveStep then
begin
FPointRec.RightTop.Left:=FPointRec.RightTop.Left+offsetX;
FPointRec.RightTop.Top:=FPointRec.RightTop.Top+offsetY;
end
else begin
MoveX:=MoveX+offsetX;
MoveY:=MoveY+offsetY;
if Abs(moveX)>=FMoveStep then
begin
FPointRec.RightTop.Left:=FPointRec.RightTop.Left+moveX;
moveX:=0;
end;
if Abs(moveY)>=FMoveStep then
begin
FPointRec.RightTop.Top:=FPointRec.RightTop.Top+moveY;
moveY:=0;
end;
end;
FPointRec.RightTop.PrevP:=FPointRec.RightTop.NextP;
AlignRightTop;
end;
//对齐点
procedure TDragClass.AlignRightBottom;
begin
FPointRec.LeftBottom.Top:=FPointRec.RightButton.top;
FPointRec.RightTop.Left:=FPointRec.RightButton.Left;
FPointRec.LeftMid.Left:=FPointRec.LeftTop.Left;
FPointRec.LeftMid.Top:=
(FPointRec.LeftBottom.Top+FPointRec.LeftTop.Top) div 2;
FPointRec.TopMid.Top:=FPointRec.LeftTop.Top;
FPointRec.TopMid.Left:=
(FPointRec.RightTop.Left+FPointRec.LeftTop.Left) div 2;
FPointRec.RightMid.Left:=FPointRec.RightTop.Left;
FPointRec.RightMid.Top:=
(FPointRec.RightTop.Top+FPointRec.RightButton.Top) div 2;
FPointRec.ButtonMid.Top:=FPointrec.LeftBottom.Top;
FPointRec.ButtonMid.Left:=
(FPointRec.LeftBottom.Left+FPointRec.RightButton.Left) div 2;
end;
//移动右底点
procedure TDragClass.MoveRightBottomPoint;
var offsetX,offsetY:Integer;
begin
GetCursorPos(FPointRec.RightButton.NextP);
offsetX:=FPointRec.RightButton.NextP.X-FPointRec.RightButton.PrevP.X;
offSetY:=FPointRec.RightButton.NextP.Y-FPointRec.RightButton.PrevP.Y;
if not FisMoveStep then
begin
FPointRec.RightButton.Left:=FPointRec.RightButton.Left+offsetX;
FPointRec.RightButton.Top:=FPointRec.RightButton.Top+offsetY;
end
else begin
MoveX:=MoveX+offsetX;
MoveY:=MoveY+offsetY;
if Abs(moveX)>=FMoveStep then
begin
FPointRec.RightButton.Left:=FPointRec.RightButton.Left+moveX;
moveX:=0;
end;
if Abs(moveY)>=FMoveStep then
begin
FPointRec.RightButton.Top:=FPointRec.RightButton.Top+moveY;
moveY:=0;
end;
end;
FPointRec.RightButton.PrevP:=FPointRec.RightButton.NextP;
AlignRightBottom;
end;
//对齐点
procedure TDragClass.AlignLeftMid;
begin
FPointRec.LeftTop.Left:=FPointRec.LeftMid.Left;
FPointRec.LeftBottom.Left:=FPointRec.LeftMid.Left;
FPointRec.TopMid.Top:=FPointRec.LeftTop.Top;
FPointRec.TopMid.Left:=
(FPointRec.RightTop.Left+FPointRec.LeftTop.Left) div 2;
FPointRec.ButtonMid.Top:=FPointrec.LeftBottom.Top;
FPointRec.ButtonMid.Left:=
(FPointRec.LeftBottom.Left+FPointRec.RightButton.Left) div 2;
end;
//左中点
procedure TDragClass.MoveLeftMidPoint;
var offsetX:Integer;
begin
GetCursorPos(FPointRec.LeftMid.NextP);
offsetX:=FPointRec.LeftMid.NextP.X-FPointRec.LeftMid.PrevP.X;
if not FisMoveStep then
begin
FPointRec.LeftMid.Left:=FPointRec.LeftMid.Left+offsetX;
end
else begin
MoveX:=MoveX+offsetX;
if Abs(moveX)>=FMoveStep then
begin
FPointRec.LeftMid.Left:=FPointRec.LeftMid.Left+moveX;
moveX:=0;
end;
end;
FPointRec.LeftMid.PrevP:=FPointRec.LeftMid.NextP;
AlignLeftMid;
end;
//对齐点
procedure TDragClass.AlignTopMid;
begin
FPointRec.LeftTop.Top:=FPointRec.TopMid.Top;
FPointRec.RightTop.Top:=FPointRec.TopMid.Top;
FPointRec.TopMid.Top:=FPointRec.LeftTop.Top;
FPointRec.LeftMid.Left:=FPointRec.LeftTop.Left;
FPointRec.LeftMid.Top:=
(FPointRec.LeftBottom.Top+FPointRec.LeftTop.Top) div 2;
FPointRec.RightMid.Left:=FPointRec.RightTop.Left;
FPointRec.RightMid.Top:=
(FPointRec.RightTop.Top+FPointRec.RightButton.Top) div 2;
end;
//顶中点
procedure TDragClass.MoveTopMidPoint;
var offsetY:Integer;
begin
GetCursorPos(FPointRec.TopMid.NextP);
offSetY:=FPointRec.TopMid.NextP.Y-FPointRec.TopMid.PrevP.Y;
if not FisMoveStep then
begin
FPointRec.TopMid.Top:=FPointRec.TopMid.Top+offsetY;
end
else begin
MoveY:=MoveY+offsetY;
if Abs(moveY)>=FMoveStep then
begin
FPointRec.TopMid.Top:=FPointRec.TopMid.Top+moveY;
moveY:=0;
end;
end;
FPointRec.TopMid.PrevP:=FPointRec.TopMid.NextP;
AlignTopMid;
end;
//对齐点
procedure TDragClass.AlignRightMid;
begin
FPointRec.RightTop.Left:=FPointRec.RightMid.Left;
FPointRec.RightButton.Left:=FPointRec.RightMid.Left;
FPointRec.TopMid.Top:=FPointRec.LeftTop.Top;
FPointRec.TopMid.Left:=
(FPointRec.RightTop.Left+FPointRec.LeftTop.Left) div 2;
FPointRec.ButtonMid.Top:=FPointrec.LeftBottom.Top;
FPointRec.ButtonMid.Left:=
(FPointRec.LeftBottom.Left+FPointRec.RightButton.Left) div 2;
end;
//右中点
procedure TDragClass.MoveRightMidPoint;
var offsetX:Integer;
begin
GetCursorPos(FPointRec.RightMid.NextP);
offsetX:=FPointRec.RightMid.NextP.X-FPointRec.RightMid.PrevP.X;
if not FisMoveStep then
begin
FPointRec.RightMid.Left:=FPointRec.RightMid.Left+offsetX;
end
else begin
MoveX:=MoveX+offsetX;
if Abs(moveX)>=FMoveStep then
begin
FPointRec.RightMid.Left:=FPointRec.RightMid.Left+moveX;
moveX:=0;
end;
end;
FPointRec.RightMid.PrevP:=FPointRec.RightMid.NextP;
AlignRightMid;
end;
//对齐点
procedure TDragClass.AlignBottomMid;
begin
FPointRec.LeftBottom.Top:=FPointRec.ButtonMid.Top;
FPointRec.RightButton.Top:=FPointrec.ButtonMid.Top;
FPointRec.LeftMid.Left:=FPointRec.LeftTop.Left;
FPointRec.LeftMid.Top:=
(FPointRec.LeftBottom.Top+FPointRec.LeftTop.Top) div 2;
FPointRec.RightMid.Left:=FPointRec.RightTop.Left;
FPointRec.RightMid.Top:=
(FPointRec.RightTop.Top+FPointRec.RightButton.Top) div 2;
end;
//底中点
procedure TDragClass.MoveBottomMidPoint;
var offsetY:Integer;
begin
GetCursorPos(FPointRec.ButtonMid.NextP);
offSetY:=FPointRec.ButtonMid.NextP.Y-FPointRec.ButtonMid.PrevP.Y;
if not FisMoveStep then
begin
FPointRec.ButtonMid.Top:=FPointRec.ButtonMid.Top+offsetY;
end
else begin
MoveY:=MoveY+offsetY;
if Abs(moveY)>=FMoveStep then
begin
FPointRec.ButtonMid.Top:=FPointRec.ButtonMid.Top+moveY;
moveY:=0;
end;
end;
FPointRec.ButtonMid.PrevP:=FPointRec.ButtonMid.NextP;
AlignBottomMid;
end;
//重定位控件的尽寸
procedure TDragClass.reSizeCon;
var Con:TControl;
begin
Con:=TControl(FConList.Items[FCurActiveCon]);
Con.Left:=FPointRec.LeftTop.Left+FPointRec.LeftTop.Width;
Con.Top:=FPointRec.LeftTop.Top+FPointRec.LeftTop.Height;
Con.Width:=FPointRec.RightTop.Left-Con.Left;
Con.Height:=FPointRec.LeftBottom.Top-Con.Top;
end;
//-----------------------------------------------
//设置控件移动时是否用跳跃式的移动
procedure TDragClass.SetisMoveStep(value: Boolean);
begin
if FisMoveStep<>value then
FisMoveStep:=Value;
end;
//设置控件移动跳跃的距离
procedure TDragClass.SetMoveStep(value: integer);
begin
if Value<5 then
FMoveStep:=5
else if Value>20 then
FMoveStep:=20
else
FMoveStep:=Value;
end;
end.到第三部分，用一个例子来说明这个类的用法
我们用一个例子来演示这个类的用法，建一个工程，将TDragClass的单元加入主窗体单元中，代码如下：
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, ExtCtrls, Buttons,uDrag,uDragPoint, jpeg;
type
TForm1 = class(TForm)
Bevel1: TBevel;
Button3: TButton; //指定用何种方式移动和拉动
Edit2: TEdit;//用于设定跳跃式移动的幅度
Button4: TButton;//确定Edit2中的内容
Button1: TButton;//点击该按钮，加入下面的控件，实现控件移动
Panel1: TPanel;
Shape1: TShape;
Image1: TImage;
Button2: TButton;
Edit1: TEdit;
StaticText1: TStaticText;
Shape2: TShape;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
MyDrag:TDragClass;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
myDrag.addControl(Edit1);
myDrag.addControl(Button2);
myDrag.addControl(Shape1);
myDrag.addControl(Image1);
myDrag.addControl(Panel1);
myDrag.addControl(BitBtn1);
myDrag.addControl(shape2);
myDrag.addControl(BitBtn2);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
myDrag:=TDragClass.create(self);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(myDrag) then
MyDrag.Free;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
myDrag.isMoveStep:=not myDrag.isMoveStep;
if myDrag.isMoveStep then
Button3.Caption:='连接式移动'
else
Button3.Caption:='跳跃式移动';
end;
procedure TForm1.Button4Click(Sender: TObject);
var value:integer;
begin
if TryStrtoInt(Edit2.Text,value) then
myDrag.MoveStep:=value;
end;
procedure TForm1.FormClick(Sender: TObject);
begin
myDrag.SetPointVisible(false);
end;
end.
运行程序，点击Button1按钮，看看如何，下面的控件是不是都可以移动了呢，再点击Button3，控件的移动是不是变得不连续了呢，再输入Edit2的值，然后点确定，控件移动的不连续性是不是变化了呢。
至此这个控件移动类讲解完毕，但还有很多改善的地方，有兴趣自己改吧。还是那句话，希望对你有用。
TQuickRep.Prepare:产生一个报表对象，但还没有通过通过预览窗口预览，或打印。
下面代码直接将报表输出：
quickrep1.prepare;
try
quickrep1.qrprinter.save('test.qrp');
finally
quickrep1.qrprinter.free;
end;
quickrep1.qrprinter:=nil;
在使用了quickrep.qrprinter.preview之后，可能需要quickrep.qrprinter.free，才能退出。
quickrep中的类型为rbColumnheader的TQRBand的，如果quickrep中只有该band存在的话，右键|preview，看不到东西。必须在quickrep的dataset属性有值之后，才能在preview中看到该band上的东西，其他类型的band 好像没有这个问题。
关于文件属性等问题的函数：
http://www.vctop.com/View.asp?ID=459&CateID=1
http://www.delphibbs.com/keylife/iblog_show.asp?xid=17827
获得文件的拥有者
http://www.zjmf.com/A06/A0607/A060703/200512/2957.html
作者：湛江数码… 教程来源：www.zjbit.com 点击数：781 更新时间：2005-12-28
//
When you create a file or directory, you become the owner of it.
// With GetFileOwner you get the owner of a file.
function GetFileOwner(FileName: string;
var Domain, Username: string): Boolean;
var
SecDescr: PSecurityDescriptor;
SizeNeeded, SizeNeeded2: DWORD;
OwnerSID: PSID;
OwnerDefault: BOOL;
OwnerName, DomainName: PChar;
OwnerType: SID_NAME_USE;
begin
GetFileOwner := False;
GetMem(SecDescr, 1024);
GetMem(OwnerSID, SizeOf(PSID));
GetMem(OwnerName, 1024);
GetMem(DomainName, 1024);
try
if not GetFileSecurity(PChar(FileName),
OWNER_SECURITY_INFORMATION,
SecDescr, 1024, SizeNeeded) then
Exit;
if not GetSecurityDescriptorOwner(SecDescr,
OwnerSID, OwnerDefault) then
Exit;
SizeNeeded := 1024;
SizeNeeded2 := 1024;
if not LookupAccountSID(nil, OwnerSID, OwnerName,
SizeNeeded, DomainName, SizeNeeded2, OwnerType) then
Exit;
Domain := DomainName;
Username := OwnerName;
finally
FreeMem(SecDescr);
FreeMem(OwnerName);
FreeMem(DomainName);
end;
GetFileOwner := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Domain, Username: string;
begin
GetFileOwner('YourFile.xyz', domain, username);
ShowMessage(username + '@' + domain);
end;
// Note: Only works unter NT.string TStrings pchar的相互转换
版权所有 codesky.net 2003-2005
发表时间：2003-8-9 关键字：不详
http://www.codesky.net/article/doc/200308/2003080963295785.htm
var
p:pchar;
s:string;
ss:tstrings;
begin
ss:=tstringlist.create; // 开始时一定不要忘记创建ss
ss.text:=s; // string --＞ tstrings
s:=ss.text; // tstrings --＞ string
p:=pchar(s); // string --＞ pchar
s:=p; // pchar --＞ string
showmessage(s); // 合法语句
showmessage(p); // 合法语句
... ...
ss.free; // 最后还要记着释放ss占用的资源
end;
原作者：不详
--_-------------------------------------------－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
delphi中如何获得字体列表
字体列表：系统中所有字体名称。
主要的API：EnumFontFamiliesEx。
delphi中有一个非常好的办法获得字体列表，Screen.Fonts。会得到一个TStringList，直接使用就可以了。
仔细看Screen里的代码，主要是这一句：
EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, LongInt(FFonts), 0);
一般来说windows api中的Enum枚举系列函数都是需要一个回调函数的。
EnumFontsProc这个就是回调函数。回调函数里是实际执行加入到StringList的代码。
如果不使用VCL，可以使用这个办法来获得系统字体列表。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
如何编程将TTreeView中选中的节点highlight？
将TTreeview.HideSelection := false;
这样，编程某个节点选中的时候，并且当TTreeview被foucus，就可以highlight该节点。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
http://www.honesed.com/blog/article.asp?id=111
istbox从文件中读取列表的操作
ListBox1.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'aaa.txt');
ListBox1.Items.Add(Edit1.Text); //添加了一个项目
ListBox1.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'aaa.txt');
删除项目ListBox1.Items.Delete(listbox1.itemindex);
------------------------------------
判断窗体是否已经打开
if frmPriceInput <> nil then ....
注意：有时窗体虽然已经关闭，但没完全释放，最好在该窗体关闭的CLOSE事件里加入 frmPrintInput = nil;
------------------------------------
关闭MDI子窗口的方法
在子窗口的OnClose事件处理过程中加入如下代码
Action := caFree;
Delphi为一个Form的关闭行为指定了四种方式，分别是：
caNone -- 禁止Form被关闭
caHide -- Form不被关闭，但是被隐藏。被隐藏的Form仍然可以被程序访问。
caFree -- Form被关闭，并且释放其占用的资源。
caMinimize -- Form被最小化而不是被关闭，这是MDI子窗口的默认关闭行为。
------------------------------------
系统配置文件 *.INI 的操作
头部要引用IniFiles
1、声明变量
IniFile:TiniFile;
2、指明路径
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'option.ini');
3、读取变量,注意变量有类型之分readstring,readinteger...等
titleBMPFile:=IniFile.ReadString('TitleImage','FileName',''); //IniFile.ReadString('组名','变量','默认值')
IniFile.ReadInteger
IniFile.ReadBool
4、写入或修改变量
IniFile.WriteString('标题','变量1','值');
5、用完后释放
IniFile.Free;
------------------------------------
动态读取图象
Image1.Picture.LoadFromFile(titleBMPFile);
------------------------------------
fastreport自定义函数的用法
1、先在普通工程窗体上定义好函数
2、在frreport控件的userfunction中写入
if ansicomparetext( 'My_StrToRMB' , Name ) = 0 then
val:=My_StrToRMB(frparser.Calc(p1));
//MY_STRTORMB是函数名
//如果定义多个函数，就多来几个IF即可。
在报表设计视图中就可以调用这个函数了。
------------------------------------
数组是这样定义的sbh:array [0..9999999,0..1] of string;
------------------------------------
treeview的用法
//先定义项目序数和节点
n: Integer;
Node: TTreeNode;
Node := Tree1.Selected;
if (Node = nil) or (Node.StateIndex = -1) then Exit;//一般可以把不作反应的列的stateindex定为-1
n := Node.StateIndex;
------------------------------------
Fields[] 通过索引返回字段,要自己選擇返回的類型!
FieldByName() 通过名字返回字段,要自己選擇返回的類型!
FieldValues[] 通过名字返回字段的值,自動化類型!
------------------------------------
调用外部程序方法
用ShellExecute，在USES段加入SHELLAPI，使用时如：
ShellExecute(handle,'open','c:/myapp/myapp.exe','-s','',SW_SHOWNORMAL);
第一个参数为父窗口句柄；
第二个参数为打开方式（OPEN，PRINT两种）；
第三个参数为执行文件全路径；
第四个参数为执行文件参数；
第五个参数为执行文件开始运行时的初始目录；
第六个参数为为执行文件运行方式(SW_HIDE,SW_MAXIMIZE,SW_MINIMIZE,
SW_RESTORE,SW_SHOW,SW_SHOWDEFAULT,SW_SHOWMAXIMIZED,SW_SHOWMINIMIZED,
SW_SHOWMINNOACTIVE,SW_SHOWNA,SW_SHOWNOACTIVATE,SW_SHOWNORMAL);
------------------------------------
判断文件是否存在
if not fileexists('db2.mdb.bak') then ...
------------------------------------
判断按键
if Key=#13 then //如果回车则。。。
------------------------------------
退出
关闭窗口 close;
关闭程序：Application.Terminate;
退出事件 exit;
------------------------------------
检测软件是否已在运行
if GetLastError = ERROR_ALREADY_EXISTS then...
------------------------------------
定义函数是这样写的
function IsReadOnly(b: Boolean; colors: Tcolor): Boolean;
------------------------------------
fastreport直接打印
FrReport1.PrepareReport; //初始化
FrReport1.PrintPreparedReport('1',1,True,frAll); //打印
预览FrReport1.showreport;
------------------------------------
找开浏览器，进入某站点。（或调用WINDOWS程序）
进入站点ShellExecute(Handle, PChar('OPEN'), PChar('http://www.devexpress.com/downloads/index.asp'), nil, nil, SW_SHOWMAXIMIZED);
发送邮件ShellExecute(Handle, 'open', PChar('mailto:' + edtemail.Text + '?subject='), nil, nil, SW_SHOW);
------------------------------------
打开文件对话框
if OpenPictureDialog.Execute then
------------------------------------
调用帮助文件
Application.HelpFile := '../../Help/eBars.hlp';
------------------------------------
打开窗口
TForm1.Create(self).ShowModal;
------------------------------------
取得当前执行程序的路径
FPath := ExtractFilePath(Application.ExeName);
或
FileName := ExtractFilePath(ParamStr(0)) + '/MDB/电子通讯录.mdb';
------------------------------------
当前路径
getcurrentdir
------------------------------------
判断当前鼠标处于某个位置（TAG）
case TComponent(Sender).Tag of
0: begin
...
lbBarBackgroud.Caption := sCustomImage;
end;
1: begin
...
lbBarBackgroud.Caption := sCustomImage;
end;
2: begin
...
lbBarBackgroud.Caption := sCustomImage;
end;
------------------------------------
数据库连接
1、建立一个adoconnection控件，命名为conn
2、建立一个adodataset控件,命名为ds
然后就可以用以下语句连接并执行SQL查询(本例是access的数据库，带密码)。
conn.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+getcurrentdir+'/data/pn.mdb;Persist Security Info=False;jet oledb:database password=80513';
conn.Connected:=true;
ds.Active:=false;
ds.CommandText:='select 拜访日期,拜访时间,拜访客户,拜访地点,谈话内容 from khbf order by 拜访日期 desc';
ds.Active:=true;
------------------------------------
ADODataSet1.State的用法
if ADODataSet1.State in [dsEdit,dsInsert] then
ADODataSet1.Post ;
------------------------------------
ADOQuery.open和ADOQuery.execSQL的区别
用于存贮时如insert 只能用execSQL
------------------------------------
------------------------------------
------------------------------------
------------------------------------
回车光标移到另一个输入框
if key=#13 then
cmb_name.SetFocus;
------------------------------------
播放声音
playsound('c:/windows/media/start.wav',0,SND_ASYNC);
------------------------------------
列表框listbox增加项目
cmb_name.Items.Add(adotable1.FieldValues['帐号']);
------------------------------------
listview用法
ListView.Selected := ListView.Items[0];
ListView.Selected.Focused := True;
ListView.Selected.MakeVisible(False);
ListView.Selected.Index
ListView.Items.Count
ListView.Items.Delete(3) //删除第3个项目
ListView.Items.Add.Caption:='dddddddd'; //增加一个项目
ListView.Items.BeginUpdate;
ListView.Items.EndUpdate
ListView.Canvas.Font.Color := clGrayText;
if ListView.Selected <> nil then。。。。。
//往listview添加项目
先定义
var itm: TListItem;
然后
listview.Items.Clear;
itm := listview.Items.Add;
itm.ImageIndex := 5;
itm.Caption := Msg.Subject;
itm.SubItems.Add('aaaaa');
itm.SubItems.Add('ffffff');
itm.SubItems.Add('ffdfdfdf');
itm.SubItems.Add('oooo');
------------------------------------
静态调用DLL的方法
有参数
procedure CreateSms(Text: Pchar);stdcall;External 'SmsLib.dll';
无参数
procedure CreateSms;stdcall;External 'SmsLib.dll';
------------------------------------
确定、取消对话框作用
if application.MessageBox('真的退出?','提示',mb_okcancel)=idok then
application.Terminate; //Terminate是终止程序
showmessage('请先选中要修改的班级'); //这个是简单的显示提示框
messagebox(self.Handle ,'价格输入不合法!','提示',MB_OK or MB_ICONASTERISK);
------------------------------------
调用窗体的步骤
先引用该窗体的单元，然后建立窗体，最后显示出来。
例1：
use uxsgl;
Application.CreateForm(TFmXsgl, FmXsgl);
fmxsgl.ShowModal;
例2：
Frm_LendDetail:=TFrm_LendDetail.Create(self);
Try
Frm_LendDetail.ShowModal;
Finally
Frm_LendDetail.Free;
End;
------------------------------------
数据库查询
先建立数据源，然后添加一个TADOQUERY
adoquery1.SQL.Clear ;
adoquery1.Close;
adoquery1.SQL.Add('select * from tkcb order by ckcb_kh');
adoquery1.Open;
aaa=adoquery1.FieldValues['ckcb_kc']; //取出当前记录某字段的值
adoquery1.Next; //下一记录
adoquery1.Close; //关闭查询
------------------------------------
判断键盘输入字符-chr(13)是回车
if key=chr(13) then
bitbtn1.SetFocus;
------------------------------------
时间格式
lblTime.Caption := FormatDateTime('yyyymmdd hh:nn:ss',Now);
------------------------------------
表数据的添加添加
dmd是数据模块 tbl_zgdb是表名
with dmd.tbl_zgdb do begin
Append;
FieldValues['HYZH'] := Edt_HYZH.text;
FieldValues['XM'] := Edt_xm.text;
FieldValues['XB'] := Edt_xb.text;
FieldValues['dw'] := Edt_dw.text;
FieldValues['ZZMM'] := zzmm;
FieldValues['CSNY'] := trim(Edt_csny.text);
FieldValues['GZSJ'] := Edt_gzsj.text;
FieldValues['DBLB'] := dblb;
FieldValues['ZCLB'] := zclb;
FieldValues['XL'] := xl;
FieldValues['BZ'] := Edt_bz.text;
Post;
close;
end;
------------------------------------
列表框的选项值
Edit1.Text:=listbox1.Items.Strings[listbox1.itemindex];
------------------------------------
Delphi键盘按键伪码
用法：if key = chr(VK_RETURN) then...
常数名称 十六进制值 十进制值 对应按键
VK_LBUTTON 01 1 鼠标的左键
VK_RBUTTON 02 2 鼠标的右键
VK-CANCEL 03 3 Contol-break 执行
VK_MBUTTON 04 4 鼠标的中键（三按键鼠标)
VK_BACK 08 8 Backspace键
VK_TAB 09 9 Tab键
VK_CLEAR 0C 12 Clear键
VK_RETURN 0D 13 Enter键
VK_SHIFT 10 16 Shift键
VK_CONTROL 11 17 Ctrl键
VK_MENU 12 18 Alt键
VK_PAUSE 13 19 Pause键
VK_CAPITAL 14 20 Caps Lock键
VK_ESCAPE 1B 27 Ese键
VK_SPACE 20 32 Spacebar键
VK_PRIOR 21 33 Page Up键
VK_NEXT 22 34 Page Domw键
VK_END 23 35 End键
VK_HOME 24 36 Home键
VK_LEFT 25 37 LEFT ARROW 键(←)
VK_UP 26 38 UP ARROW键(↑)
VK_RIGHT 27 39 RIGHT ARROW键(→)
VK_DOWN 28 40 DOWN ARROW键(↓)
VK_Select 29 41 Select键
VK_EXECUTE 2B 43 EXECUTE键
VK_SNAPSHOT 2C 44 Print Screen键
VK_Insert 2D 45 Ins键
VK_Delete 2E 46 Del键
VK_HELP 2F 47 Help键
VK_0 30 48 0键
VK_1 31 49 1键
VK_2 32 50 2键
VK_3 33 51 3键
VK_4 34 52 4键
VK_5 35 53 5键
VK_6 36 54 6键
VK_7 37 55 7键
VK_8 38 56 8键
VK_9 39 57 9键
VK_A 41 65 A键
VK_B 42 66 B键
VK_C 43 67 C键
VK_D 44 68 D键
VK_E 45 69 E键
VK_F 46 70 F键
VK_G 47 71 G键
VK_H 48 72 H键
VK_I 49 73 I键
VK_J 4A 74 J键
VK_K 4B 75 K键
VK_L 4C 76 L键
VK_M 4D 77 M键
VK_N 4E 78 N键
VK_O 4F 79 O键
VK_P 50 80 P键
VK_Q 51 81 Q键
VK_R 52 82 R键
VK_S 53 83 S键
VK_T 54 84 T键
VK_U 55 85 U键
VK_V 56 86 V键
VK_W 57 87 W键
VK_X 58 88 X键
VK_Y 59 89 Y键
VK_BZ 5A 90 Z键
VK_NUMPAD0 60 96 数字键0键
VK_NUMPAD1 61 97 数字键1键
VK_NUMPAD2 62 98 数字键2键
VK_NUMPAD3 63 99 数字键3键
VK_NUMPAD4 64 100 数字键4键
VK_NUMPAD5 65 101 数字键5键
VK_NUMPAD6 66 102 数字键6键
VK_NUMPAD7 67 103 数字键7键
VK_NUMPAD8 68 104 数字键8键
VK_NUMPAD9 69 105 数字键9键
VK_MULTIPLY 6A 106 *键
VK_ADD 6B 107 +键
VK_SEPARATOR 6C 108 Separator键
VK_SUBTRACT 6D 109 -键
VK_DECIMAL 6E 110 .键
VK_DIVIDE 6F 111 键
VK_F1 70 112 F1键
VK_F2 71 113 F2键
VK_F3 72 114 F3键
VK_F4 73 115 F4键
VK_F5 74 116 F5键
VK_F6 75 117 F6键
VK_F7 76 118 F7键
VK_F8 77 119 F8键
VK_F9 78 120 F9键
VK_F10 79 121 F10键
VK_F11 7A 122 F11键
VK_F12 7B 123 F12键
VK_NUMLOCK 90 144 Num Lock 键
VK_SCROLL 91 145 Scroll Lock键
==================
Delphi中怎么将实数取整？
floor 和 ceil 是 math unit 里的函数，使用前要先 Uses Math。
trunc 和 round 是 system unit 里的函数，缺省就可以用。
floor 直接往小的取，比如 floor(-123.55)=-124，floor(123.55)=123
trunc 直接切下整数，比如 trunc(-123.55)=-123, floor(123.55)=123
ceil 直接往大的取，比如 ceil(-123.55)=-123， ceil(123.55)=124
round 计算四舍五入，比如 round(-123.55)=-124，round(123.55)=124
==================================================
如何把RGB颜色转变成Delphi的 Tcolor?
form1.color:=rgbtocolor(255,0,0);
函数:
---------
function RGBToColor(R,G,B:Byte): TColor;
begin
Result:=B Shl 16 or
G Shl 8 or
R;
end;
===========================
回调函数(Callback Routine)的解释
MyWindowClassInfo = packed record
Style:UINT
...
lpFnWndProc:Pointer
...
end;
应 用程序只需要将一个能处理消息的函数地址指定给MyWindowClassInfo中的lpFnWndProc字段，执行环境就知道消息需要调用的函数， 于是应用程序可以把任何的函数地址指定给该字段以代表可以处理窗口消息的函数，这个函数是由执行环境来调用的，因此这种函数也被称为回调函数 (Callback Routine)。
回调函数的机制：调用者在初始化一个对象的时候，将一些参数传递给对象，同时将一个调用者可以访问的函数地址传递给该对象，这个函数就是调用者和被调用者之间的一种通知约定，当约定的事件发生时，被调用者就会按照回调函数地址调用该函数。
/
Object Inspector(对象检视器)
Properties页显示窗体中当前被选择部件的属性信息
Events页列出了当前部件可以响应的事件
（小窍门：Object Inspector一直可见，可将鼠标移到Object Inspector上，按动右键，以启动Object Inspector的弹出式菜单，将其设置为Stay On Top。）
部件的调整与对齐
如果要精确地表述部件的尺寸，可以在Object Inspector上，改变Left(表示部件左边缘到窗体左边框的象素点数)、Top(表示窗体上边框到部件上边缘的象素点数)、 Width(部件本身的宽度)、Height(部件本身的高度)等属性。
使四个按钮对齐。先将四个按钮选为一组：按住并向右下方拖动鼠标左键，在窗体上画出围绕四个按钮的矩形，释放左键后，被选中的按钮周边会出现暗灰色的边框。选用Edit|Align命令，
或选中4个按钮，出现灰色边框后，点右键，选择position,后面align…等，是不同方式的对齐，可以调整同样大小的尺寸。
锁定部件
选择主菜单上的Edit|Lock Controls选项
设置窗体的缺省按钮
按钮的Default属性从False改成True，即将它设为窗体的缺省按钮
OnClick事件，即按钮接收到左键单击时应用程序所作出的反应
ColorDialog1.Execute;
程序的第一句用Execute方法，使得ColorDialog运行它本身
Label(标签)一般放在对象的旁边，用来标记这些对象，当用户使用“Alt+关键字母”时，将自动选中它所指向的对象。方法是设置Label部件的FocusControl属性，在值段中，选用与它关联对象的对象名。
Edit、 MaskEdit、Memo部件都是用作接收、显示用户输入文本的。ReadOnly在运行时间内控制对象是否可以进行Windows的操作，当此值为 False时，该框内的文本就不能被复制到剪贴板上。MaxLength可以设置输入文本的长度限制。用PasswordChar属性可以按照显示隐蔽密 码的方法显示用户输入文本。当一个字段被加上高亮度显示时，按键操作会将这一字段删除，替换成当前的键盘输入。这种设置为操作提供了方便，您不必每次先删 除原来的文本；但也可能会导致误删文本。将AutoSelect属性设置成False，这种替代功能就被取消了。
它的EditMask属性为它提供了过滤文本的格式。点动这一属性的省略按钮，会弹出过滤编辑对话框
Memo 是备注框，与以上对象不同的是，它可以接收多行文本输入。将ScrollBars设置成ssVertical，可以为它加上一个垂直的滚行条。Align 属性调整该对象在窗口中的对齐情况，有alNone(无对齐指定)、alBottom(底部对齐)、alClient(全窗口显示)等可以选择；而 Alignment属性则决定了文本在框中的对齐显示格式。Lines属性访问的文本被存储在一个TStrings对象中，按动它的省略按钮，可以通过对 话框向它增加文本，也可以用程序对这一属性进行操作，以达到修改或增加备注文本的目的。
Combo Box(组合框) 显示可用磁盘驱动器
List Box(列表框) Windows打开文件操作时显示文件列表