New Page 1

2003-11-27


启动Word时用如下代码：
begin
try
Wordapplication.Connect;
except
MessageDlg('Word may not be installed', mtError, [mbOk], 0);
Abort;
end;
Wordapplication.Visible := True;
WordApplication.Caption := 'Delphi automation';
end;
让Word打开一个指定的文件，需要先放置OpenDialog，然后调用WordApplication.Documents.Open：
var
ItemIndex :OleVariant;
FileName, ConfirmConversions, ReadOnly, AddToRecentFiles,
PasswordDocument, PasswordTemplate,
Revert,
WritePasswordDocument, WritePasswordTemplate,
Format: OleVariant;
begin
if not dlgOpen.Execute then
Exit;

{Open document}
FileName := dlgOpen.FileName;
ConfirmConversions := False;
ReadOnly := False;
AddToRecentFiles := False;
PasswordDocument := '';
PasswordTemplate := '';
Revert := True;
WritePasswordDocument := '';
WritePasswordTemplate := '';
Format := wdOpenFormatDocument;

WordApplication.Documents.Open( FileName, ConfirmConversions,
ReadOnly, AddToRecentFiles, PasswordDocument,
PasswordTemplate,
Revert, WritePasswordDocument, WritePasswordTemplate,
Format );

{Assign WordDocument component}
ItemIndex := 1;
WordDocument.ConnectTo(WordApplication.Documents.Item(ItemIndex));

{Turn Spell checking of because it takes a long time if enabled and slows down
Winword}
WordApplication.Options.CheckSpellingAsYouType := False;
WordApplication.Options.CheckGrammarAsYouType := False;
end;

判断Word是否运行

先在Form上添加一个Server组件中的WordApplication,命名为WordApplication1,然后在"关闭WORD"按扭中输入如下代码：
var
SaveChanges, OriginalFormat, RouteDocument: OleVariant;
begin
SaveChanges := WdDoNotSaveChanges;
OriginalFormat := UnAssigned;
RouteDocument := UnAssigned;
try
WordApplication1.Quit(SaveChanges, OriginalFormat, RouteDocument);
WordApplication1.Disconnect;
except
on E: Exception do
begin
Showmessage(E.Message);
WordApplication1.Disconnect;
end;
end;
end;
准成，当然了，请按实际情况修改 SaveChanges, OriginalFormat, RouteDocument的内容.


程序中实现的办法：

如何将Excel文件中的数据倒入Delphi本地库(Paradox)?[2000-04-26]
label PH;
var
msexcel : olevariant;
wbook, wsheet : olevariant;
i,j : integer;
temp : string;
...
begin
MsExcel := CreateOleObject('Excel.Application');
WBook := MsExcel.Application;
WBook.Visible := False;
wbook.workbooks.Open('c:\xxxx.xls');//打开Excel文档
WSheet := WBook.ActiveSheet;
for i := 1 to WSheet.Rows.count - 1 do
begin
Table1.Append; //Paradox表,其它表当然也可以了
for j := 1 to WSheet.Columns.Count do
begin
temp := wsheet.cells[i, j].value;
if Trim(temp) = '' then //如果为空则跳出循环,当然，
// 也可以是其它条件
goto PH;
Table1.Fields[j - 1].AsString := temp;
end;
PH:
if Trim(wsheet.cells[i, 1].Value) = '' then break;//跳出循环
end;
...
WBook.SaveAs('c:\xxxx.xls');
MsExcel.quit;
end;
注意:Tabel1的字段数要大于要倒入的Excel文档的列数

    在数据库应用软件的开发过程中，经常需要把数据转换成Excel文件,让用户作进一步的数据处理。而Delphi是开发数据库应用系统的常用工具，那么，如何在Delphi中操作Excel呢?

    我们知道,在Microsoft Office软件中有一种内嵌的编程语言VBA,它是一种宏语言，利用它,你可以编写出功能强大的代码,如打开文件、修改数据、保存数据和设置字体等。另一方面,Microsoft Office软件中的宏能以VBA代码的形式记录下你的操作过程。因此借助宏操作,可以很轻松地实现某一功能,并把这些代码稍作修改嵌入到你的软件中。但是VBA也存在一个缺点,它必须有Microsoft Office作平台,在哪里编写,必须在哪里执行。例如在Excel下编写的一段VBA代码,则它只有在Excel下才能运行。因此,笔者的方法就是把VBA代码嵌入到Delphi中,从而实现用Delphi操作Excel。

    下面,我们以Delphi程序为例,说明这种调用方法：

    Unit excel;

    interface

    uses

    Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls,ComObj;

    //ComObj是操作OLE对象的函数集

    type TForm1 =class(TForm)

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

    private

    { Private declarations }

    public

    { Public declarations }

    end;

    var

    Form1: TForm1;

    implementation

    {$R *.DFM}

    procedure TForm1.Button1Click(Sender: TObject);

    var

    eclApp,WorkBook:Variant;

    //声明为OLE Automation 对象

    xlsFileName:string;begin

    xlsFileName:='ex.xls';

    try

    //创建OLE对象Excel Application与 WorkBook

    eclApp:=CreateOleObject('Excel.Application');

    WorkBook:=CreateOleobject('Excel.Sheet');

    except

    ShowMessage('您的机器里未安装Microsoft Excel。');

    Exit;

    end;

    try

    ShowMessage('下面演示:新建一个XLS文件,并写入数据,最后关闭它。');

    workBook:=eclApp.workBooks.Add;

    eclApp.Cells(1 , 1):='字符型';

    eclApp.Cells(2 , 1):='Excel文件';

    eclApp.Cells(1 , 2):='Money型';

    eclApp.Cells(2 , 2):=10.01;

    eclApp.Cells(1 , 3):='日期型';eclApp.Cells(2 , 3):=Date;

    WorkBook.saveas(xlsFileName);

    WorkBook.close;

    ShowMessage('下面演示:打开刚创建的XLS文件,并修改其中的内容,然后,由用户决定是否保存。');

    WorkBook:=eclApp.workBooks.Open(xlsFileName);

    eclApp.Cells(2 , 1):='Excel文件类型';

    if MessageDlg(xlsFileName+'文件已被修改,是否保存?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then

    WorkBook.save

    else

    workBook.Saved := True; //放弃修改

    WorkBook.Close;

    eclApp.Quit;

    //退出Excel Application

    //释放VARIANT变量

    eclApp:=Unassigned;

    except

    ShowMessage('不能正确操作Excel文件。可能是该文件已被其他程序打开,或系统错误。');

    WorkBook.close;

    eclApp.Quit;

    //释放VARIANT变量

    eclApp:=Unassigned;

    end;

    end;

    end.

    经过上述操作过程后,我们就可以很放心地将数据库中的数据转换成Excel文件了。


全面控制 Excel 首先创建 Excel 对象

全面控制 Excel
首先创建 Excel 对象，使用ComObj:
var ExcelID: Variant;
ExcelID := CreateOleObject( 'Excel.Application' );
1) 显示当前窗口：
ExcelID.Visible := True;
2) 更改 Excel 标题栏：
ExcelID.Caption := '应用程序调用 Microsoft Excel';
3) 添加新工作簿：
ExcelID.WorkBooks.Add;
4) 打开已存在的工作簿：
ExcelID.WorkBooks.Open( 'C:\Excel\Demo.xls' );
5) 设置第2个工作表为活动工作表：
ExcelID.WorkSheets[2].Activate;
或
ExcelID.WorksSheets[ 'Sheet2' ].Activate;
6) 给单元格赋值：
ExcelID.Cells[1,4].Value := '第一行第四列';
7) 设置指定列的宽度（单位：字符个数），以第一列为例：
ExcelID.ActiveSheet.Columns[1].ColumnsWidth := 5;
8) 设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：
ExcelID.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米
9) 在第8行之前插入分页符：
ExcelID.WorkSheets[1].Rows[8].PageBreak := 1;
10) 在第8列之前删除分页符：
ExcelID.ActiveSheet.Columns[4].PageBreak := 0;
11) 指定边框线宽度：
ExcelID.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;
1-左 2-右 3-顶 4-底 5-斜( \ ) 6-斜( / )
12) 清除第一行第四列单元格公式：
ExcelID.ActiveSheet.Cells[1,4].ClearContents;
13) 设置第一行字体属性：
ExcelID.ActiveSheet.Rows[1].Font.Name := '隶书';
ExcelID.ActiveSheet.Rows[1].Font.Color := clBlue;
ExcelID.ActiveSheet.Rows[1].Font.Bold := True;
ExcelID.ActiveSheet.Rows[1].Font.UnderLine := True;
14) 进行页面设置：
a.页眉：
ExcelID.ActiveSheet.PageSetup.CenterHeader := '报表演示';
b.页脚：
ExcelID.ActiveSheet.PageSetup.CenterFooter := '第&P页';
c.页眉到顶端边距2cm：
ExcelID.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
d.页脚到底端边距3cm：
ExcelID.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
e.顶边距2cm：
ExcelID.ActiveSheet.PageSetup.TopMargin := 2/0.035;
f.底边距2cm：
ExcelID.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
g.左边距2cm：
ExcelID.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
h.右边距2cm：
ExcelID.ActiveSheet.PageSetup.RightMargin := 2/0.035;
i.页面水平居中：
ExcelID.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
j.页面垂直居中：
ExcelID.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
k.打印单元格网线：
ExcelID.ActiveSheet.PageSetup.PrintGridLines := True;
15) 拷贝操作：
a.拷贝整个工作表：
ExcelID.ActiveSheet.Used.Range.Copy;
b.拷贝指定区域：
ExcelID.ActiveSheet.Range[ 'A1:E2' ].Copy;
c.从A1位置开始粘贴：
ExcelID.ActiveSheet.Range.[ 'A1' ].PasteSpecial;
d.从文件尾部开始粘贴：
ExcelID.ActiveSheet.Range.PasteSpecial;
16) 插入一行或一列：
a. ExcelID.ActiveSheet.Rows[2].Insert;
b. ExcelID.ActiveSheet.Columns[1].Insert;
17) 删除一行或一列：
a. ExcelID.ActiveSheet.Rows[2].Delete;
b. ExcelID.ActiveSheet.Columns[1].Delete;
18) 打印预览工作表：
ExcelID.ActiveSheet.PrintPreview;
19) 打印输出工作表：
ExcelID.ActiveSheet.PrintOut;
20) 工作表保存：
if not ExcelID.ActiveWorkBook.Saved then
ExcelID.ActiveSheet.PrintPreview;
21) 工作表另存为：
ExcelID.SaveAs( 'C:\Excel\Demo1.xls' );
22) 放弃存盘：
ExcelID.ActiveWorkBook.Saved := True;
23) 关闭工作簿：
ExcelID.WorkBooks.Close;
24) 退出 Excel：
ExcelID.Quit;


如果用的是MICROSOFT 旗下的数据库管理系统生成的表例如

如果用的是MICROSOFT
旗下的数据库管理系统生成的表例如*.DBF等，可以通过OLE技术直接在WORD文档中显示完整的数据表。
如果用PARADOX表，可以用下面的方法：
var
msword:variant;
begin
try
msword:=createoleobject('word.basic');
msword.filenew;
msword.appshow;
table1.disablecontrols;
try
bookmark:=table1.getbookmark;
try
msword.bold;
msword.insert('报表标题'#13#10);
msword.insert('字段名1'+#9+....+'字段名n'#13#10);
table1.first;
while not table1.eof do
begin
msword.insert(table1.fieldbyname(字段名1).asstring+#9+.....+table1.fieldbyname(字段名n).asstring+#13#10);
msword.next;
end;
finally
table1.gotobookmark(bookmark);
table1.freebookmark(bookmark);
end;
finally
table1.enablecontrols;
end;
except
showmessage('没有发现WORD，请安装！');
end;
end;
//在OLE服务器WORD启动后自动写了一个制表文件，此时只要选择全部数据（除标题），然后选插入表格即可作出WORD报表。
//如果有其他好方法请与我联系。
//我想解决的是在程序中自动画出表格。

控制Word

var
tbl : Table;
i,j:integer;
un_Var,ex_Var,cnt_Var:OleVariant;
row_num,col_num:integer;
st:string;
begin
// 在Word中新建一个文档，并添加文本，然后设置粗体和字体大小
WordApplication1.Connect;
WordApplication1.Visible := True;
WordApplication1.Documents.Add(EmptyParam,EmptyParam);
WordDocument1.Connect;
WordApplication1.ActiveWindow.View.Type_:= wdNormalView;
WordApplication1.Selection.Font.Name :='黑体';
WordApplication1.Selection.Font.Size := 16;
WordApplication1.Selection.ParagraphFormat.Alignment :=
wdAlignParagraphCenter;
WordApplication1.Selection.TypeText('昆明市土地信息系统表格输出');
WordApplication1.Selection.TypeParagraph;
WordApplication1.Selection.TypeParagraph;
WordApplication1.Selection.Font.Name :=  '宋体';
WordApplication1.Selection.Font.Size :=12;
WordApplication1.Selection.ParagraphFormat.Alignment :=
wdAlignParagraphRight;
WordApplication1.Selection.TypeText('日期'+formatdatetime('yyyy"年"mm"月"dd"日"',now));
WordApplication1.Selection.TypeParagraph;
WordApplication1.Selection.TypeParagraph;//回车
WordApplication1.Selection.ParagraphFormat.Alignment :=
wdAlignParagraphLeft;
row_num:=table1.RecordCount;
col_num:=table1.Fields.Count;
tbl :=
WordApplication1.ActiveDocument.Tables.Add(WordApplication1.Selection.Range,row_num+1,Col_num);
un_Var:=wdCharacter;
cnt_Var:=1;
ex_Var:=wdMove;
table1.First;
for j := 0 to Col_num-1 do    //标题
begin
st:=table1.Fields.Fields[j].FieldName;
WordApplication1.Selection.TypeText(st);
WordApplication1.Selection.MoveRight(un_Var,cnt_Var,ex_Var);
end;
for i := 0 to row_num-1 do    // 行
begin
for j := 0 to Col_num-1 do    //
列
begin
st:=table1.Fields.Fields[j].AsString;
WordApplication1.Selection.TypeText(st);
WordApplication1.Selection.MoveRight(un_Var,cnt_Var,ex_Var);
end;
WordApplication1.Selection.MoveRight(un_Var,cnt_Var,ex_Var);
table1.next;
end;
WordApplication1.Selection.TypeText('制表人:阎磊');
WordApplication1.Selection.TypeParagraph;
end;

可以参考以下代码：

procedure PrintReport4(DSR, AJXZ, CFSJ, JBAQ: PChar); stdcall;

var

  Word, Doc, Fields:OleVariant;

begin

  Word:=CreateOleObject('Word.Application');

  Word.Visible:=True;

  Word.Documents.Add('C:\Customs\案件呈报表');

  Doc := Word.ActiveDocument;

  Fields := Doc.FormFields;

  Fields.Item('DSR').Result  := String(DSR);

  Fields.Item('AJXZ').Result := String(AJXZ);

  Fields.Item('CFSJ').Result := String(CFSJ);

  Fields.Item('JBAQ').Result := String(JBAQ);

end;

其中案件呈报表就是word模版文件。

打开WORD文档的一段程序

uses ComObj ;

procedure TForm1.Button1Click(Sender: TObject);

var

  vWord,vDoc,vRange : Variant ;

  sText,sReplace : string ;

  lReturn : Boolean ;

begin

  sText := 'ABCDEFG' ;  //原文字串

  sReplace := 'GFEDCBA' ; //新字串

  vWord := CreateOleObject('Word.Application') ;//创建Word线程

  try

    //打开要操作的文件

    vDoc := vWord.Documents.Open('C:\My Documents\AAAc.Doc');

    vDoc.Select ;  //选取中整个文档

    vRange := vDoc.Range ; //替换范围

    lReturn := True ;

    while lReturn do

    begin  //找到并替代成功则返回 True    共11个参数

      lReturn := vDoc.Range.Find.Execute(sText,,,,,,,,,sReplace,True) ;

    end ;

  finally

    vDoc.Close(True) ; //关闭文并保存

    vWord.Quit(False) ; //退出Word

  end ;

end;

Delphi 3 下通过。

控制WORD文档的一段程序

unit Unit1;

interface

uses

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

StdCtrls,OleCtnrs,ComObj;

type

    TForm1 = class(TForm)

    Label1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    Label4: TLabel;

    Label5: TLabel;

    ED_WenHao: TEdit;

    ED_BiaoTi: TEdit;

    ED_ShouWenDanWei: TEdit;

    ED_ZhenWen: TMemo;

    ED_FaWenDanWei: TEdit;

    Btn_PrintToWord: TButton;

    Btn_Quit: TButton;

    procedure Btn_PrintToWordClick(Sender: TObject);

    procedure Btn_QuitClick(Sender: TObject);

    private

        { Private declarations }

    public

        { Public declarations }

end;

var

    Form1: TForm1;

implementation

{$R *.DFM}

//开始：数据发送到 word事件

procedure TForm1.Btn_PrintToWordClick(Sender: TObject);

vAR

    VarWord: Variant;// 创建 WORD时所用

begin

    try

        // 1. 建立 OleObject，连接 word97

        VarWord:=CreateOleObject('word.basic');

        // 2. 建立 Word97的新文件

        VarWord.FileNew;

        // 3. 设置 Word97的基本状态

        VarWord.ViewZoom75; //设置显示比例为 75%

        VarWord.ViewPage; //改为页面显示方式

        // 4. 将当前数据控件上的信息发送至 Word97

        // 4.1 发送文号数据

        VarWord.CenterPara; //居中

        Varword.font('宋体 '); //设置字体

        VarWord.FontSize(14); //设置字号

        varword.insert(#13+#13+ ED_WenHao.Text+#13+#13+#13);

        // 4.2 发送标题数据

        VarWord.font('黑体 ');

        VarWord.Fontsize(16);

        VarWord.insert( ED_BiaoTi.text+#13);

        // 4.3 发送收文单位数据

        VarWord.LeftPara; //左对齐

        VarWord.Font('宋体 ');

        VarWord.fontSize(14);

        VarWord.Insert(#13+ ED_ShouWenDanWei.Text+'： '+#13);

        // 4.5 发送正文数据

        VarWord.fontSize(14);

        VarWord.Insert( ED_ZhenWen.Text+#13);

       // 4.6 发送发文单位数据

        VarWord.RightPara; //右对齐

        VarWord.fontSize(14);

        VarWord.Insert( ED_FaWenDanWei.Text+#13);

        // 5 最后设置

        VarWord.StartOfdocument; //到文首

        VarWord.AppMaxiMize; //设置窗口最大化

        VarWord.AppShow; //显示应用程序

    except

        showmessage('运行 Microsoft Word 失败！ ');

    end; //end of try

end;

//end：数据发送到 word事件

//开始：窗口关闭事件

procedure TForm1.Btn_QuitClick(Sender: TObject);

begin

        close;

end;

//End：窗口关闭事件

end.

// 这是主程序的尾部

！我保证你们看到以下的用法一定爽歪歪了！！！

这可是我三天工作的结果。唔。。。

---看最后终结者office。

--------------------------------

如果你们用的office97的server控件，那么用office2000时就要把server上的控件换掉。

做法：

1。在Componet里打开Install Packages.....

2.去掉borland sample automation server components

3.在project中点input type Library....

4.点add加入office2000的类库。（在Microsoft Office/office目录下的）

5。反正是什么Excel9.olb , Msword9.olb 和那些*.olb的东东，有excel的，word的，等。。。

6。palette page:改为servers(因为以前的office的控件完完了）

7。点install就好了。

这样office2000的问题我想应解决了。（如果你用的是什么word.application或excel.application 的控件的话）。

-----------

我的建议：

    先用上面一的方法，再用comobj对象。

use comobj, excel_tlb; //excel_tlb 是新excel控件的pas文件，你把新控件放在窗体上看它用的哪个.pas就好了，当然下面要把这个控件去掉。因为comobj不用这个控件。只用这个.pas如excel_tlb中的函数。

var xl:variant;

在事件里写：

xl:=createoleobject('Excel.Application');

然后打开excel或word录一个宏命令，并打开宏命令考入代码。

----以下是宏录下来的宏。

  workbooks.add

  Range("C5:D7").Select

    Sheets("Sheet2").Select

    ActiveWindow.SelectedSheets.Delete

    Charts.Add

    ActiveChart.ChartType = xlColumnClustered

    ActiveChart.SetSourceData Source:=Sheets("Sheet3").Range("A1")

    ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet3"

-------

现在把它改为以下：

  xl.workbooks.add;

 xl.workbooks.add('d:\test.xls');

  xl.Range['C5:D7'].Select;

  xl.Sheets['Sheet2'].Select;

  xl.ActiveWindow.SelectedSheets.Delete;

  xl.Charts.Add;

  xl.ActiveChart.ChartType := xlColumnClustered;

  xl.ActiveChart.Location(xlLocationAsObject,'Sheet3');

现在运行一下，我保证你们爽歪歪!

看到规律了吗？

前面加上对象名，（）改[]，= 改:=,有参数时直接用，后加;  。哈哈，满意了吧，

用office的宏命令可是不用你去想编程的，全是手动。这样少写了一大堆代码。

bbcoll  如有不明白的朋友讨论可：bbcoll@china.com

、存入

 procedure TForm1.Button1Click(Sender: TObject);

var

  CurST:TStringStream;

  Filename:string;

begin

  if OpenDialog1.Execute then

  begin

   Filename:=OpenDialog1.FileName;

   wordOleContainer.CreateObjectFromFile(FileName, False);

   CurST := tstringstream.create('');

   wordOleContainer.savetostream(CurST);

   ADOTable1.Append;

   ADOTable1.FieldByName('doc').AsVariant:=CurST.datastring;

   ADOTable1.Post;

   CurST.free;

   wordOleContainer.DestroyObject;

  end; }

end;

//读出

procedure TForm1.BitBtn1Click(Sender: TObject);

var

    CurItemStream:TStringStream;

   CurItem:Variant;

begin

     CurItem:=aDOTable1.FieldByName('doc').AsVariant;

     CurItemStream:= TStringstream.create(CurItem);

     CurItemStream.position:=0;

     wordOleContainer.loadfromstream(CurItemStream);

     CurItemStream.free;

     wordOleContainer.SaveAsDocument('temp.rtf');

     wordOleContainer.DestroyObject;

     sleep(5000);

     richedit1.lines.loadfromfile('temp.rtf');//此处读出rtf可能是乱码，请查看delphi

   //richedit demo

end;


Delphi 程序员之家——

程序员之家
2003年06月30日 星期一
首页|数据库应用|文件应用|多媒体设计|网络应用|数据安全|使用技巧|界面设计|其它|网友来稿|精彩控件|Delphi书籍|留言讨论区
留言讨论区
师资班同学录
欢迎网友来稿
添加到收藏夹
给站长的信

为了更好的建设本站，请您留下对本网站的建议：
昵称：
邮箱：
建议：

如何在Delphi应用程序中调用文档
在开发应用程序过程中， 为更好地方便用户熟悉此软件的功能和使用方法， 我们可以使用CHM的帮助文档。那么， 如何更好地使CHM文档融入到你的应用程序中呢？笔者谈谈一种简单、方便的方法， 以供参考。

在Win9.x的system目录下(或Win2000的system32目录下)可以找到hhctrl.ocx文件， 虽然这个文件是ActiveX， 但是它还可以当成DLL动态链接库使用，不过它必须在IE4.0以后才有提供。通过分析 hhctrl.ocx 文件，可以看出它提供了一个HtmlHelpA函数来对CHM文件进行调用。

首先，在implementation里，作如下声明：

function HtmlHelpA(hwndCaller: THandle; pazFile: String;

uCommand, dwData: DWord): DWord; stdcall external ’hhctrl.ocx’;

然后就可以进行使用，例如：

HtmlHelpA (handle, ’c\winnt\help\access.chm’, 0, 0);

非常简单吧， 试试看， 您一定行的， 为你的程序加入这个简单易行的功能吧！
文章作者：詹炜鑫
文章来源：原创(发表于CSDN)
作者邮箱：zhanweixin@163.com
作者网站：http://zhanweixin.yeah.net
浏览次数：2964

发表高见：
昵称：
邮箱：
评论：

网友评论：

昵称： | -_-
邮箱： | modofu@sohu.com
日期： | 2003年05年04日 17时26分43秒
评论： | 不行啊

昵称： | windzx
邮箱： | windzaixian@sohu.com
日期： | 2003年04年24日 11时45分31秒
评论： | 不知道如何调用word文档请指教

昵称： | windzx
邮箱： | windzaixian@sohu.com
日期： | 2003年04年24日 11时36分56秒
评论： | 不行

昵称： | vicent
邮箱： | lgh525@yahoo.com.cn
日期： | 2003年04年18日 11时44分47秒
评论： | 太好了

昵称： | kuku
邮箱： | lijingbin486@sohu.com
日期： | 2003年04年12日 17时34分09秒
评论： | 在程序中嵌入windows脚本,可以调用任何文档，就像dos下的批处理程序

昵称： | 无知
邮箱： | xjsongsj@21cn.com
日期： | 2003年04年10日 13时31分28秒
评论： | 我想问一下如何在多文档中调用子文档. 比如在主菜单中调用菜单中所指的表单,如何在代码段中写代码?怎样写?谢谢!

昵称： | purple
邮箱： | taodongxia@sohu.com
日期： | 2003年04年07日 09时22分30秒
评论： | 那我怎么调用powerpoint或word呢？谢谢！
【合作站点】
返回页顶

制作维护: DBoy
http://www.delphiboy.com e_mail:webmaster@dboy520.51.net


New Page 2

:::运行时生成控件:::
㈠、运行时生成可视控件：以下以TEdit 控件为例
1.在Form的Public中定义TEdit控件
    Edit1:TEdit;
2.在需要生成的地方加入以下代码：
    Edit1:=TEdit.Create(Self);
    Edit1.Parent:=Form1;
    Edit1.Left ?:=20;
    Edit1.Top :=20;
    Edit1.Text :='Edit1 Text';
3.使用完毕后，释放分配的资源
    if? Assigned(Edit1) then Edit1.Free; ?
    ㈡、运行时生成非可视控件：以下以 TTimer控件为例
1.在Form的Public中定义TTimert控件
    Timer1:TTimber;
2.在需要生成的地方加入以下代码：
    Timer1:=TTimer.Create(Self);
    Timer1.OnTimer:=YourAction;
YourAction是自己定义的OnTimer事件，使用
procedure TForm1.YourAction(Sender:TObject); 完成
3.使用完毕后，释放分配的资源
    if? Assigned(Timer1) then Timer1.Free; ?


New Page 3

:::DELPHI4.0动态数组:::

DELPHI4.0动态数组
方法:
var
A:array of Integer;
begin
ShowMessage(IntToStr(High(A))); //<- 值为1
SetLenght(A,3);
ShowMessage(IntToStr(High(A))); //<- 值为3
end;
注:这是DELPHI4.0新添的功能.

6.DELPHI中怎样建立一个动态数组? 如何Resize 一个数组?
问 How Do I Create A Dynamic Arrays In Delphi? And How Can I Resize A Array?

答 You cannot resize a non-dynamic array in Pascal. You can
create and resize a dynamically created array. To do this, you
must create the dynamic array, turn range checking off,
and access the array members via a variable only, or you
will receive runtime and compile time errors. Since you will
access the array through a pointer variable, you can dynamically
resize the array by creating a new array in memory, then copy all the
valid elements of the original array to the new array, then free the
memory
for the original array, and assign the new array's pointer back to the
original array pointer.
Example:

type
TSomeArrayElement = integer;
PSomeArray = ^TSomeArray;
TSomeArray = array[0..0] of TSomeArrayElement;

procedure CreateArray(var TheArray : PSomeArray;
NumElements : longint);
begin
GetMem(TheArray, sizeof(TSomeArrayElement) * NumElements);
end;

procedure FreeArray(var TheArray : PSomeArray;
NumElements : longint);
begin
FreeMem(TheArray, sizeof(TSomeArrayElement) * NumElements);
end;

procedure ReSizeArray(var TheArray : PSomeArray;
OldNumElements : longint;
NewNumElements : longint);
var
TheNewArray : PSomeArray;
begin
GetMem(TheNewArray, sizeof(TSomeArrayElement) * NewNumElements);
if NewNumElements > OldNumElements then
Move(TheArray^,
TheNewArray^,
OldNumElements * sizeof(TSomeArrayElement)) else
Move(TheArray^,
TheNewArray^,
NewNumElements * sizeof(TSomeArrayElement));
FreeMem(TheArray, sizeof(TSomeArrayElement) * OldNumElements);
TheArray := TheNewArray;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
p : PSomeArray;
i : integer;
begin
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}

CreateArray(p, 200);
for i := 0 to 199 do
p^[i] := i;
ResizeArray(p, 200, 400);
for i := 0 to 399 do
p^[i] := i;
ResizeArray(p, 400, 50);
for i := 0 to 49 do
p^[i] := i;
FreeArray(p, 50);

{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
end;

-----------------
另外，在使用动态实数数组的时候，数组元素类型最好声明为 single 或 double
因为 single 和 double 类型使用的是 FPU 运算,而 real 不是
---------------------
回答2
It seems that the "best" way to deal with this is not necessarily by
declaring a pointer type and doing dynamic memory allocation etc.(as most of

you approached this problem) but (as one of you pointed out) to use Delphi's
"Variant support routines" (see Help) where you can create dynamic arrays of
Variants and manipulate them using the SYSTEM unit. Some of the function
names are:

VarArrayCreate -- Creates a variant array of given bounds and type.
VarArrayDimCount -- Returns the number of dimensions of a given variant.
VarArrayHighBound -- Returns the high bound of a given dimension of a given variant array.
VarArrayLock -- Locks a given variant array.
VarArrayLowBound -- Returns the low bound of a given dimension of a given variant array.
VarArrayOf -- Returns a given variant array with specified elements.
VarArrayRedim -- Resizes a given variant array by changing the high bound.
VarArrayUnLock -- Unlocks a given variant array.


New Page 1

◇[DELPHI]简单的剪贴板操作

richedit1.selectall;

richedit1.copytoclipboard;

richedit1.cuttoclipboard;

edit1.pastefromclipboard;

◇[DELPHI]关于文件、目录操作

Chdir('c:\abcdir');转到目录

Mkdir('dirname');建立目录

Rmdir('dirname');删除目录

GetCurrentDir;//取当前目录名，无'\'

Getdir(0,s);//取工作目录名s:='c:\abcdir';

Deletfile('abc.txt');//删除文件

Renamefile('old.txt','new.txt');//文件更名

ExtractFilename(filelistbox1.filename);//取文件名

ExtractFileExt(filelistbox1.filename);//取文件后缀

◇[DELPHI]处理文件属性

attr:=filegetattr(filelistbox1.filename);

if (attr and faReadonly)=faReadonly then ... //只读

if (attr and faSysfile)=faSysfile then ... //系统

if (attr and faArchive)=faArchive then ... //存档

if (attr and faHidden)=faHidden then ... //隐藏

WINEXEC//调用可执行文件

winexec('command.com /c copy *.* c:\',SW_Normal);

winexec('start abc.txt');

ShellExecute或ShellExecuteEx//启动文件关联程序

function executefile(const filename,params,defaultDir:string;showCmd:integer):THandle;

ExecuteFile('C:\abc\a.txt','x.abc','c:\abc\',0);

ExecuteFile('http://tingweb.yeah.net','','',0);

ExecuteFile('mailto:tingweb@wx88.net','','',0);


New Page 5

:::DELPHI中动态链接库的使用:::

---- 在DELPHI中，有两种方法可用于调用一个储存在DLL（动态链接库）中的过程。

---- 一、 调用方法

---- 1、静态调用或显式装载使用一个外部声明子句，使DLL在应用程序开始执行前即被装入。例如：

Function instring (sourcestr: Pchar ; check: char): integer; far; external ‘ demostr’
---- 这种方式要在单元的interface 部分用external 指示字列出要从DLL中调用的例程。Far 指令表明可
以被其他段，例如其他单元调用的子例程。所有在单元接口中声明的子例程在缺省情况下都是Far类型的，其
相反的指令是near。

---- 如果external 后什么也不跟，必须用 {$ L } 编译指令预先指定一个DLL名字，如：

{ $ L Mydlls.dll }
Procedure setstring(var str: string) ;
stdcall ; external
---- 但是使用静态调用方法时，程序无法在运行时间里决定DLL的调用。在DELPHI中使用DLL时，例程的标
识符必须与DLL中相应输出例程的标识符完全一致（尽管DELPHI本身大小写不敏感）。

---- 2、动态调用或隐式装入

---- 使用WINDOWS API 函数 Loadlibrary 和GetprocAddress可以实现在运行时间里的动态装载DLL，并
调用其中的过程。

---- 例如：

Type TMyProc=Procedure (Param:Pchar ) ;Stdcall;
Var MyProc: TMyproc;
MyHandle:THandle;
MyHandle:=LoadLibrary (‘Mydll’) ;
If MyHandle< =0 then
Raise Exception.Create
( ‘动态链接库调用失败，错误代码
是：’+Inttostr(Getlasterror))
else
@MyProc:=GetProcAddress(MyHandle,’demoproc’);
if not Assigned(MyProc) then
Raise Exception.Create('GetProcAddress
调用失败，错误代码
是：’+inttostr(getlasterror))
else MyProc(Pchar(‘a string’));
Freelibrary(Myhandle); // 卸载DLL
---- 二、 调用方式

---- 1、通过过程、函数名；

---- 2、通过过程、函数别名；

---- 3、通过过程、函数的顺序号

---- 例：Function Getstring : string ; stdcall ; external ‘Mydlls.dll’ name ‘Mygetstr’name 子句指定函数名Getstring 改为Mygetstr，当程序调用这个例程时，使用Mygetstr这
个名字；Function Getstring : string ; stdcall ; external ‘Mydlls.dll’ index 5 Index 子句
通过索引号引入例程可以减少DLL的加载时间。

---- 三、 调用约定

---- 调用约定，是指调用例程时参数的传递顺序。DELPHI中DLL支持的调用约定有：

调用约定 参数传递顺序
Register 从左到右
Pascal 从左到右
Stdcall 从右到左
Cdecl 从右到左
Safecall 从右到左
---- 使用Stdcall 方式，能保证不同语言写的DLL的兼容性，同时它也是WINDOWS API的约定方式；Delphi 3。0、4。0的默认调用方式为Register ；Cdecl是采用 C/C++的调用约定，适用于DLL是由C++语言
编写的；Safecall 是适合于声明OLE对象中的方法。

---- 四、 DLL中的变量和段

---- 一个DLL声明的任何变量都为自己私有，调用它的模块不能直接使用它定义的变量。要使用时必须通过
过程或函数界面才能完成，对DLL来说，它永远都没有机会使用调用它的模块中的声明的变量。一个DLL没有
自己的SS（堆栈段），它使用调用它的应用程序的堆栈。因此在DLL中的过程、函数不要假定DS=SS（DS为数
据段）。


New Page 4

:::如何在运行时改变应用程序图标:::

例如你想在忙时显示一个图标，不忙时显示另外一个图标，如下：
if (Working) then
Application.Icon.LoadfromFile(StartupDirectory + 'Busy.ico')
else
Application.Icon.LoadfromFile(StartupDirectory + 'Lazy.ico');


New Page 1

::: 如何在状态条显示按钮菜单等的提示信息，同时不会覆盖正常信息:::

很多程序都有状态条。当鼠标在菜单项，或按钮上移动时会把这些菜单项或按钮的提示信息显示在上面。当鼠标在空白区时，状态条上又会显示原有的输出。即提示信息与正常输出不冲突。下面即是实现方法：

在form1的private下加入ShowHint函数说明
procedure ShowHint(Sender: TObject);

procedure TForm1.FormCreate(Sender: TObject);
begin
//...
Application.OnHint := ShowHint;
//...
end;

procedure TForm1.ShowHint(Sender: TObject);
begin
if Length(Application.Hint) > 0 then
begin
StatusBar1.SimplePanel := True;
StatusBar1.SimpleText := Application.Hint;
end
else StatusBar1.SimplePanel := False;
end;


New Page 5

:::实现打开文件:::

打开Windows已经注册的文件其实很简单，根据以下代码定义一个过程：
procedure URLink(URL:PChar);
begin
ShellExecute(0, nil, URL, nil, nil, SW_NORMAL);
end;
在要调用的地方使用
URLink('Readme.txt');
如果是链接主页的话，那么改用
URLink('http://gui.yeah.net');


显示密码编辑框中的密码

    我们在使用Windows时，经常会碰到一些密码编辑框，输入其中的文字都以“＊”显示。现在，有许多共享软件和自由软件都可以实现隐藏密码的正确显示。究竟这是怎样实现的呢！其实，这比较简单，虽然这些信息都以“＊”显示，但其内部还是以当初的字符表示，所以，我们只要用Windows API函数就可以实现。
    在Windows中，每一个窗口、控件都有它的名字（叫做Name或Window Text）。对于Form、Dialog Box、Message Box来说，名字就显示在Title Bar中；对于Edit、Button、Static Control，名字显示在他所占的区域中。密码编辑框本身就是个Edit控件，虽然显示的是特殊字符，但名字属性没有变，还是输入时的字符。Windows提供了两个API函数来获得这个名字：
    int GetWindowTextLength(HWND hWnd); ／／ 得到名字的长度
     其中，hWnd ：想要得到的那个窗口或控件的句柄 handle
    int GetWindowText(HWND hWnd, LPTSTR lpString, int nMaxCount );／／ 得到名字
    其中，hWnd ：想要得到的那个窗口或控件的句柄 handle；
    lpString：存放名字的字符串的地址
    nMaxCount ：可拷贝的最大字符数
    下面以Delphi为例，说明它的实现过程。
    新建一Form，放置Label、Edit、Button各一个到Form中，将Edit1的PasswordChar属性改为“＊”，双击Button1：
    procedure TForm1.Button1Click(Sender: TObject);
    var
    Name:PChar; ／／ 名字
    L:integer; ／／ 名字的长度
    begin
    L:=GetWindowTextLength(Edit1.handle)＋1; ／／ 得到名字长度，并将长度加1
    GetMem(Name,L);／／为将要得到的名字分配内存
    GetWindowText(Edit1.handle,Name,L);／／得到名字
    label1.Caption:=String(Name); ／／ 将得到的名字显示于 Label1
    FreeMem(Name,0); ／／ 释放分配的内存
    end;
    经过运行，在Edit1中输入的密码就可通过Label1显示出来。
（大师）


New Page 4

:::小写金额转换:::

如下为一个简单的小写金额转换为大写的函数，其思路简单（可以说烂吧，居然利用了位置来转换），但是它几乎可以无限制的转换，只要你能读得出来和写得进去：
function Tform1.SmallTOBig(small:real):string;
var SmallMonth,BigMonth:string;
wei1,qianwei1:string[2];
wei,qianwei,dianweizhi,qian:integer;
begin
{------- 修改参数令值更精确 -------}
{小数点后的位置，需要的话也可以改动-2值}
qianwei:=-2;
{转换成货币形式，需要的话小数点后加多几个零}
Smallmonth:=formatfloat('0.00',small);
{---------------------------------}
dianweizhi :=pos('.',Smallmonth);{小数点的位置}
{循环小写货币的每一位，从小写的右边位置到左边}
for qian:=length(Smallmonth) downto 1 do
begin
{如果读到的不是小数点就继续}
if qian<>dianweizhi then
begin
{位置上的数转换成大写}
case strtoint(copy(Smallmonth,qian,1)) of
1:wei1:='壹'; 2:wei1:='贰';
3:wei1:='叁'; 4:wei1:='肆';
5:wei1:='伍'; 6:wei1:='陆';
7:wei1:='柒'; 8:wei1:='捌';
9:wei1:='玖'; 0:wei1:='零';
end;
{判断大写位置，可以继续增大到real类型的最大值}
case qianwei of
-3:qianwei1:='厘';
-2:qianwei1:='分';
-1:qianwei1:='角';
0 :qianwei1:='元';
1 :qianwei1:='拾';
2 :qianwei1:='佰';
3 :qianwei1:='千';
4 :qianwei1:='万';
5 :qianwei1:='拾';
6 :qianwei1:='佰';
7 :qianwei1:='千';
8 :qianwei1:='亿';
9 :qianwei1:='十';
10:qianwei1:='佰';
11:qianwei1:='千';
end;
inc(qianwei);
BigMonth :=wei1+qianwei1+BigMonth;{组合成大写金额}
end;
end;
SmallTOBig:=BigMonth;
end;
调用如下“edit1.text:=SmallTOBig(1234567890.1234);”他自动默认小数点后两位


New Page 1

:::如何将一个流的内容写入到剪贴板中，并处理:::

这个技巧是参考Delphi的剪贴板类的实现来完成的。将一个流的内容放入剪贴板，
首先要注册你自已的格式，使用RegisterClipboardFormat()函数
然后做下面三步：
1.创建一个内容流，并将内容写进去
2.创建一个全局的内容区，并将流的内容写入
3.调用ClipBoard.SetAsHandle()将内容写入剪贴板

将内容写入剪贴板中
var
hbuf : THandle;
bufptr : Pointer;
mstream : TMemoryStream;
begin
mstream := TMemoryStream.Create;
try
{-- 处理流的代码 --}
hbuf := GlobalAlloc(GMEM_MOVEABLE, mstream.size);
try
bufptr := GlobalLock(hbuf);
try
Move(mstream.Memory^, bufptr^, mstream.size);
Clipboard.SetAsHandle(CF_MYFORMAT, hbuf);
finally
GlobalUnlock(hbuf);
end;
except
GlobalFree(hbuf);
raise;
end;
finally
mstream.Free;
end;
end;
请注意不要将分配的全局缓冲区释放，这个工作由剪贴板来完成，在读出数据中
你应该将它复制后处理。

将剪贴板内容读出来
var
hbuf : THandle;
bufptr : Pointer;
mstream : TMemoryStream;
begin
hbuf := Clipboard.GetAsHandle(CF_MYFORMAT);
if hbuf <> 0 then begin
bufptr := GlobalLock(hbuf);
if bufptr <> nil then begin
try
mstream := TMemoryStream.Create;
try
mstream.WriteBuffer(bufptr^, GlobalSize(hbuf));
mstream.Position := 0;
{-- 处理流的代码 --}
finally
mstream.Free;
end;
finally
GlobalUnlock(hbuf);
end;
end;
end;
end;

串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示如何将颜色值转换成字符串表示

如何将颜色值转换成字符串表示


New Page 2

:::隐藏和显示Windows的任务条:::

procedure hideTaskbar; //隐藏

var

wndHandle : THandle;

wndClass : array[0..50] of Char;

begin

StrPCopy(@wndClass[0], 'Shell_TrayWnd');

wndHandle := FindWindow(@wndClass[0], nil);

ShowWindow(wndHandle, SW_HIDE);

End;

procedure showTaskbar;

var

wndHandle : THandle;

wndClass : array[0..50] of Char;

begin

StrPCopy(@wndClass[0], 'Shell_TrayWnd');

wndHandle := FindWindow(@wndClass[0], nil);

ShowWindow(wndHandle, SW_RESTORE);

end;


New Page 2

:::在Delphi中用拼音首字符序列来实现检索功能:::

在日常工作和生活中我们经常使用电子记事本查找个人通讯录信息，或在单位的应用程序中查询客户档案或业务资料，这个过程中往往需要输入大量的汉字信息，对于熟悉计算机的人这已经是一件头疼的事，那些不太熟悉计算机或根本不懂汉字输入的用户简直就望而生畏。作为对数据检索技术的一种新的尝试，作者探索使用汉字拼音的首字符序列作为检索关键字，这样，用户不必使用汉字，只须简单地键入要查询信息的每个汉字的拼音首字符即可。比如你想查找关键字“中国人民银行”，你只需要输入“zgrmyh”。作者希望通过下面的例子，为广大计算机同行起一个抛砖引玉的作用，让我们开发的程序更加便捷、好用。

---- 原理很简单，找出汉字表中拼音首字符分别为“A”至“Z”的汉字内码范围，这样，对于要检索的汉字只需要检查它的内码位于哪一个首字符的范围内，就可以判断出它的拼音首字符。

---- 程序更简单，包括3个控件：一个列表存放着所有待检索的信息；一个列表用于存放检索后的信息；一个编辑框用于输入检索关键字（即拼音首字符序列）。详细如下：

---- 1．进入Delphi创建一个新工程：Project1

---- 2．在Form1上创建以下控件并填写属性：

控件类型 属性名称 属性值
Edit Name Search
ListBox Name SourceList
Items 输入一些字符串，如姓名等，用于提供检索数据
ListBox Name ResultList

---- 3．键入以下两个函数

// 获取指定汉字的拼音索引字母，如：“汉”的索引字母是“H”
function GetPYIndexChar( hzchar:string):char;
begin
case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
$B0A1..$B0C4 : result := 'A';
$B0C5..$B2C0 : result := 'B';
$B2C1..$B4ED : result := 'C';
$B4EE..$B6E9 : result := 'D';
$B6EA..$B7A1 : result := 'E';
$B7A2..$B8C0 : result := 'F';
$B8C1..$B9FD : result := 'G';
$B9FE..$BBF6 : result := 'H';
$BBF7..$BFA5 : result := 'J';
$BFA6..$C0AB : result := 'K';
$C0AC..$C2E7 : result := 'L';
$C2E8..$C4C2 : result := 'M';
$C4C3..$C5B5 : result := 'N';
$C5B6..$C5BD : result := 'O';
$C5BE..$C6D9 : result := 'P';
$C6DA..$C8BA : result := 'Q';
$C8BB..$C8F5 : result := 'R';
$C8F6..$CBF9 : result := 'S';
$CBFA..$CDD9 : result := 'T';
$CDDA..$CEF3 : result := 'W';
$CEF4..$D188 : result := 'X';
$D1B9..$D4D0 : result := 'Y';
$D4D1..$D7F9 : result := 'Z';
else
result := char(0);
end;
end;

// 在指定的字符串列表SourceStrs中检索符合拼音索引字符串
PYIndexStr的所有字符串，并返回。
function SearchByPYIndexStr( SourceStrs:TStrings; PYIndexStr:string):string;label NotFound;
var
i, j :integer;
hzchar :string;
begin
for i:=0 to SourceStrs.Count-1 do
begin
for j:=1 to Length(PYIndexStr) do
begin
hzchar:=SourceStrs[i][2*j-1]+ SourceStrs[i][2*j];
if (PYIndexStr[j]<>'?') and (UpperCase(PYIndexStr[j]) <> GetPYIndexChar(hzchar)) then goto NotFound;
end;
if result='' then result := SourceStrs[i] else result := result + Char(13) + SourceStrs[i];
NotFound:
end;
end;

4．增加编辑框Search的OnChange事件：
procedure TForm1.SearchChange(Sender: TObject);
var ResultStr:string;
begin
ResultStr:='';
ResultList.Items.Text := SearchByPYIndexStr(Sourcelist.Items, Search.Text);
end;

---- 5．编译运行后，在编辑框Search中输入要查询字符串的拼音首字符序列，检索结果列表ResultList就会列出检索到的信息，检索中还支持“？”通配符，对于难以确定的的文字使用“？”替代位置，可以实现更复杂的检索。


New Page 1

:::辨别分辨率:::

要得到显示器的分辨率，由下列程序得到：
var
x:longint;
a:string;
begin
x := GetSystemMetrics(SM_CXSCREEN);
Str(x,a);
Label1.Caption := '显示器水平分辨率' + a;
x := GetSystemMetrics(SM_CYSCREEN);
Str(x,a);
Label2.Caption := '显示器垂直分辨率' + a;
end;


New Page 2

:::程序启动画面:::
在启动程序之前出现启动画面的方法多得是，但有些是调用“记时器”来延时的，这种方法有时拖慢了程序的启动速度，下面介绍又一方法，给大家参考对比一下。
    建一个启动封面窗体，假设为Form2，先设置好BorderIcons、BorderStyle、FormStyle、Position，接着在窗体上加入图片框、文本框，设置好后在菜单里选Project里的Options，把Form2从Auto-create forms里转到Available forms。再接着就是按Ctrl+F12键，选Project1，出现工程单元，其内容如下
...
Application.CreateForm(TForm1, Form1);
Application.Run;
..
    在Application.CreateForm(TForm1, Form1); 前加入如下语句：
form2:=tform2.create(application);
form2.Show;
form2.Update;
    然后在Application.Run;前面加入如下语句：
form2.hide;
form2.free;


New Page 3

:::动态修改显示器分辨率:::

Windows提供给我们两个API函数，可以动态调整显示器的分辨率，他们是EnumDisplaySettings() 和ChangeDisplaySettings()，下面这个例子就是了

function DynamicResolution(X, Y: word): BOOL;
var
lpDevMode: TDeviceMode;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH Or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := X;
lpDevMode.dmPelsHeight := Y;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if DynamicResolution(640, 480) then
ShowMessage('Now is 640*480');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if DynamicResolution(800, 600) then
ShowMessage('Now is 800*600');
end;


New Page 3

:::分行提示:::
无论你什么时候要分行显示的时候，只需要在字符串中间加入“#13”就可以了，但在属性框里却不能这么干，以下就几种控件加以说明：
begin
Label1.caption :='垂'+#13+'直'+#13+'显'+#13+'示';
Edit1.Hint :='输入框说明：'+#13+'文本的输入';
end;


New Page 4

:::关闭外部应用程序:::
如何在 Delphi 应用程序中, 去关闭外部已开启的应用程序？
下面给出一段在 Delphi 中关闭“计算器”程序为例：
var
HWndCalculator : HWnd;
begin
// find the exist calculator window
HWndCalculator := Winprocs.FindWindow(nil, '计算器'); // close the exist Calculator
if HWndCalculator <> 0 then
SendMessage(HWndCalculator, WM_CLOSE, 0, 0);
end;


New Page 5

:::控制面板大全:::

在程序运行过程中启动控制面板的各个设置功能：
var x:cardinal;
begin
{启动控制面板}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL',9);
{辅助选项 属性-键盘}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1',9);
{辅助选项 属性-声音}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2',9);
{辅助选项 属性-显示}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,3',9);
{辅助选项 属性-鼠标}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,4',9);
{辅助选项 属性-常规}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL access.cpl,,5',9);
{添加/删除程序 属性-安装/卸载}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Appwiz.cpl,,1',9);
{添加/删除程序 属性-Windows安装程序}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Appwiz.cpl,,2',9);
{添加/删除程序 属性-启动盘}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Appwiz.cpl,,3',9);
{显示 属性-背景}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0',9);
{显示 属性-屏幕保护程序}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1',9);
{显示 属性-外观}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2',9);
{显示 属性-设置}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3',9);
{Internet 属性-常规}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,0',9);
{Internet 属性-安全}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,1',9);
{Internet 属性-内容}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,2',9);
{Internet 属性-连接}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,3',9);
{Internet 属性-程序}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,4',9);
{Internet 属性-高级}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl,,5',9);
{区域设置 属性-区域设置}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,0',9);
{区域设置 属性-数字}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,1',9);
{区域设置 属性-货币}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,2',9);
{区域设置 属性-时间}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,3',9);
{区域设置 属性-日期}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Intl.cpl,,4',9);
{游戏控制器-一般}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Joy.cpl,,0',9);
{游戏控制器-高级}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Joy.cpl,,1',9);
{鼠标 属性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Main.cpl',9);
{多媒体 属性-音频}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,0',9);
{多媒体 属性-视频}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,1',9);
{多媒体 属性-MIDI}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,2',9);
{多媒体 属性-CD音乐}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,3',9);
{多媒体 属性-设备}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,4',9);
{调制解调器 属性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Modem.cpl',9);
{网络}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Netcpl.cpl',9);
{密码 属性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Password.cpl',9);
{扫描仪与数字相机 属性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sticpl.cpl',9);
{系统 属性-常规}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sysdm.cpl,,0',9);
{系统 属性-设备管理器}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sysdm.cpl,,1',9);
{系统 属性-硬件配置文件}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sysdm.cpl,,2',9);
{系统 属性-性能}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Sysdm.cpl,,3',9);
{日期/时间 属性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL timedate.cpl',9);
{电源管理 属性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Powercfg.cpl',9);
{拨号属性}
x:=winexec('rundll32.exe shell32.dll,Control_RunDLL Telephon.cpl',9);
{----------------------调用错误----------------------}
if x=0 then messagebox(0,'程序超出内存','错误',0);
if x=ERROR_BAD_FORMAT then messagebox(0,'该程序非一个合法的Win32.EXE程序).','错误',0);
if x=ERROR_FILE_NOT_FOUND then messagebox(0,'指定文件没找到','错误',0);
if x=ERROR_PATH_NOT_FOUND then messagebox(0,'指定路径没找到','错误',0);
end;


New Page 4

:::如何调用一个DLL:::

procedure TForm1.Button1Click(Sender: TObject);
type
TQTSetAppHandle = procedure(Value: THandle); stdcall;
TQTExecute = procedure; stdcall;
var
LibHandle: THandle;
QTSetAppHandle: TQTSetAppHandle;
QTExecute: TQTExecute;
begin
LibHandle := LoadLibrary('lockscr');
if LibHandle <> 0 then
begin

@QTSetAppHandle := GetProcAddress(LibHandle, 'QTSetAppHandle');
if @QTSetAppHandle <> nil then QTSetAppHandle(Application.Handle);

@QTExecute := GetProcAddress(LibHandle , 'QTExecute');
if @QTExecute <> nil then
begin
Application.Minimize;
Application.ProcessMessages;
QTExecute;
end;
FreeLibrary(LibHandle);
end;
end;


New Page 3

:::如何动态更新DBGrid的颜色？:::

DBGrid控件是一个有许多用户接口的显示数据库的控件，以下的程序告诉您如何根据显示的内容改变字体的显示颜色。例如，如果一个城市的人口大于200万，我们就让它显示为蓝色。使用的控件事件为DBGrid.OnDrawColumeCell.

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect:TRect;DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

if Table1.FieldByName('Population').AsInteger > 20000000 then

DBGrid1.Canvas.Font.Color := clBlue;

DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

上面的例子是简单的，但是你可以根据自己的需要扩充，例如字体也变化等，甚至你可以调用画圆的函数在数字上画上一个红色的圆圈。


New Page 3

:::如何防止一个程序执行两次:::

这是一个比较简单的防止程序执行两次的方法
implementation
var hnd: THandle;

initialization
hnd := CreateMutex(nil, True, 'irgendwaseinmaliges');
if GetLastError = ERROR_ALREADY_EXISTS then Halt;

finalization
if hnd <> 0 then CloseHandle(hnd);
end.


New Page 4

:::如何计算一个目录的大小:::

function GetDirectorySize(const ADirectory: string): Integer;
var
Dir: TSearchRec;
Ret: integer;
Path: string;
begin
Result := 0;
Path := ExtractFilePath(ADirectory);
Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);

if Ret <> NO_ERROR then
exit;

try
while ret=NO_ERROR do
begin
inc(Result, Dir.Size);
if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then
Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*'));
Ret := Sysutils.FindNext(Dir);
end;
finally
Sysutils.FindClose(Dir);
end;
end;


New Page 2

:::如何将颜色值转换成字符串表示:::

在Graphics单元中有两个有用的函数：
function StringToColor(const s:string):TColor; 用于将字符串转换成
TColor值，如将'clBtnFace'转换成 $02FF8800
function ColorToString(Color: TColor): string; 用于将颜色值转换成
字符串值


New Page 1

:::如何清空回收站:::

Procedure EmptyRecycleBin ;
Const
SHERB_NOCONFIRMATION = $00000001 ;
SHERB_NOPROGRESSUI = $00000002 ;
SHERB_NOSOUND = $00000004 ;

Type
TSHEmptyRecycleBin = function (Wnd : HWND ;
LPCTSTR : PChar ;
DWORD : Word ) : Integer ; stdcall ;
Var
SHEmptyRecycleBin : TSHEmptyRecycleBin ;
LibHandle : THandle ;

Begin
LibHandle := LoadLibrary(PChar('Shell32.dll')) ;
If LibHandle <> 0 then
@SHEmptyRecycleBin := GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')
Else
Begin
MessageDlg('Failed to load Shell32.dll.', mtError, [mbOK], 0);
Exit ;
End ;

If @SHEmptyRecycleBin <> nil then
SHEmptyRecycleBin(Application.Handle ,
'' ,
SHERB_NOCONFIRMATION or
SHERB_NOPROGRESSUI or
SHERB_NOSOUND ) ;
FreeLibrary(LibHandle);
@SHEmptyRecycleBin := nil ;
End ;