这几天清理资料，把以前学Delphi时的笔记翻出来了。大概是2005年时的吧,有些资料都没有什么价值了。以后再整理吧。
Delphi Note
1、触发器的使用。
源数据库：
名称：info
字段：idd、namee、age、sex、city、department、position
目标数据库：
名称：leave
字段：idd、namee、type
1、 修改操作。（原代码）
CREATE TRIGGER test_upd on info
FOR UPDATE
AS
if update(namee)
update leave
set leave.namee=i.namee
from inserted i
where leave.idd=i.idd
2、 删除操作。（原代码）
CREATE TRIGGER test_del on [info]
FOR DELETE
AS
declare @id char(10)
select @id= idd from deleted
delete from leave where idd=@id
3、 插入操作。（原代码）
CREATE TRIGGER test_INS ON info
FOR INSERT
AS
insert into leave
(idd,namee)
SELECT i.idd,i.namee FROM inserted i
2、ADO的认识
Microsoft的数据存取技术演变：
1、 ODBC仅支持关系数据库，以及传统的数据库类型，无法符合日渐复杂的数据存取应用，也无法让脚本语言使用，。
2、 DAO。Microsoft为能让程序员存取Access数据库，产生了DAO（Data Access Object），能够存取Xbase的数据库及Excel文件，并且结ODBC存取关系数据库。但去目的是存取Access数据库，因此只对Access数据库非常有效率，先已处于维护状态。
3、 RDO。由于DAO在结合ODBC存取关系数据库时表现的不好，所以Microsoft推出了RDO，不过目前也逐渐被放弃了。
4、 OLE－DB是很底层化的，使用复杂的，可以存取传统的关系数据库、Excel文件、Email或Internet/Intranet上的电子签名信息。
5、 ADO成功的封装了OLE-DB的大部分功能，可以让应用程序或WEB应用程序存取各种不通的数据源。大大简化了数据存取工作。
3、Tdatabase、TUpdateSql组件的作用。
Tdatabase是BDE与Query和Table连接的中间通道。这样程序修改时，只要修改Datebase的属性就可以了。通过其Database的属性设定公用的别名。
TupdateSql是用来进行网络数据库数据的修改。Query1.Applyupdates;Query1.CommitUpdates;另外，被修改的Server端数据库表要有key。
4、开发Activex控件。
<一>转换ActiveX控件
第一步 选择菜单File的New项，出现项目对话框，选择Activex页，选择ActiveX Control。
第二步 在出现的向导对话框(ActiveX Control Wizard)中，从控件列表中选择转换的控件。
第三步 注册ActiveX。选择菜单Run—Register ActiveX Server。即生成一个OCX文件，存储于当前路径。
第四步 Web配置选项。选择菜单Project—Web deployment—Option。设定路径。
第五步 生成HTML文档。选择菜单Project—Web Deploy。然后，在HTML dir所指示的目录下，外面可以看到HTML文件已经生成。
<二>开发新的ActiveX控件
第一步 建立一个ActiveX Form。选择菜单File—New，出现项目对话框，选择Activex页，选择ActiveForm。
第二步 在ActiveForm Wizard对话框中输入各种名称。
第三步 在ActiveX Wizard上，加入控件，譬如加入一个Button、一个Image组件，在button的OnClick事件中，有如下的处理：
Image1.Canvas.Ellipse(0,0,Image1.Width,Image1.Height);
第四步 编译。按Ctrl+F9组合健，或选择Projiect—CompileFormProj1。
第五步 注册ActiveX，生成OCX文件，选择菜单Run—Register ActiveX Server。
第六步 Web配置选项。选择菜单Project—Web Deploy。
第七步 生成HTML文档。选择菜单Project—Web Deploy。
5、恢复SQL的.mdf及.log文件。
EXEC sp_attach_db @dbname = N'AAA', //AAA为要建立的数据库名
@filename1 = N'c:\ooo\aaa.mdf',
@filename2 = N'c:\ooo\aaa_log.ldf'
6、bmp及jpg的转换和数据库中bmp、jpg格式图形的存储。
Demo1：
var blobstream:tblobstream;
filestream:tfilestream;
begin
table1.insert;
blobstream:=table1.createblobstream(table1.fieldbyname('picture'),bmreadwrite);
filestream:=tfilestream.create('d:\picture.jpg',fmread);
blobstream.copyfrom(filestream,filestream.size);
table1.post;
要是想保存
var blobstream:tblobstream;
filestream:tfilestream;
begin
blobstream:=table1.createblobstream(table1.fieldbyname('picture'),bmread);
filestream:=tfilestream.create('d:\picture.jpg',fmcreate or fmwrite);
filestream.copyfrom(filestream,filestream.size);
就可以了,加分吧
demo2：
var
bs: TBlobStream;
begin
bs:=Table1.FieldByName('c1').CreateBlobStream(
Table1.FieldByName('c1'), bmWrite);
Graphic.SaveToStream(bs);
end;
7、控制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;
8、将EXCEL表中的数据导入到库中
程序中实现的办法：
如何将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文档的列数
9、取得字段的属性
找了一些以前写过的代码 :
var fType :TfieldType;
strType :String;
Adotable1.Fields[0].DataSize 得到 宽度 !
fType :=AdoTable1.Fields[0].Dataset 用于得到field的类型，这个结果不是string，你要自己去转换:
Case fType of
ftWideString : strType:='Text';
ftDate: strType :='Date';
ftString :strType :='Text';
ftBoolean:strType :='Boolean';
ftMemo :strType :='memo';
ftSmallint :strType:='Integer' ;
ftUnknown :strType:='Unknown';
end;
另外还有一种 :
var
i:Integer;
FieldType:String;
case varastype(ADOTable1.Fields[i].DataType,varInteger) of
24: FieldType:='字符型';
16: FieldType:='备注型';
3 : FieldType:='数值型';
11: FieldType:='日期时间型';
8 : FieldType:='货币型';
14: FieldType:='自动编号型';
5 : FieldType:='逻辑型';
15: FieldType:='OLE对象型';
end;
10、在query中检索记录
if query1.Locate('ID','A001',[loCaseInsensitive])then begin
showmessage('有重复记录。');
注意：lacate执行后会将Query的属性置回到readonly状态。
所以query1.Edit要放在locate后。
11、把程序加进windows的“启动”中
procedure TFrmAbout.WriteRegAutoRun(FileName:string);
var
Regf:TRegistry;
begin
Regf:=TRegistry.Create;
Regf.RootKey:=HKEY_LOCAL_MACHINE;
if Length(FileName)>0 then
try
RegF.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false);
RegF.WriteString('YourProgram',FileName);
except
end;
RegF.CloseKey;
RegF.Free;
end;
十二、控制Word
启动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的内容.
如何输出到Word
如果用的是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;
sql server中用image或是text字段都行，可以保存任何文件类型，读出时还可以改名
procedure TForm1.Button1Click(Sender: TObject);//保存文件
var str:Tmemorystream;
begin
str:=Tmemorystream.Create;
str.LoadFromFile('f:\page.doc');
str.Position:=0;
adoquery1.Append;
Tblobfield(adoquery1.FieldByName('tt')).loadfromstream(str);
try
adoquery1.Post;
finally
str.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);//读取文件
var str:Tmemorystream;
begin
str:=Tmemorystream.Create;
str.Position:=0;
Tblobfield(adoquery1.FieldByName('tt')).savetostream(str);
str.SaveToFile('F:\page.doc');
str.Free;
end;
将WORD中制定字符替换成数据库中数据时报错 ( 积分：50, 回复：
to lq123:
while not Query1.eof do
begin
i:=i+1;
FindText1 := '<Name'+inttostr(i)+'>';
FindText2 := '<pm'+inttostr(i)+'>';
FindText3 := '<fcon'+inttostr(i)+'>';
FindText4 := '<pcon'+inttostr(i)+'>';
FindText5 := '<rem'+inttostr(i)+'>';
ReplaceWith1 := Query1.fieldbyname('project_name').asstring;
ReplaceWith2 := Query1.fieldbyname('name').asstring;
ReplaceWith3 := Query1.fieldbyname('fcontent').asstring;
ReplaceWith5 := Query1.fieldbyname('remark').asstring;
Query2.Close ;
Query2.ParamByName ('MProject_id2').asstring:=Query1.fieldbyname('project_id2').asstring;
Query2.ParamByName ('M_date').asstring:=FormatDateTime('yyyy"/"mm"/"dd',DateTimePicker2.date);
Query2.Open ;
ReplaceWith4 := Query2.fieldbyname('pcontent').asstring;
Qstaff.Close ;
Qstaff.ParamByName ('MProject_id2').asstring:=Query1.fieldbyname('project_id2').asstring;
Qstaff.ParamByName ('M_serial').asstring:=Query1.fieldbyname('serial').asstring;
Qstaff.Open ;
j:=0;
if Qstaff.RecordCount <>0 then
while not Qstaff.Eof do
begin
j:=j+1;
find1:='<n'+inttostr(i)+inttostr(j)+'>';
find2:='<t'+inttostr(i)+inttostr(j)+'>';
rep1:=Qstaff.fieldbyname('name').asstring;
rep2:=Qstaff.fieldbyname('opinion').asstring;
WordDocument1.Range.Find.Execute( Find1, MatchCase, MatchWholeWord,
MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
Wrap, Format, Rep1, Replace );
WordDocument1.Range.Find.Execute( Find2, MatchCase, MatchWholeWord,
MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
Wrap, Format, Rep2, Replace );
Qstaff.Next ;
end;
WordDocument1.Range.Find.Execute( FindText1, MatchCase, MatchWholeWord,
MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
Wrap, Format, ReplaceWith1, Replace );
WordDocument1.Range.Find.Execute( FindText2, MatchCase, MatchWholeWord,
MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
Wrap, Format, ReplaceWith2, Replace );
WordDocument1.Range.Find.Execute( FindText3, MatchCase, MatchWholeWord,
MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
Wrap, Format, ReplaceWith3, Replace );
WordDocument1.Range.Find.Execute( FindText4, MatchCase, MatchWholeWord,
MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
Wrap, Format, ReplaceWith4, Replace );
WordDocument1.Range.Find.Execute( FindText5, MatchCase, MatchWholeWord,
MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
Wrap, Format, ReplaceWith5, Replace );
Query1.Next ;
end;
Fsumdoc_imp.Close ;
label2.Caption :='';
end;
以下为例：
1、在WORD中插入书签名为“MM”；
2、在程序中定义 bookmark1:OLEVariant;
在FORM上添加WORDAPPLICATION，WORDDOCUMENT
指定打开WORD文档；假设一个MEMO字段名为“MM1”，
var tmpstring:String;
...
tmpstring:=table1.fieldbyname('MM1').AsString;
BookMark1:='addr';
try
WordApp.ActiveDocument.Bookmarks.Item(BookMark1).Range.InsertAfter(tmpstring);
except
end;
VB中使用方法如下：下例在活动文档中查找所有“hi”并将其替换为“hello”。
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:="hi", ReplaceWith:="hello", Replace:=wdReplaceAll
delphi5.0中find.execute的定义和参数说明如下：
function Execute(var FindText: OleVariant; var MatchCase: OleVariant;
var MatchWholeWord: OleVariant; var MatchWildcards: OleVariant;
var MatchSoundsLike: OleVariant; var MatchAllWordForms: OleVariant;
var Forward: OleVariant; var Wrap: OleVariant; var Format: OleVariant;
var ReplaceWith: OleVariant; var Replace: OleVariant): WordBool; safecall;
FindText 1、要搜索的文字。用空字符串（“”），将只搜索格式。
指定相应的字符代码，可以搜索特殊的字符。例如，
“ ^p”相对于一个段落标记，而“ ^t”相对于制表符。
有关可用的特殊字符的列表，请参阅可进行查找和替换
操作的特殊字符与文档元素示例。
2、如果 MatchWildcards 为 True，则可以包含通配符，
以及其他高级搜索条件。例如，“ *(ing) ” 将查
找以“ing”结尾的所有单词。详细内容，请参阅通配符搜索示例。
3、要搜索符号字符，可键入一个“ ^ ”符号，一个零（0），然后是
符号字符的代码。例如，在 Windows 中，“ ^0151”对应于一个长
破折号
MatchCase 如果查找区分大小写，则本参数为 True。相应于“编辑”菜单
“查找并替换”对话框中的“区分大小写”复选框。
MatchWholeWord 如果只查找整个单词而不是单词的一部分，则本参数为 True。相
应于“编辑”菜单“查找并替换”对话框中的“全字匹配”复选框。
MatchWildcards 如果查找文字包含特殊的搜索操作符，则本参数为 True。相应于
“编辑”菜单“查找并替换”对话框中的“使用通配符”复选框。
MatchSoundsLike 如果查找包括与查找文字发音相近的单词，则本参数为 True。
相应于“编辑”菜单“查找并替换”对话框中的“同音”复选框。
MatchAllWordForms 如果查找文字的所有形式（例如，“ sit” 将包含“sitting”
和“sat”），则本参数为 True。相应于“编辑”菜单“查找并
替换”对话框中的“查找单词的各种形式”复选框。
Forward 如果向下（向文档尾部）搜索，则本参数为 True。
Wrap 如果从不是文档开头的地方开始搜索，并且达到文档尾部时
（如 Forward 设置为 False，则相反），本参数控制接下来的操作。
当在所选内容或范围中没有找到搜索文字时，本参数也控制接下来
的操作。可以是下列 WdFindWrap 常量之一：
常量 说明
wdFindAsk 在搜索完所选内容或者范围之后，Word 显示一条消息，询问是否搜
索文档的其他部分。
wdFindContinue 在到达搜索范围的开始或者结尾时，继续进行查找操作。
wdFindStop 在到达搜索范围的开始或者结尾时，停止进行查找操作。
Format 如果本参数为 True，则查找带格式的文本或者只查找格式
而不查找文本。
ReplaceWith 替换文字。要删除由 Find 参数指定的文字，可使用空字符串
（“”）。与 Find 参数相似，本参数也可以指定特殊的字符和
高级搜索条件。要指定一个图形对象或者其他非文本项作为替换
内容，可将这些项放到剪贴板上，然后将 ReplaceWith 指定为“ ^c”。
Replace 指定执行替换的次数：一次、所有或者不替换。可以是下列
WdReplace 常量之一：wdReplaceAll、wdReplaceNone 或 wdReplaceOne。
用OLE把dbgrid内容输出到excel
简单，方法如下：
procedure CopyDbDataToExcel(Target:TDbgid);
var
iCount,jCount:Integer;
XLApp:Variant;
Sheet: Variant;
Target:TDBGrid;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//通过ole创建Excel对象
Try
XLApp := CreateOleObject('Excel.Application');
Except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add[XLWBatWorksheet];
XLApp.WorkBooks[1].WorkSheets[1].Name := '测试工作薄';
Sheet := XLApp.Workbooks[1].WorkSheets['测试工作薄'] ;
if Not Target.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Target.DataSource.DataSet.first;
for iCount := 0 to Target.Columns.Count -1 do
begin
Sheet.cells[1 ,iCount+1] := Target.Columns.Items[iCount].Title.Caption;
end;
jCount:=1;
While Not Target.DataSource.DataSet.Eof do
begin
for iCount := 0 to Target.Columns.Count -1 do
begin
Sheet.cells[jCount+1 ,iCount+1] := Target.Columns.Items[iCount].Field.AsString;
end;
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
word:=createoleobject('word.application');
word.visible:=true;
word.documents.open('e:\abc.doc',false);
word.activedocument.range(0,0);
word.activedocument.tables.add(word.activedocument.range,2,3);
word.activedocument.sellection.insertrowsbelow(1);
十三、抓屏幕图像，保存为内存流
全局变量
memoryStream:TMemoryStream;
memoryStream:=TMemoryStream.create;
}
var
image:Timage;
jpgstream:TJPEGImage;
ss:tcanvas;
begin
ss:=tcanvas.Create;
ss.Handle:=getdc(0);
image:=timage.Create(self);
image.width:=Screen.width;
image.Height:=screen.Height ;
image.picture.bitmap.PixelFormat:= pf16bit;
bitblt(image.canvas.handle,0,0,image.width,image.height,ss.handle,0,0,srccopy);
{大大的BMP流
image.picture.bitmap.SaveToStream(memoryStream);
}
{无损压缩BMP流 //uses Zlib.pas
//先定义变量count,DestStream,SourceStream
image.picture.bitmap.SaveToStream(memoryStream);
Count:=memoryStream.Size;
DestStream:=TMemoryStream.Create;
//压缩方式:clnone,clfastest,cldefault,clmax
SourceStream:=TCompressionStream.Create(cldefault, DestStream);
try
memoryStream.SaveToStream(SourceStream);
SourceStream.Free;
memoryStream.Clear;
memoryStream.WriteBuffer(Count, SizeOf(Count));
memoryStream.CopyFrom(DestStream, 0);
finally
DestStream.Free;
end;
}
{还原BMP流 //uses Zlib.pas
//先定义变量count,buffer,DestStream,SourceStream
//memoryStream是压缩的BMP流
memoryStream.ReadBuffer(Count, SizeOf(Count));
GetMem(Buffer, Count);
DestStream:=TMemoryStream.Create;
SourceStream:=TDecompressionStream.Create(memoryStream);
Try
SourceStream.ReadBuffer(Buffer^, Count);
DestStream.WriteBuffer(Buffer^, Count);
DestStream.Position:=0;
image.Picture.Bitmap.LoadFromStream(DestStream);
finally
FreeMem(Buffer);
DestStream.Free;
end;
}
{JPG流 //uses jpeg
jpgstream:= TJPEGImage.Create;
jpgstream.Assign(image.picture.bitmap);
jpgstream.CompressionQuality:=50;//压缩质量
jpgstream.Compress;
jpgstream.SaveToStream(memoryStream);//保存为JPG流
//使用JPG流 image.Picture.Assign(jpgstream);
jpgstream.free;
}
ReleaseDC(0,ss.Handle);
image.free;
{发送内存流...}
end;
我用的是内存流和timer实现连续抓图！但速度并不行！
这是我的程序
var
DC: HDC;
Canvas: TCanvas;
MyBitmap: TBitmap;
aPicture : TPicture;
jpg:tjpegimage;
begin
DC := GetDC(0);
mybitmap:=tbitmap.Create;
canvas:=tcanvas.Create;
Canvas.Handle := DC;
with Screen do
begin
MyBitmap.Width := Width;
MyBitmap.Height := Height;
Application.ProcessMessages;
MyBitmap.Canvas.CopyRect(Rect(0, 0, Width, Height), Canvas,
Rect(0, 0, Width, Height));
end;
jpg:=tjpegimage.Create ;
aPicture:= TPicture.Create;
apicture.Bitmap:=mybitmap;
Application.ProcessMessages;
jpg.Assign(apicture.Bitmap);
TempStream[zuatu] := TMemoryStream.Create;
Application.ProcessMessages;
jpg.SaveToStream(TempStream[zuatu]);
ReleaseDC(0, DC);
mybitmap.free;
canvas.Free;
jpg.Free;
apicture.Free ;
zuatu:=zuatu-1;
if zuatu<1 then
十四、实现Word文档中表格的替换
var
itemindex,mystart,myend:OleVariant;
AData : THandle;
APalette: HPALETTE;
MyFormat : Word;
begin
try
//把剖面图发送到剪贴板，设定句柄。
TempProfile1.Picture.SaveToClipboardFormat(MyFormat,AData,APalette);
ClipBoard.SetAsHandle(MyFormat,AData);
finally
WordDocument1.Paragraphs.Item(21).Range.paste;//粘贴到Word文档中。
Dbimage的粘贴方法参见delphi的demo在activex目录下。
小弟收集了些windows消息的用法，特与大家共享，由于水平有限，望各位高手能指出错误提出更多的关于windows消息的用法，重金酬献￥￥￥
消息，就是指Wi n d o w s发出的一个通知，告诉应用程序某个事情发生了。例如，单击鼠标、改变
窗口尺寸、按下键盘上的一个键都会使Wi n d o w s发送一个消息给应用程序。
消息本身是作为一个记录传递给应用程序的，这个记录中包含了消息的类型以及其他信息。例如，
对于单击鼠标所产生的消息来说，这个记录中包含了单击鼠标时的坐标。这个记录类型叫做T M s g，它
在Wi n d o w s单元中是这样声明的：
t y p e
TMsg = packed record
hwnd: HWND; / /窗口句柄
message: UINT; / /消息常量标识符
wParam: WPA R A M ; // 32位消息的特定附加信息
lParam: LPA R A M ; // 32位消息的特定附加信息
time: DWORD; / /消息创建时的时间
pt: TPoint; / /消息创建时的鼠标位置
e n d ;
消息中有什么？
是否觉得一个消息记录中的信息像希腊语一样？如果是这样，那么看一看下面的解释：
hwnd 32位的窗口句柄。窗口可以是任何类型的屏幕对象，因为Win32能够维护大多数可
视对象的句柄(窗口、对话框、按钮、编辑框等)。
message 用于区别其他消息的常量值，这些常量可以是Windows单元中预定义的常量，也
可以是自定义的常量。
wParam 通常是一个与消息有关的常量值，也可能是窗口或控件的句柄。
lParam 通常是一个指向内存中数据的指针。由于W P a r a m、l P a r a m和P o i n t e r都是3 2位的，
因此，它们之间可以相互转换。
WM_NULL = $0000;
WM_CREATE = $0001;
应用程序创建一个窗口
WM_DESTROY = $0002;
一个窗口被销毁
WM_MOVE = $0003;
移动一个窗口
WM_SIZE = $0005;
改变一个窗口的大小
WM_ACTIVATE = $0006;
一个窗口被激活或失去激活状态；
WM_SETFOCUS = $0007;
获得焦点后
WM_KILLFOCUS = $0008;
失去焦点
WM_ENABLE = $000A;
改变enable状态
WM_SETREDRAW = $000B;
设置窗口是否能重画
WM_SETTEXT = $000C;
应用程序发送此消息来设置一个窗口的文本
WM_GETTEXT = $000D;
应用程序发送此消息来复制对应窗口的文本到缓冲区
WM_GETTEXTLENGTH = $000E;
得到与一个窗口有关的文本的长度（不包含空字符）
WM_PAINT = $000F;
要求一个窗口重画自己
WM_CLOSE = $0010;
当一个窗口或应用程序要关闭时发送一个信号
WM_QUERYENDSESSION = $0011;
当用户选择结束对话框或程序自己调用ExitWindows函数
WM_QUIT = $0012;
用来结束程序运行或当程序调用postquitmessage函数
WM_QUERYOPEN = $0013;
当用户窗口恢复以前的大小位置时，把此消息发送给某个图标
WM_ERASEBKGND = $0014;
当窗口背景必须被擦除时（例在窗口改变大小时）
WM_SYSCOLORCHANGE = $0015;
当系统颜色改变时，发送此消息给所有顶级窗口
WM_ENDSESSION = $0016;
当系统进程发出WM_QUERYENDSESSION消息后，此消息发送给应用程序，
通知它对话是否结束
WM_SYSTEMERROR = $0017;
WM_SHOWWINDOW = $0018;
当隐藏或显示窗口是发送此消息给这个窗口
WM_ACTIVATEAPP = $001C;
发此消息给应用程序哪个窗口是激活的，哪个是非激活的；
WM_FONTCHANGE = $001D;
当系统的字体资源库变化时发送此消息给所有顶级窗口
WM_TIMECHANGE = $001E;
当系统的时间变化时发送此消息给所有顶级窗口
WM_CANCELMODE = $001F;
发送此消息来取消某种正在进行的摸态（操作）
WM_SETCURSOR = $0020;
如果鼠标引起光标在某个窗口中移动且鼠标输入没有被捕获时，就发消息给某个窗口
WM_MOUSEACTIVATE = $0021;
当光标在某个非激活的窗口中而用户正按着鼠标的某个键发送此消息给当前窗口
WM_CHILDACTIVATE = $0022;
发送此消息给MDI子窗口当用户点击此窗口的标题栏，或当窗口被激活，移动，改变大小
WM_QUEUESYNC = $0023;
此消息由基于计算机的训练程序发送，通过WH_JOURNALPALYBACK的hook程序
分离出用户输入消息
WM_GETMINMAXINFO = $0024;
此消息发送给窗口当它将要改变大小或位置；
WM_PAINTICON = $0026;
发送给最小化窗口当它图标将要被重画
WM_ICONERASEBKGND = $0027;
此消息发送给某个最小化窗口，仅当它在画图标前它的背景必须被重画
WM_NEXTDLGCTL = $0028;
发送此消息给一个对话框程序去更改焦点位置
WM_SPOOLERSTATUS = $002A;
每当打印管理列队增加或减少一条作业时发出此消息
WM_DRAWITEM = $002B;
当button，combobox，listbox，menu的可视外观改变时发送
此消息给这些空件的所有者
WM_MEASUREITEM = $002C;
当button, combo box, list box, list view control, or menu item 被创建时
发送此消息给控件的所有者
WM_DELETEITEM = $002D;
当the list box 或 combo box 被销毁 或 当 某些项被删除通过LB_DELETESTRING, LB_RESETCONTENT, CB_DELETESTRING, or CB_RESETCONTENT 消息
WM_VKEYTOITEM = $002E;
此消息有一个LBS_WANTKEYBOARDINPUT风格的发出给它的所有者来响应WM_KEYDOWN消息
WM_CHARTOITEM = $002F;
此消息由一个LBS_WANTKEYBOARDINPUT风格的列表框发送给他的所有者来响应WM_CHAR消息
WM_SETFONT = $0030;
当绘制文本时程序发送此消息得到控件要用的颜色
WM_GETFONT = $0031;
应用程序发送此消息得到当前控件绘制文本的字体
WM_SETHOTKEY = $0032;
应用程序发送此消息让一个窗口与一个热键相关连
WM_GETHOTKEY = $0033;
应用程序发送此消息来判断热键与某个窗口是否有关联
WM_QUERYDRAGICON = $0037;
此消息发送给最小化窗口，当此窗口将要被拖放而它的类中没有定义图标，应用程序能
返回一个图标或光标的句柄，当用户拖放图标时系统显示这个图标或光标
WM_COMPAREITEM = $0039;
发送此消息来判定combobox或listbox新增加的项的相对位置
WM_GETOBJECT = $003D;
WM_COMPACTING = $0041;
显示内存已经很少了
WM_WINDOWPOSCHANGING = $0046;
发送此消息给那个窗口的大小和位置将要被改变时，来调用setwindowpos函数或其它窗口管理函数
WM_WINDOWPOSCHANGED = $0047;
发送此消息给那个窗口的大小和位置已经被改变时，来调用setwindowpos函数或其它窗口管理函数
WM_POWER = $0048;（适用于16位的windows）
当系统将要进入暂停状态时发送此消息
WM_COPYDATA = $004A;
当一个应用程序传递数据给另一个应用程序时发送此消息
WM_CANCELJOURNAL = $004B;
当某个用户取消程序日志激活状态，提交此消息给程序
WM_NOTIFY = $004E;
当某个控件的某个事件已经发生或这个控件需要得到一些信息时，发送此消息给它的父窗口
WM_INPUTLANGCHANGEREQUEST = $0050;
当用户选择某种输入语言，或输入语言的热键改变
WM_INPUTLANGCHANGE = $0051;
当平台现场已经被改变后发送此消息给受影响的最顶级窗口
WM_TCARD = $0052;
当程序已经初始化windows帮助例程时发送此消息给应用程序
WM_HELP = $0053;
此消息显示用户按下了F1，如果某个菜单是激活的，就发送此消息个此窗口关联的菜单，否则就
发送给有焦点的窗口，如果当前都没有焦点，就把此消息发送给当前激活的窗口
WM_USERCHANGED = $0054;
当用户已经登入或退出后发送此消息给所有的窗口，当用户登入或退出时系统更新用户的具体
设置信息，在用户更新设置时系统马上发送此消息；
WM_NOTIFYFORMAT = $0055;
公用控件，自定义控件和他们的父窗口通过此消息来判断控件是使用ANSI还是UNICODE结构
在WM_NOTIFY消息，使用此控件能使某个控件与它的父控件之间进行相互通信
WM_CONTEXTMENU = $007B;
当用户某个窗口中点击了一下右键就发送此消息给这个窗口
WM_STYLECHANGING = $007C;
当调用SETWINDOWLONG函数将要改变一个或多个 窗口的风格时发送此消息给那个窗口
WM_STYLECHANGED = $007D;
当调用SETWINDOWLONG函数一个或多个 窗口的风格后发送此消息给那个窗口
WM_DISPLAYCHANGE = $007E;
当显示器的分辨率改变后发送此消息给所有的窗口
WM_GETICON = $007F;
此消息发送给某个窗口来返回与某个窗口有关连的大图标或小图标的句柄；
WM_SETICON = $0080;
程序发送此消息让一个新的大图标或小图标与某个窗口关联；
WM_NCCREATE = $0081;
当某个窗口第一次被创建时，此消息在WM_CREATE消息发送前发送；
WM_NCDESTROY = $0082;
此消息通知某个窗口，非客户区正在销毁
WM_NCCALCSIZE = $0083;
当某个窗口的客户区域必须被核算时发送此消息
WM_NCHITTEST = $0084;//移动鼠标，按住或释放鼠标时发生
WM_NCPAINT = $0085;
程序发送此消息给某个窗口当它（窗口）的框架必须被绘制时；
WM_NCACTIVATE = $0086;
此消息发送给某个窗口 仅当它的非客户区需要被改变来显示是激活还是非激活状态；
WM_GETDLGCODE = $0087;
发送此消息给某个与对话框程序关联的控件，widdows控制方位键和TAB键使输入进入此控件
通过响应WM_GETDLGCODE消息，应用程序可以把他当成一个特殊的输入控件并能处理它
WM_NCMOUSEMOVE = $00A0;
当光标在一个窗口的非客户区内移动时发送此消息给这个窗口 //非客户区为：窗体的标题栏及窗
的边框体
WM_NCLBUTTONDOWN = $00A1;
当光标在一个窗口的非客户区同时按下鼠标左键时提交此消息
WM_NCLBUTTONUP = $00A2;
当用户释放鼠标左键同时光标某个窗口在非客户区十发送此消息；
WM_NCLBUTTONDBLCLK = $00A3;
当用户双击鼠标左键同时光标某个窗口在非客户区十发送此消息
WM_NCRBUTTONDOWN = $00A4;
当用户按下鼠标右键同时光标又在窗口的非客户区时发送此消息
WM_NCRBUTTONUP = $00A5;
当用户释放鼠标右键同时光标又在窗口的非客户区时发送此消息
WM_NCRBUTTONDBLCLK = $00A6;
当用户双击鼠标右键同时光标某个窗口在非客户区十发送此消息
WM_NCMBUTTONDOWN = $00A7;
当用户按下鼠标中键同时光标又在窗口的非客户区时发送此消息
WM_NCMBUTTONUP = $00A8;
当用户释放鼠标中键同时光标又在窗口的非客户区时发送此消息
WM_NCMBUTTONDBLCLK = $00A9;
当用户双击鼠标中键同时光标又在窗口的非客户区时发送此消息
WM_KEYFIRST = $0100;
WM_KEYDOWN = $0100;
//按下一个键
WM_KEYUP = $0101;
//释放一个键
WM_CHAR = $0102;
//按下某键，并已发出WM_KEYDOWN， WM_KEYUP消息
WM_DEADCHAR = $0103;
当用translatemessage函数翻译WM_KEYUP消息时发送此消息给拥有焦点的窗口
WM_SYSKEYDOWN = $0104;
当用户按住ALT键同时按下其它键时提交此消息给拥有焦点的窗口；
WM_SYSKEYUP = $0105;
当用户释放一个键同时ALT 键还按着时提交此消息给拥有焦点的窗口
WM_SYSCHAR = $0106;
当WM_SYSKEYDOWN消息被TRANSLATEMESSAGE函数翻译后提交此消息给拥有焦点的窗口
WM_SYSDEADCHAR = $0107;
当WM_SYSKEYDOWN消息被TRANSLATEMESSAGE函数翻译后发送此消息给拥有焦点的窗口
WM_KEYLAST = $0108;
WM_INITDIALOG = $0110;
在一个对话框程序被显示前发送此消息给它，通常用此消息初始化控件和执行其它任务
WM_COMMAND = $0111;
当用户选择一条菜单命令项或当某个控件发送一条消息给它的父窗口，一个快捷键被翻译
WM_SYSCOMMAND = $0112;
当用户选择窗口菜单的一条命令或当用户选择最大化或最小化时那个窗口会收到此消息
WM_TIMER = $0113; //发生了定时器事件
WM_HSCROLL = $0114;
当一个窗口标准水平滚动条产生一个滚动事件时发送此消息给那个窗口，也发送给拥有它的控件
WM_VSCROLL = $0115;
当一个窗口标准垂直滚动条产生一个滚动事件时发送此消息给那个窗口也，发送给拥有它的控件 WM_INITMENU = $0116;
当一个菜单将要被激活时发送此消息，它发生在用户菜单条中的某项或按下某个菜单键，它允许
程序在显示前更改菜单
WM_INITMENUPOPUP = $0117;
当一个下拉菜单或子菜单将要被激活时发送此消息，它允许程序在它显示前更改菜单，而不要
改变全部
WM_MENUSELECT = $011F;
当用户选择一条菜单项时发送此消息给菜单的所有者（一般是窗口）
WM_MENUCHAR = $0120;
当菜单已被激活用户按下了某个键（不同于加速键），发送此消息给菜单的所有者；
WM_ENTERIDLE = $0121;
当一个模态对话框或菜单进入空载状态时发送此消息给它的所有者，一个模态对话框或菜单进入空载状态就是在处理完一条或几条先前的消息后没有消息它的列队中等待
WM_MENURBUTTONUP = $0122;
WM_MENUDRAG = $0123;
WM_MENUGETOBJECT = $0124;
WM_UNINITMENUPOPUP = $0125;
WM_MENUCOMMAND = $0126;
WM_CHANGEUISTATE = $0127;
WM_UPDATEUISTATE = $0128;
WM_QUERYUISTATE = $0129;
WM_CTLCOLORMSGBOX = $0132;
在windows绘制消息框前发送此消息给消息框的所有者窗口，通过响应这条消息，所有者窗口可以
通过使用给定的相关显示设备的句柄来设置消息框的文本和背景颜色
WM_CTLCOLOREDIT = $0133;
当一个编辑型控件将要被绘制时发送此消息给它的父窗口；通过响应这条消息，所有者窗口可以
通过使用给定的相关显示设备的句柄来设置编辑框的文本和背景颜色
WM_CTLCOLORLISTBOX = $0134;
当一个列表框控件将要被绘制前发送此消息给它的父窗口；通过响应这条消息，所有者窗口可以
通过使用给定的相关显示设备的句柄来设置列表框的文本和背景颜色
WM_CTLCOLORBTN = $0135;
当一个按钮控件将要被绘制时发送此消息给它的父窗口；通过响应这条消息，所有者窗口可以
通过使用给定的相关显示设备的句柄来设置按纽的文本和背景颜色
WM_CTLCOLORDLG = $0136;
当一个对话框控件将要被绘制前发送此消息给它的父窗口；通过响应这条消息，所有者窗口可以
通过使用给定的相关显示设备的句柄来设置对话框的文本背景颜色
WM_CTLCOLORSCROLLBAR= $0137;
当一个滚动条控件将要被绘制时发送此消息给它的父窗口；通过响应这条消息，所有者窗口可以
通过使用给定的相关显示设备的句柄来设置滚动条的背景颜色
WM_CTLCOLORSTATIC = $0138;
当一个静态控件将要被绘制时发送此消息给它的父窗口；通过响应这条消息，所有者窗口可以
通过使用给定的相关显示设备的句柄来设置静态控件的文本和背景颜色
WM_MOUSEFIRST = $0200;
WM_MOUSEMOVE = $0200;
// 移动鼠标
WM_LBUTTONDOWN = $0201; //按下鼠标左键
WM_LBUTTONUP = $0202; //释放鼠标左键
WM_LBUTTONDBLCLK = $0203;//双击鼠标左键
WM_RBUTTONDOWN = $0204; //按下鼠标右键
WM_RBUTTONUP = $0205; //释放鼠标右键
WM_RBUTTONDBLCLK = $0206;//双击鼠标右键
WM_MBUTTONDOWN = $0207; //按下鼠标中键
WM_MBUTTONUP = $0208; //释放鼠标中键
WM_MBUTTONDBLCLK = $0209; //双击鼠标中键
WM_MOUSEWHEEL = $020A;
当鼠标轮子转动时发送此消息个当前有焦点的控件
WM_MOUSELAST = $020A;
WM_PARENTNOTIFY = $0210;
当MDI子窗口被创建或被销毁，或用户按了一下鼠标键而光标在子窗口上时发送此消息给它的父窗口
WM_ENTERMENULOOP = $0211;
发送此消息通知应用程序的主窗口that已经进入了菜单循环模式
WM_EXITMENULOOP = $0212;
发送此消息通知应用程序的主窗口that已退出了菜单循环模式
WM_NEXTMENU = $0213;
WM_SIZING = 532;
当用户正在调整窗口大小时发送此消息给窗口；通过此消息应用程序可以监视窗口大小和位置
也可以修改他们
WM_CAPTURECHANGED = 533;
发送此消息 给窗口当它失去捕获的鼠标时；
WM_MOVING = 534;
当用户在移动窗口时发送此消息，通过此消息应用程序可以监视窗口大小和位置
也可以修改他们；
WM_POWERBROADCAST = 536;
此消息发送给应用程序来通知它有关电源管理事件；
WM_DEVICECHANGE = 537;
当设备的硬件配置改变时发送此消息给应用程序或设备驱动程序
WM_IME_STARTCOMPOSITION = $010D;
WM_IME_ENDCOMPOSITION = $010E;
WM_IME_COMPOSITION = $010F;
WM_IME_KEYLAST = $010F;
WM_IME_SETCONTEXT = $0281;
WM_IME_NOTIFY = $0282;
WM_IME_CONTROL = $0283;
WM_IME_COMPOSITIONFULL = $0284;
WM_IME_SELECT = $0285;
WM_IME_CHAR = $0286;
WM_IME_REQUEST = $0288;
WM_IME_KEYDOWN = $0290;
WM_IME_KEYUP = $0291;
WM_MDICREATE = $0220;
应用程序发送此消息给多文档的客户窗口来创建一个MDI 子窗口
WM_MDIDESTROY = $0221;
应用程序发送此消息给多文档的客户窗口来关闭一个MDI 子窗口
WM_MDIACTIVATE = $0222;
应用程序发送此消息给多文档的客户窗口通知客户窗口激活另一个MDI子窗口，当客户窗口收到
此消息后，它发出WM_MDIACTIVE消息给MDI子窗口（未激活）激活它；
WM_MDIRESTORE = $0223;
程序 发送此消息给MDI客户窗口让子窗口从最大最小化恢复到原来大小
WM_MDINEXT = $0224;
程序 发送此消息给MDI客户窗口激活下一个或前一个窗口
WM_MDIMAXIMIZE = $0225;
程序发送此消息给MDI客户窗口来最大化一个MDI子窗口；
WM_MDITILE = $0226;
程序 发送此消息给MDI客户窗口以平铺方式重新排列所有MDI子窗口
WM_MDICASCADE = $0227;
程序 发送此消息给MDI客户窗口以层叠方式重新排列所有MDI子窗口
WM_MDIICONARRANGE = $0228;
程序 发送此消息给MDI客户窗口重新排列所有最小化的MDI子窗口
WM_MDIGETACTIVE = $0229;
程序 发送此消息给MDI客户窗口来找到激活的子窗口的句柄
WM_MDISETMENU = $0230;
程序 发送此消息给MDI客户窗口用MDI菜单代替子窗口的菜单
WM_ENTERSIZEMOVE = $0231;
WM_EXITSIZEMOVE = $0232;
WM_DROPFILES = $0233;
WM_MDIREFRESHMENU = $0234;
WM_MOUSEHOVER = $02A1;
WM_MOUSELEAVE = $02A3;
WM_CUT = $0300;
程序发送此消息给一个编辑框或combobox来删除当前选择的文本
WM_COPY = $0301;
程序发送此消息给一个编辑框或combobox来复制当前选择的文本到剪贴板
WM_PASTE = $0302;
程序发送此消息给editcontrol或combobox从剪贴板中得到数据
WM_CLEAR = $0303;
程序发送此消息给editcontrol或combobox清除当前选择的内容；
WM_UNDO = $0304;
程序发送此消息给editcontrol或combobox撤消最后一次操作
WM_RENDERFORMAT = $0305；
WM_RENDERALLFORMATS = $0306;
WM_DESTROYCLIPBOARD = $0307;
当调用ENPTYCLIPBOARD函数时 发送此消息给剪贴板的所有者
WM_DRAWCLIPBOARD = $0308;
当剪贴板的内容变化时发送此消息给剪贴板观察链的第一个窗口；它允许用剪贴板观察窗口来
显示剪贴板的新内容；
WM_PAINTCLIPBOARD = $0309;
当剪贴板包含CF_OWNERDIPLAY格式的数据并且剪贴板观察窗口的客户区需要重画；
WM_VSCROLLCLIPBOARD = $030A;
WM_SIZECLIPBOARD = $030B;
当剪贴板包含CF_OWNERDIPLAY格式的数据并且剪贴板观察窗口的客户区域的大小已经改变是此消息通过剪贴板观察窗口发送给剪贴板的所有者；
WM_ASKCBFORMATNAME = $030C;
通过剪贴板观察窗口发送此消息给剪贴板的所有者来请求一个CF_OWNERDISPLAY格式的剪贴板的名字
WM_CHANGECBCHAIN = $030D;
当一个窗口从剪贴板观察链中移去时发送此消息给剪贴板观察链的第一个窗口；
WM_HSCROLLCLIPBOARD = $030E;
此消息通过一个剪贴板观察窗口发送给剪贴板的所有者 ；它发生在当剪贴板包含CFOWNERDISPALY格式的数据并且有个事件在剪贴板观察窗的水平滚动条上；所有者应滚动剪贴板图象并更新滚动条的值；
WM_QUERYNEWPALETTE = $030F;
此消息发送给将要收到焦点的窗口，此消息能使窗口在收到焦点时同时有机会实现他的逻辑调色板
WM_PALETTEISCHANGING= $0310;
当一个应用程序正要实现它的逻辑调色板时发此消息通知所有的应用程序
WM_PALETTECHANGED = $0311;
此消息在一个拥有焦点的窗口实现它的逻辑调色板后发送此消息给所有顶级并重叠的窗口，以此
来改变系统调色板
WM_HOTKEY = $0312;
当用户按下由REGISTERHOTKEY函数注册的热键时提交此消息
WM_PRINT = 791;
应用程序发送此消息仅当WINDOWS或其它应用程序发出一个请求要求绘制一个应用程序的一部分；
WM_PRINTCLIENT = 792;
WM_HANDHELDFIRST = 856;
WM_HANDHELDLAST = 863;
WM_PENWINFIRST = $0380;
WM_PENWINLAST = $038F;
WM_COALESCE_FIRST = $0390;
WM_COALESCE_LAST = $039F;
WM_DDE_FIRST = $03E0;
WM_DDE_INITIATE = WM_DDE_FIRST + 0;
一个DDE客户程序提交此消息开始一个与服务器程序的会话来响应那个指定的程序和主题名；
WM_DDE_TERMINATE = WM_DDE_FIRST + 1;
一个DDE应用程序（无论是客户还是服务器）提交此消息来终止一个会话；
WM_DDE_ADVISE = WM_DDE_FIRST + 2;
一个DDE客户程序提交此消息给一个DDE服务程序来请求服务器每当数据项改变时更新它
WM_DDE_UNADVISE = WM_DDE_FIRST + 3;
一个DDE客户程序通过此消息通知一个DDE服务程序不更新指定的项或一个特殊的剪贴板格式的项
WM_DDE_ACK = WM_DDE_FIRST + 4;
此消息通知一个DDE（动态数据交换）程序已收到并正在处理WM_DDE_POKE, WM_DDE_EXECUTE, WM_DDE_DATA, WM_DDE_ADVISE, WM_DDE_UNADVISE, or WM_DDE_INITIAT消息
WM_DDE_DATA = WM_DDE_FIRST + 5;
一个DDE服务程序提交此消息给DDE客户程序来传递个一数据项给客户或通知客户的一条可用数据项
WM_DDE_REQUEST = WM_DDE_FIRST + 6;
一个DDE客户程序提交此消息给一个DDE服务程序来请求一个数据项的值；
WM_DDE_POKE = WM_DDE_FIRST + 7;
一个DDE客户程序提交此消息给一个DDE服务程序，客户使用此消息来请求服务器接收一个未经同意的数据项；服务器通过答复WM_DDE_ACK消息提示是否它接收这个数据项；
WM_DDE_EXECUTE = WM_DDE_FIRST + 8;
一个DDE客户程序提交此消息给一个DDE服务程序来发送一个字符串给服务器让它象串行命令一样被处理，服务器通过提交WM_DDE_ACK消息来作回应；
WM_DDE_LAST = WM_DDE_FIRST + 8;
WM_APP = $8000;
WM_USER = $0400;
此消息能帮助应用程序自定义私有消息；
/
通知消息(Notification message)是指这样一种消息，一个窗口内的子控件发生了一些事情，需要通
知父窗口。通知消息只适用于标准的窗口控件如按钮、列表框、组合框、编辑框，以及Windows 95公
共控件如树状视图、列表视图等。例如，单击或双击一个控件、在控件中选择部分文本、操作控件的
滚动条都会产生通知消息。
按扭
B N _ C L I C K E D //用户单击了按钮
B N _ D I S A B L E //按钮被禁止
B N _ D O U B L E C L I C K E D //用户双击了按钮
B N _ H I L I T E //用户加亮了按钮
B N _ PA I N T按钮应当重画
B N _ U N H I L I T E加亮应当去掉
组合框
C B N _ C L O S E U P组合框的列表框被关闭
C B N _ D B L C L K用户双击了一个字符串
C B N _ D R O P D O W N组合框的列表框被拉出
C B N _ E D I T C H A N G E用户修改了编辑框中的文本
C B N _ E D I T U P D AT E编辑框内的文本即将更新
C B N _ E R R S PA C E组合框内存不足
C B N _ K I L L F O C U S组合框失去输入焦点
C B N _ S E L C H A N G E在组合框中选择了一项
C B N _ S E L E N D C A N C E L用户的选择应当被取消
C B N _ S E L E N D O K用户的选择是合法的
C B N _ S E T F O C U S组合框获得输入焦点
编辑框
E N _ C H A N G E编辑框中的文本己更新
E N _ E R R S PA C E编辑框内存不足
E N _ H S C R O L L用户点击了水平滚动条
E N _ K I L L F O C U S编辑框正在失去输入焦点
E N _ M A X T E X T插入的内容被截断
E N _ S E T F O C U S编辑框获得输入焦点
E N _ U P D AT E编辑框中的文本将要更新
E N _ V S C R O L L用户点击了垂直滚动条消息含义
列表框
L B N _ D B L C L K用户双击了一项
L B N _ E R R S PA C E列表框内存不够
L B N _ K I L L F O C U S列表框正在失去输入焦点
L B N _ S E L C A N C E L选择被取消
L B N _ S E L C H A N G E选择了另一项
L B N _ S E T F O C U S列表框获得输入焦点
本人能力有限，如有不当之处，还望高手多多指教；baoxf1025@163.com
Tchart属性描述
Nseries需比较的数据项的个数
Nvalues每个数据项中的子项目数
TitleDlg图表的标题设置对话框
AdmDlg图表构件绘图区上下左右边缘处注解设置对话框
FontDlg注解文字字体设置
BorderStyle图表构件的边框风格
Height、Width、Top、Left这四项设置图表构件在窗体中的位置及大小
BottomGap、TopGap、LeftGap、RightGap这四项设置图表构件绘图区的位置及大小
ChartType、pThpe、Style这三项设置图表构件及绘图区的类型与风格
Chart3D用以设置是否以三维形式显示数据
ViewRot3D设置观察三维图示的视角
WallWidth设置三维图示中X、Y、Z三壁的厚度
LinebkColor、LineColor、LineStyle、LineWidth设置线条的颜色和风格
PointType设置数据点的形状、类型
RGB3DBK、RGB2DBK、RGBBK、RGBBarHorz设置2/3维图示中背景色
Cursor设置绘图区光标形状
Decimals设置图表中数据显示的小数位数
Stacked设置图表中数据的归一化方式
Grid、VertGridGap设置坐标系的背景网格线
在制作同时比较多组数据的图表时，还需要设置以下属性：
FixedGap每个数据项之间间隔
ThisPoint数据项的次序
ThisSerie每个数据项中子数据项的次序
ThisBkColor、ThisColor颜色设置
余下的Visible、Hint、HelpContext、Name、Tag等属性与其它构件相同，不再赘述。
下面对CustTool、ToolBar、PalleteBar、PatternBar几个关于图表中工具条设置的属性
作简单介绍。PalleteBar设为True时生成的图表带有颜色设置工具条，即可在浏览图表
时改变数据项颜色以适应不同视觉需求。
PatternBar设为True时生成的图表带有图案设置工具条，作用同上。
ToolBar设为True时生成的图表带有一个功能
强大的工具条，其上加速键能完成的功能有：从数据文件读入比较数据、输出数据到
数据文件、图表打印、在直方图/饼图/离散点图/曲线拟合图之间切换、2/3维切换、改变
视角、以表格方式浏览、修改数据等等。丰富的功能节省了程序员的开发时间，使用极为
方便(工具条上每个加速键都有Hint提示)。
CustTool在该属性里可以设置需要使用的功能项，Delphi自动去除未选取的加速键。
到目前为止，读者对ChartFx构件的属性已有了一定的了解，可以设计较为复杂的图表了，
但还不能真正制作实用的图表，因为我们还未介绍如何初始化数据。同时读者可能还发现
了这么个问题：当数据较多以致构件空间容纳不下怎么办?我们举一实例来说明这两个问
题。假定某校要比较全校40个班级某一学期班平均成绩，40个班的平均分和名称(实验班、
初一(2)等)分别存放在两个数组Data［39］、Class Name［39］中。在窗体FormCreat事
件中加入以下代码：
For i:=0 to 39 Do Begin
ChartFx 1.OpenData［COD-VALUES］:=makelong(1,40);
With ChartFx1 Do Begin
ThisSerie:=0;
Value［i］:=Data［i］;
Legend［i］:=ClassName［i］;
CloseData［COD-VALUES］:=0;
End;
End;
按F9执行，我们发现图表并未显示全部40个数据，而是在绘图区下方出现了滚行条，
滚动此条就可以浏览全部数据，Delphi轻松地解决了这个问题。在绘图区的右方则出现了
一个注解框，显示每个数据项编号所对应的班级名称。
若设置ChartType为Bar，则每个数据项都用一个有一定高度(此高度由初始化数
据及归一化方式决定)的彩色矩形条来表示。用鼠标双击矩形条即显示对应数据，显示方
式由DblClkDlg和RigClkDlg设定。
十五sharp画图
unit RotShp;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TRotateShape = class(TShape)
private
FAngle: Integer;
FShapeWidth: Integer;
FShapeHeight: Integer;
procedure SetAngle(Value: Integer);
procedure SetShapeHeight(const Value: Integer);
procedure SetShapeWidth(const Value: Integer);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property ShapeWidth: Integer read FShapeWidth write SetShapeWidth;
property ShapeHeight: Integer read FShapeHeight write SetShapeHeight;
property Angle: Integer read FAngle write SetAngle;
end;
procedure Register;
implementation
uses
Math;
procedure Register;
begin
RegisterComponents('Samples', [TRotateShape]);
end;
{ TRotateShape }
const
MinDist = 30;
type
TDblPoint = record
x, y: Extended;
end;
function DblPoint(x, y: Extended): TDblPoint;
begin
Result.x := x;
Result.y := y;
end;
constructor TRotateShape.Create(AOwner: TComponent);
begin
inherited;
FShapeWidth := Width;
FShapeHeight := Height;
FAngle := 0;
end;
procedure TRotateShape.Paint;
var
p: array of TPoint;
fp: array of TDblPoint;
Cnt, i: Integer;
Len, Alpha, Pho, Theta, a, b, x, y: Extended;
begin
x := Width * 0.5;
y := Height * 0.5;
a := FShapeWidth * 0.5;
b := FShapeHeight * 0.5;
if Shape in [stSquare, stRoundSquare, stCircle] then
if a < b then b := a
else a := b;
case Shape of
stRectangle, stSquare:
begin
SetLength(fp, 4);
fp[0] := DblPoint(-a, -b);
fp[1] := DblPoint( a, -b);
fp[2] := DblPoint( a, b);
fp[3] := DblPoint(-a, b);
end;
stRoundRect, stRoundSquare:
if (FShapeWidth <= 25) or (FShapeHeight <= 25) then begin
SetLength(fp, 4);
fp[0] := DblPoint(-a, -b);
fp[1] := DblPoint( a, -b);
fp[2] := DblPoint( a, b);
fp[3] := DblPoint(-a, b);
end else begin
SetLength(fp, 16);
fp[0] := DblPoint(-a + 5, -b);
fp[1] := DblPoint(a - 5, -b);
fp[2] := DblPoint(a - 5 + Cos(DegToRad(300)) * 5,
-b + 5 + Sin(DegToRad(300)) * 5);
fp[3] := DblPoint(a - 5 + Cos(DegToRad(330)) * 5,
-b + 5 + Sin(DegToRad(330)) * 5);
fp[4] := DblPoint(a, -b + 5);
fp[5] := DblPoint(a, b - 5);
fp[6] := DblPoint(a - 5 + Cos(DegToRad(30)) * 5,
b - 5 + Sin(DegToRad(30)) * 5);
fp[7] := DblPoint(a - 5 + Cos(DegToRad(60)) * 5,
b - 5 + Sin(DegToRad(60)) * 5);
fp[8] := DblPoint(a - 5, b);
fp[9] := DblPoint(-a + 5, b);
fp[10] := DblPoint(-a + 5 + Cos(DegToRad(120)) * 5,
b - 5 + Sin(DegToRad(120)) * 5);
fp[11] := DblPoint(-a + 5 + Cos(DegToRad(150)) * 5,
b - 5 + Sin(DegToRad(150)) * 5);
fp[12] := DblPoint(-a, b - 5);
fp[13] := DblPoint(-a, -b + 5);
fp[14] := DblPoint(-a + 5 + Cos(DegToRad(210)) * 5,
-b + 5 + Sin(DegToRad(210)) * 5);
fp[15] := DblPoint(-a + 5 + Cos(DegToRad(240)) * 5,
-b + 5 + Sin(DegToRad(240)) * 5);
end;
stEllipse, stCircle:
begin
Len := Pi * a * b;
Cnt := Round(Len / MinDist);
SetLength(fp, Cnt);
for i := 0 to Cnt - 1 do begin
Alpha := i * 2 * Pi / Cnt;
fp[i] := DblPoint(a * Cos(Alpha), b * Sin(Alpha));
end;
end;
end;
SetLength(p, Length(fp));
Alpha := DegToRad(FAngle);
for i := Low(fp) to High(fp) do begin
Pho := Sqrt(Sqr(fp[i].x) + Sqr(fp[i].y));
Theta := ArcTan2(fp[i].y, fp[i].x) + Alpha;
p[i] := Point(Round(x + Pho * Cos(Theta)), Round(y + Pho * Sin(Theta)));
end;
Canvas.Pen := Pen;
Canvas.Brush := Brush;
Canvas.Polygon(p);
end;
procedure TRotateShape.SetAngle(Value: Integer);
begin
Value := Value mod 360;
if FAngle <> Value then begin
FAngle := Value;
Invalidate;
end;
end;
procedure TRotateShape.SetShapeHeight(const Value: Integer);
begin
if FShapeHeight <> Value then begin
FShapeHeight := Value;
Invalidate;
end;
end;
procedure TRotateShape.SetShapeWidth(const Value: Integer);
begin
if FShapeWidth <> Value then begin
FShapeWidth := Value;
Invalidate;
end;
end;
end.
十六 控件添加
| 问题：加入控件问题 ( 积分：200, 回复：3, 阅读：94 ) | |
| 来自：xtdragon, 时间：2001-4-14 10:35:00, ID：502395 | |
| 我有一段代码： unit WPanel;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls,Menus;
type TWPanel = class(TPanel) private { Private declarations } FTPanel:TPanel; FAPanel:TPanel; protected { Protected declarations } public { Public declarations } Constructor Create(AOwner:TComponent);override; Destructor Destroy;override; procedure FTPanelClick(Sender:TObject); procedure Change(Sender:TObject); class procedure mnuPPClear(mnuPP:TPopupMenu); procedure onPopup(mnuPP:TPopupMenu); procedure PanelMouseDown(Sender:TObject;Button:TMouseButton; Shift:TShiftState;X,Y:Integer); class procedure DeleteAllShapes(ParentControl : TWinControl); published { Published declarations } end; Var mnuPP:TPopupMenu;
implementation
Constructor TWpanel.Create(AOwner:TComponent); begin inherited Create(AOwner); BevelInner:=bvLowered; BevelWidth:=2; Height:=235; Width:=94; FTPanel:=TPanel.Create(Self); FTPanel.Parent:=TWpanel(Self); FTPanel.Height:=25; FTPanel.Align:=altop; FTPanel.onClick:=FTPanelClick; TPanel(Self).onMouseDown:=PanelMouseDown;
end;
Destructor TWPanel.Destroy; begin inherited Destroy; end;
class procedure TWPanel.DeleteAllShapes(ParentControl : TWinControl); var i : Integer; begin {DeleteAllShapes} // Delete controls from ParentControl i := 0;
while i < ParentControl.ControlCount do begin if ParentControl.Controls[i] is TWPanel then begin ParentControl.Controls[i].Free; // Note that there is no need to increment the counter, because the // next component (if any) will now be at the same position in Controls[] end else begin Inc(i); end; end; end; {DeleteAllShapes}
class procedure TWPanel.mnuPPClear(mnuPP:TPopupMenu); var i:integer; begin for i:=mnuPP.Items.Count-1 DownTo 0 do mnuPP.Items[i].Free; end;
procedure TWPanel.PanelMouseDown(Sender:TObject;Button:TMouseButton; Shift:TShiftState;X,Y:Integer);
var p,q:TPoint; begin {Selected:=True;} {ReleaseCapture; perform(WM_SysCommand,$F012,0);} if (Button in [mbRight]) then begin mnuPPClear(mnuPP); onPopup(mnuPP); P.x:=x; p.y:=y; q:=ClientToScreen(P); mnuPP.Popup(q.x,q.y); exit; end; end;
procedure TWPanel.FTPanelClick(Sender:TObject); var s:string; begin if inputQuery('机架名输入','请输入机架名',s) then FTPanel.Caption:=s; end;
procedure TWPanel.onPopup(mnuPP:TPopupMenu); var mp:TMenuItem; begin mp:=TMenuItem.Create(Self); mp.Caption:='增加机框'; mp.onClick:=Change; mnuPP.Items.Add(mp); end;
procedure TWPanel.Change(Sender:TObject); begin {if tmenuitem(sender).Caption='增加机框' then begin } FAPanel:=TPanel.Create(self); FAPanel.Align:=alBottom; FAPanel.Caption:='仙桃'; FAPanel.Height:=70; FAPanel.Parent:=TWPanel(self); {end;} end;
procedure RegisterStorageClasses; begin {RegisterStorageClasses} RegisterClasses([TWPanel]); end; {RegisterStorageClasses}
initialization RegisterStorageClasses; mnuPP:=TPopupMenu.Create(Application); end.
unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, ExtCtrls;
type TForm1 = class(TForm) Edit1: TEdit; Button1: TButton; PopupMenu1: TPopupMenu; add1: TMenuItem; ScrollBox1: TScrollBox; Panel1: TPanel;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button1Click(Sender: TObject);
private { Private declarations } public { Public declarations } end;
var Form1: TForm1;
implementation uses wpanel; {$R *.DFM}
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin with twpanel.Create(self) do begin left:=x; top:=y; parent:=form1; end; end;
procedure TForm1.Button1Click(Sender: TObject); begin edit1.text:=inttostr(form1.componentcount);
end; end. 在FORM1中动态建立一个TWPANEL后，窗体的控件数增加一个，但是用弹出菜单建立一个 TPANEL后，TPANEL。PARENT：=TWPANEL（SELF），窗体的控件数并不增加。请问这个问题 应该如何解决。 | |
十七、隐性的的产生Form，并且在Form上添加组件。
MYform:Tform;
MyApp: TWordApplication;
MyDoc: TWordDocument;
begin
Myform:=Tform.create(application);
MyApp:=TWordApplication.Create(MyForm);
MyDoc:=TWordDocument.Create(MyForm);
十八 Delphi的一些小经验。
先人的DELPHI基础开发技巧
整理：房客 来源：大富翁论坛
◇[DELPHI]网络邻居复制文件
uses shellapi;
copyfile(pchar('newfile.txt'),pchar('//computername/direction/targer.txt'),false);
◇[DELPHI]产生鼠标拖动效果
通过MouseMove事件、DragOver事件、EndDrag事件实现，例如在PANEL上的LABEL：
var xpanel,ypanel,xlabel,ylabel:integer;
PANEL的MouseMove事件：xpanel:=x;ypanel:=y;
PANEL的DragOver事件：xpanel:=x;ypanel:=y;
LABEL的MouseMove事件：xlabel:=x;ylabel:=y;
LABEL的EndDrag事件：label.left:=xpanel-xlabel;label.top:=ypanel-ylabel;
◇[DELPHI]取得WINDOWS目录
uses shellapi;
var windir:array[0..255] of char;
getwindowsdirectory(windir,sizeof(windir));
或者从注册表中读取，位置：
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion
SystemRoot键，取得如：C:\WINDOWS
◇[DELPHI]在FORM或其他容器上画线
var x,y:array [0..50] of integer;
canvas.pen.color:=clred;
canvas.pen.style:=psDash;
form1.canvas.moveto(trunc(x[i]),trunc(y[i]));
form1.canvas.lineto(trunc(x[j]),trunc(y[j]));
◇[DELPHI]字符串列表使用
var tips:tstringlist;
tips:=tstringlist.create;
tips.loadfromfile('filename.txt');
edit1.text:=tips[0];
tips.add('last line addition string');
tips.insert(1,'insert string at NO 2 line');
tips.savetofile('newfile.txt');
tips.free;
◇[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 ... //隐藏
◇[DELPHI]执行程序外文件
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);
◇[DELPHI]取得系统运行的进程名
var hCurrentWindow:HWnd;szText:array[0..254] of char;
begin
hCurrentWindow:=Getwindow(handle,GW_HWndFrist);
while hCurrentWindow <> 0 do
begin
if Getwindowtext(hcurrnetwindow,@sztext,255)>0 then listbox1.items.add(strpas(@sztext));
hCurrentWindow:=Getwindow(hCurrentwindow,GW_HWndNext);
end;
end;
◇[DELPHI]关于汇编的嵌入
Asm End;
可以任意修改EAX、ECX、EDX；不能修改ESI、EDI、ESP、EBP、EBX。
◇[DELPHI]关于类型转换函数
FloatToStr//浮点转字符串
FloatToStrF//带格式的浮点转字符串
IntToHex//整数转16进制
TimeToStr
DateToStr
DateTimeToStr
FmtStr//按指定格式输出字符串
FormatDateTime('YYYY-MM-DD,hh-mm-ss',DATE);
◇[DELPHI]字符串的过程和函数
Insert(obj,target,pos);//字符串target插入在pos的位置。如插入结果大于target最大长度，多出字符将被截掉
。如Pos在255以外，会产生运行错。例如，st:='Brian'，则Insert（'OK',st,2）会使st变为'BrOKian'。
Delete(st,pos,Num);//从st串中的pos（整型）位置开始删去个数为Num（整型）个字符的子字串。例
如，st:='Brian'，则Delete(st,3,2)将变为Brn。
Str(value,st);//将数值value（整型或实型）转换成字符串放在st中。例如，a=2.5E4时，则str(a:10,st)将使st的
值为' 25000'。
Val(st,var,code);//把字符串表达式st转换为对应整型或实型数值，存放在var中。St必须是一个表示数值的字符
串，并符合数值常数的规则。在转换过程中，如果没有检测出错误，变量code置为0，否则置为第一个出错字
符的位置。例如，st:=25.4E3,x是一个实型变量，则val(st,x,code)将使X值为25400，code值为0。
Copy(st.pos.num);//返回st串中一个位置pos（整型）处开始的，含有num（整型）个字符的子串。如果pos大
于st字符串的长度，那就会返回一个空串，如果pos在255以外，会引起运行错误。例
如，st:='Brian'，则Copy(st,2,2)返回'ri'。
Concat(st1,st2,st3……,stn);//把所有自变量表示出的字符串按所给出的顺序连接起来，并返回连接后的值。如
果结果的长度255，将产生运行错误。例如，st1:='Brian',st2:=' ',st3:='Wilfred'，则Concat(st1,st2,st3)返
回'Brian Wilfred'。
Length(st);//返回字符串表达式st的长度。例如，st:='Brian'，则Length(st)返回值为5。
Pos(obj,target);//返回字符串obj在目标字符串target的第一次出现的位置，如果target没有匹配的串，Pos函数
的返回值为0。例如，target:='Brian Wilfred'，则Pos('Wil',target)的返回值是7，Pos('hurbet',target)的返回值
是0。
◇[DELPHI]关于处理注册表
uses Registry;
var reg:Tregistry;
reg:=Tregistry.create;
reg.rootkey:='HKey_Current_User';
reg.openkey('Control Panel\Desktop',false);
reg.WriteString('Title Wallpaper','0');
reg.writeString('Wallpaper',filelistbox1.filename);
reg.closereg;
reg.free;
◇[DELPHI]关于键盘常量名
VK_BACK/VK_TAB/VK_RETURN/VK_SHIFT/VK_CONTROL/VK_MENU/VK_PAUSE/VK_ESCAPE
/VK_SPACE/VK_LEFT/VK_RIGHT/VK_UP/VK_DOWN
F1--F12：$70(112)--$7B(123)
A-Z：$41(65)--$5A(90)
0-9：$30(48)--$39(57)
◇[DELPHI]初步判断程序母语
DELPHI软件的DOS提示：This Program Must Be Run Under Win32.
VC++软件的DOS提示：This Program Cannot Be Run In DOS Mode.
◇[DELPHI]操作Cookie
response.cookies("name").domain:='http://www.086net.com';
with response.cookies.add do
begin
name:='username';
value:='username';
end
◇[DELPHI]增加到文档菜单连接
uses shellapi,shlOBJ;
shAddToRecentDocs(shArd_path,pchar(filepath));//增加连接
shAddToRecentDocs(shArd_path,nil);//清空
◇[杂类]备份智能ABC输入法词库
windows\system\user.rem
windows\system\tmmr.rem
◇[DELPHI]判断鼠标按键
if GetAsyncKeyState(VK_LButton)<>0 then ... //左键
if GetAsyncKeyState(VK_MButton)<>0 then ... //中键
if GetAsyncKeyState(VK_RButton)<>0 then ... //右键
◇[DELPHI]设置窗体的最大显示
onFormCreate事件
self.width:=screen.width;
self.height:=screen.height;
◇[DELPHI]按键接受消息
OnCreate事件中处理：Application.OnMessage:=MyOnMessage;
procedure TForm1.MyOnMessage(var MSG:TMSG;var Handle:Boolean);
begin
if msg.message=256 then ... //ANY键
if msg.message=112 then ... //F1
if msg.message=113 then ... //F2
end;
◇[杂类]隐藏共享文件夹
共享效果：可访问，但不可见（在资源管理、网络邻居中）
取共享名为：direction$
访问：//computer/dirction/
◇[Java Script]Java Script网页常用效果
网页60秒定时关闭
<script language="java script"><!--
settimeout('window.close();',60000)
--></script>
关闭窗口
<a href="/" οnclick="javascript:window.close();return false;">关闭</a>
定时转URL
<meta http-equiv="refresh" content="40;url=http://www.086net.com">
设为首页
<a
οnclick="this.style.behavior='url(#default#homepage)';this.sethomepage('http://086net.com');"href="#">设
为首页</a>
收藏本站
<a href="javascript:window.external.addfavorite('http://086net.com','[未名码头]')">收藏本站</a>
加入频道
<a href="javascript:window.external.addchannel('http://086net.com')">加入频道</a>
◇[DELPHI]文本编辑相关
checkbox1.checked:=not checkbox1.checked;
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsBold] else
richedit1.font.style:=richedit1.font.style-[fsBold]//粗体
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsItalic] else
richedit1.font.style:=richedit1.font.style-[fsItalic]//斜体
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsUnderline] else
richedit1.font.style:=richedit1.font.style-[fsUnderline]//下划线
memo1.alignment:=taLeftJustify;//居左
memo1.alignment:=taRightJustify;//居右
memo1.alignment:=taCenter;//居中
◇[DELPHI]随机产生文本色
randomize;//随机种子
memo1.font.color:=rgb(random(255),random(255),random(255));
◇[DELPHI]DELPHI5 UPDATE升级补丁序列号
1000003185
90X25fx0
◇[DELPHI]文件名的非法字符过滤
for i:=1 to length(s) do
if s[i] in ['\','/',':','*','?','<','>','|'] then
◇[DELPHI]转换函数的定义及说明
datetimetofiledate (datetime:Tdatetime):longint; 将Tdatetime格式的日期时间值转换成DOS格式的日期时间值
datetimetostr (datetime:Tdatetime):string; 将Tdatatime格式变量转换成字符串，如果datetime参数不包含日期
值，返回字符串日期显示成为00/00/00，如果datetime参数中没有时间值，返回字符串中的时间部分显示成为
00：00：00 AM
datetimetostring (var result string;
const format:string;
datetime:Tdatetime); 根据给定的格式字符串转换时间和日期值，result为结果字符串，format为转换格式字符
串，datetime为日期时间值
datetostr (date:Tdatetime) 使用shortdateformat全局变量定义的格式字符串将date参数转换成对应的字符串
floattodecimal (var result:Tfloatrec;value:
extended;precision,decimals:
integer); 将浮点数转换成十进制表示
floattostr (value:extended):string 将浮点数value转换成字符串格式，该转换使用普通数字格式，转换的有效位
数为15位。
floattotext (buffer:pchar;value:extended;
format:Tfloatformat;precision,
digits:integer):integer; 用给定的格式、精度和小数将浮点值value转换成十进制表示形式，转换结果存放
于buffer参数中，函数返回值为存储到buffer中的字符位数，buffer是非0结果的字符串缓冲区。
floattotextfmt (buffer:pchar;value:extended;
format:pchar):integer 用给定的格式将浮点值value转换成十进制表示形式，转换结果存放于buffer参数中，函
数返回值为存储到buffer中的字符位数。
inttohex (value:longint;digits:integer):
string; 将给定的数值value转换成十六进制的字符串。参数digits给出转换结果字符串包含的数字位数。
inttostr (value:longint):string 将整数转换成十进制形式字符串
strtodate (const S:string):Tdatetime 将字符串转换成日期值，S必须包含一个合法的格式日期的字符串。
strtodatetime (const S:string):Tdatetime 将字符串S转换成日期时间格式，S必须具有MM/DD/YY
HH：MM：SS[AM|PM]格式，其中日期和时间分隔符与系统时期时间常量设置相关。如果没有指定AM或PM信息
，表示使用24小时制。
strtofloat (const S:string):extended; 将给定的字符串转换成浮点数，字符串具有如下格式：
[+|-]nnn…[.]nnn…[<+|-><E|e><+|->nnnn]
strtoint (const S:string):longint 将数字字符串转换成整数，字符串可以是十进制或十六进制格式，如果字符串
不是一个合法的数字字符串，系统发生ECONVERTERROR异常
strtointdef (const S:string;default:
longint):longint; 将字符串S转换成数字，如果不能将S转换成数字，strtointdef函数返回参数default的值。
strtotime (const S:string):Tdatetime 将字符串S转换成TDATETIME值，S具有HH：MM：SS[AM|PM]格式，实际
的格式与系统的时间相关的全局变量有关。
timetostr (time:Tdatetime):string; 将参数TIME转换成字符串。转换结果字符串的格式与系统的时间相关常量的
设置有关。
◇[DELPHI]程序不出现在ALT+CTRL+DEL
在implementation后添加声明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏
RegisterServiceProcess(GetCurrentProcessID, 0);//显示
用ALT+DEL+CTRL看不见
◇[DELPHI]程序不出现在任务栏
uses windows
var
ExtendedStyle : Integer;
begin
Application.Initialize;
//==============================================================
ExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW
AND NOT WS_EX_APPWINDOW);
//===============================================================
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
◇[DELPHI]如何判断拨号网络是开还是关
if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then
showmessage('在线!')
else showmessage('不在线!');
◇[DELPHI]实现IP到域名的转换
function GetDomainName(Ip:string):string;
var
pH:PHostent;
data:twsadata;
ii:dword;
begin
WSAStartup($101, Data);
ii:=inet_addr(pchar(ip));
pH:=gethostbyaddr(@ii,sizeof(ii),PF_INET);
if (ph<>nil) then
result:=pH.h_name
else
result:='';
WSACleanup;
end;
◇[DELPHI]处理“右键菜单”方法
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey:=HKEY_CLASSES_ROOT;
reg.OpenKey('*\shell\check\command', true);
reg.WriteString('', '"' + application.ExeName + '" "%1"');
reg.CloseKey;
reg.OpenKey('*\shell\diary', false);
reg.WriteString('', '操作(&C)');
reg.CloseKey;
reg.Free;
showmessage('DONE!');
end;
◇[DELPHI]发送虚拟键值ctrl V
procedure sendpaste;
begin
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);
keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), 0, 0);
keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);
end;
◇[DELPHI]当前的光驱的盘符
procedure getcdrom(var cd:char);
var
str:string;
drivers:integer;
driver:char;
i,temp:integer;
begin
drivers:=getlogicaldrives;
temp:=(1 and drivers);
for i:=0 to 26 do
begin
if temp=1 then
begin
driver:=char(i+integer('a'));
str:=driver+':';
if getdrivetype(pchar(str))=drive_cdrom then
begin
cd:=driver;
exit;
end;
end;
drivers:=(drivers shr 1);
temp:=(1 and drivers);
end;
end;
◇[DELPHI]字符的加密与解密
function cryptstr(const s:string; stype: dword):string;
var
i: integer;
fkey: integer;
begin
result:='';
case stype of
0: setpass;
begin
randomize;
fkey := random($ff);
for i:=1 to length(s) do
result := result+chr( ord(s[i]) xor i xor fkey);
result := result + char(fkey);
end;
1: getpass
begin
fkey := ord(s[length(s)]);
for i:=1 to length(s) - 1 do
result := result+chr( ord(s[i]) xor i xor fkey);
end;
end;
□◇[DELPHI]向其他应用程序发送模拟键
var
h: THandle;
begin
h := FindWindow(nil, '应用程序标题');
PostMessage(h, WM_KEYDOWN, VK_F9, 0);//发送F9键
end;
□◇[DELPHI]DELPHI 支持的DAO数据格式
td.Fields.Append(td.CreateField ('dbBoolean',dbBoolean,0));
td.Fields.Append(td.CreateField ('dbByte',dbByte,0));
td.Fields.Append(td.CreateField ('dbInteger',dbInteger,0));
td.Fields.Append(td.CreateField ('dbLong',dbLong,0));
td.Fields.Append(td.CreateField ('dbCurrency',dbCurrency,0));
td.Fields.Append(td.CreateField ('dbSingle',dbSingle,0));
td.Fields.Append(td.CreateField ('dbDouble',dbDouble,0));
td.Fields.Append(td.CreateField ('dbDate',dbDate,0));
td.Fields.Append(td.CreateField ('dbBinary',dbBinary,0));
td.Fields.Append(td.CreateField ('dbText',dbText,0));
td.Fields.Append(td.CreateField ('dbLongBinary',dbLongBinary,0));
td.Fields.Append(td.CreateField ('dbMemo',dbMemo,0));
td.Fields['ID'].Set_Attributes(dbAutoIncrField);//自增字段
□◇[DELPHI]DELPHI配置MS SQL 7和BDE步骤
第一步，配置ODBC：
先在ODBC 中设数据源，安装过SQL Server7.0 后,ODBC中有一项"系统DSN"应该有两项
数据源，一个是MQIS，一个是LocalSever，任选一个选后点击配置按钮，不知你的SQL7.0
是不是安装在本地机器上，如果是的话直接进行下一步，如果不是，在服务器一栏中填上
Server,然后进行下一步，填写登录ID 和密码（登录ID，和密码是在SQL7.0中的用户选项
中设的）。
第二步，配置BDE:
打开Delphi的BDE，然后点击MQIS 或 LocalServer，就会提示用户名和密码，这和
ODBC的用户名和密码是一样的，填上就行了。
第三步，配置程序：
如果用的是TTable，就在TTable的DatabaseName中选择MQIS 或LocalServer,然后在
TableName中选择Sale就行了，然后将Active改为True,Delphi弹出提示对话，填入用户
名和密码。
如果用的是TQuery,在TQuery上点击右键，再击"SQL Builder"，这是以界面方式配置
SQL语句，或者在TQuery的SQL中填入SQL语句。最后，别忘了将Active改为True。
在运行也可能配置TQuery,具体见Delphi帮助。
□◇[DELPHI]得到图像上某一点的RGB值
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
red,green,blue:byte ;
i:integer;
begin
i:= image1.Canvas.Pixels[x,y];
Blue:= GetBValue(i);
Green:= GetGValue(i):
Red:= GetRValue(i);
Label1.Caption:=inttostr(Red);
Label2.Caption:=inttostr(Green);
Label3.Caption:=inttostr(Blue);
end;
□◇[DELPHI]关于日期格式分解转换
var year,month,day:word;now2:Tdatatime;
now2:=date();
decodedate(now2,year,month,day);
lable1.Text :=inttostr(year)+'年'+inttostr(month)+'月'+inttostr(day)+'日';
◇[DELPHI]如何判断当前网络连接方式
判断结果是MODEM、局域网或是代理服务器方式。
uses wininet;
Function ConnectionKind :boolean;
var flags: dword;
begin
Result := InternetGetConnectedState(@flags, 0);
if Result then
begin
if (flags and INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM then
begin
showmessage('Modem');
end;
if (flags and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then
begin
showmessage('LAN');
end;
if (flags and INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY then
begin
showmessage('Proxy');
end;
if (flags and INTERNET_CONNECTION_MODEM_BUSY)=INTERNET_CONNECTION_MODEM_BUSY then
begin
showmessage('Modem Busy');
end;
end;
end;
◇[DELPHI]如何判断字符串是否是有效EMAIL地址
function IsEMail(EMail: String): Boolean;
var s: String;ETpos: Integer;
begin
ETpos:= pos('@', EMail);
if ETpos > 1 then
begin
s:= copy(EMail,ETpos+1,Length(EMail));
if (pos('.', s) > 1) and (pos('.', s) < length(s)) then
Result:= true else Result:= false;
end
else
Result:= false;
end;
◇[DELPHI]判断系统是否连接INTERNET
需要引入URL.DLL中的InetIsOffline函数。
函数申明为：
function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';
然后就可以调用函数判断系统是否连接到INTERNET
if InetIsOffline(0) then ShowMessage('not connected!')
else ShowMessage('connected!');
该函数返回TRUE如果本地系统没有连接到INTERNET。
附：
大多数装有IE或OFFICE97的系统都有此DLL可供调用。
InetIsOffline
BOOL InetIsOffline(
DWORD dwFlags,
);
◇[DELPHI]简单地播放和暂停WAV文件
uses mmsystem;
function PlayWav(const FileName: string): Boolean;
begin
Result := PlaySound(PChar(FileName), 0, SND_ASYNC);
end;
procedure StopWav;
var
buffer: array[0..2] of char;
begin
buffer[0] := #0;
PlaySound(Buffer, 0, SND_PURGE);
end;
◇[DELPHI]取机器BIOS信息
with Memo1.Lines do
begin
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
end;
◇[DELPHI]网络下载文件
uses UrlMon;
function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result := False;
end;
end;
if DownloadFile('http://www.borland.com/delphi6.zip, 'c:\kylix.zip') then
ShowMessage('Download succesful')
else ShowMessage('Download unsuccesful')
◇[DELPHI]解析服务器IP地址
uses winsock
function IPAddrToName(IPAddr : String): String;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt<>nil then result:=StrPas(Hostent^.h_name) else result:='';
end;
◇[DELPHI]取得快捷方式中的连接
function ExeFromLink(const linkname: string): string;
var
FDir,
FName,
ExeName: PChar;
z: integer;
begin
ExeName:= StrAlloc(MAX_PATH);
FName:= StrAlloc(MAX_PATH);
FDir:= StrAlloc(MAX_PATH);
StrPCopy(FName, ExtractFileName(linkname));
StrPCopy(FDir, ExtractFilePath(linkname));
z:= FindExecutable(FName, FDir, ExeName);
if z > 32 then
Result:= StrPas(ExeName)
else
Result:= '';
StrDispose(FDir);
StrDispose(FName);
StrDispose(ExeName);
end;
◇[DELPHI]控制TCombobox的自动完成
{'Sorted' property of the TCombobox to true }
var lastKey: Word; //全局变量
//TCombobox的OnChange事件
procedure TForm1.AutoCompleteChange(Sender: TObject);
var
SearchStr: string;
retVal: integer;
begin
SearchStr := (Sender as TCombobox).Text;
if lastKey <> VK_BACK then // backspace: VK_BACK or $08
begin
retVal := (Sender as TCombobox).Perform(CB_FINDSTRING, -1, LongInt(PChar(SearchStr)));
if retVal > CB_Err then
begin
(Sender as TCombobox).ItemIndex := retVal;
(Sender as TCombobox).SelStart := Length(SearchStr);
(Sender as TCombobox).SelLength :=
(Length((Sender as TCombobox).Text) - Length(SearchStr));
end; // retVal > CB_Err
end; // lastKey <> VK_BACK
lastKey := 0; // reset lastKey
end;
//TCombobox的OnKeyDown事件
procedure TForm1.AutoCompleteKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
lastKey := Key;
end;
◇[DELPHI]如何清空一个目录
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean) :
Boolean;
var
SearchRec : TSearchRec;
Res : Integer;
begin
Result := False;
TheDirectory := NormalDir(TheDirectory);
Res := FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec);
try
while Res = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if ((SearchRec.Attr and faDirectory) > 0) and Recursive
then begin
EmptyDirectory(TheDirectory + SearchRec.Name, True);
RemoveDirectory(PChar(TheDirectory + SearchRec.Name));
end
else begin
DeleteFile(PChar(TheDirectory + SearchRec.Name))
end;
end;
Res := FindNext(SearchRec);
end;
Result := True;
finally
FindClose(SearchRec.FindHandle);
end;
end;
◇[DELPHI]如何计算一个目录的大小
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;
◇[DELPHI]安装程序如何添加到Uninstall列表
操作注册表，如下：
1.在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall键下建立一个主键，名
称任意。
例HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyUninstall
2.在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyUnistall下键两个串值
，
这两个串值的名称是特定的：DisplayName和UninstallString。
3.给串DisplayName赋值为显示在“删除应用程序列表”中的名称，如'Aiming Uninstall one';
给串UninstallString赋值为执行的删除命令，如 C:\WIN97\uninst.exe -f"C:\TestPro\aimTest.isu"
◇[DELPHI]截获WM_QUERYENDSESSION关机消息
type
TForm1 = class(TForm)
procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
procedure CMEraseBkgnd(var Message:TWMEraseBkgnd);Message WM_ERASEBKGND;
private
{ Private declarations }
public
{ Public declarations }
end;
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
Showmessage('computer is about to shut down');
end;
◇[DELPHI]获取网上邻居
procedure getnethood();//NT做服务器，WIN98上调试通过。
var
a,i:integer;
errcode:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries:dword;
buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
alldomain:tstrings;
begin //listcomputer is a listview to list all computers;controlcenter is a form.
alldomain:=tstringlist.Create ;
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_DOMAIN;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=nil;
lpcomment :=nil;
lpprovider :=nil;
end; // 获取所有的域
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@
netres[0],enumhandle);
if errcode=NO_ERROR then begin
enumentries:=1024;
buffersize:=sizeof(netres);
errcode:=wnetenumresource(enumhandle,enumentries,@netres[0],buffersize);
end;
a:=0;
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
alldomain.Add (netres[a].lpremotename);
a:=a+1;
end;
wnetcloseenum(enumhandle);
// 获取所有的计算机
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
for i:=0 to alldomain.Count-1 do
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SERVER;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(alldomain[i]);
lpcomment :=nil;
lpprovider :=nil;
end;
ErrCode:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,
@netres[0],EnumHandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
a:=0;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
mylistitem :=mylistitems.Add ;
mylistitem.ImageIndex :=0;
mylistitem.Caption :=uppercase(stringreplace(string(NetRes[a].lpremotename),'\\','',[rfReplaceAll]));
a:=a+1;
end;
wnetcloseenum(enumhandle);
end;
end;
◇[DELPHI]获取某一计算机上的共享目录
procedure getsharefolder(const computername:string);
var
errcode,a:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries,buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
mystrings:tstringlist;
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_DISK;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SHARE;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(computername);
lpcomment :=nil;
lpprovider :=nil;
end; // 获取根结点
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,
@netres[0],enumhandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
wnetcloseenum(enumhandle);
a:=0;
mylistitems:=controlcenter.lstfile.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
with mylistitems do
begin
mylistitem:=add;
mylistitem.ImageIndex :=4;
mylistitem.Caption :=extractfilename(netres[a].lpremotename);
end;
a:=a+1;
end;
end;
◇[DELPHI]得到硬盘序列号
var SerialNum : pdword; a, b : dword; Buffer : array [0..255] of char;
begin
if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then Label1.Caption :=
IntToStr(SerialNum^);
end;
◇[DELPHI]MEMO的自动翻页
Procedure ScrollMemo(Memo : TMemo; Direction : char);
begin
case direction of
'd': begin
SendMessage(Memo.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEDOWN, { Scroll Command }
0) { Not Used }
end;
'u' : begin
SendMessage(Memo.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEUP, { Scroll Command }
0); { Not Used }
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ScrollMemo(Memo1,'d'); //上翻页
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ScrollMemo(Memo1,'u'); //下翻页
end;
◇[DELPHI]DBGrid中回车到下个位置(Tab键)
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if DBGrid1.Columns.Grid.SelectedIndex < DBGrid1.Columns.Count - 1 then
DBGrid1.Columns[DBGrid1.Columns.grid.SelectedIndex + 1].Field.FocusControl
else
begin
Table1.next;
DBGrid1.Columns[0].field.FocusControl;
end;
end;
◇[DELPHI]如何安装控件
安装方法：
1.对于单个控件，Component-->install component..-->PAS或DCU文件-->install
2.对于带*.dpk文件的控件包，File-->open(下拉列表框中选*.dpk)-->install即可.
3.对于带*.dpl文件的控件包，Install Packages-->Add-->dpl文件名即可。
4.如果以上Install按钮为失效的话，试试Compile按钮。
5.是run time lib则在option下的packages下的runtimepackes加之.
如果编译时提示文件找不到的话，一般是控件的安装目录不在delphi的Lib目录中，有两种方法可以解决：
1.把安装的原文件拷入到delphi的Lib目录下。
2.或者Tools-->Environment Options中把控件原代码路径加入到Delphi的Lib目录中即可。
◇[DELPHI]目录完全删除（deltree）
procedure TForm1.DeleteDirectory(strDir:String);
var
sr: TSearchRec;
FileAttrs: Integer;
strfilename:string;
strPth:string;
begin
strpth:=Getcurrentdir();
FileAttrs := faAnyFile;
if FindFirst(strpth+'\'+strdir+'\*.*', FileAttrs, sr) = 0 then
begin
if (sr.Attr and FileAttrs) = sr.Attr then
begin
strfilename:=sr.Name;
if fileexists(strpth+'\'+strdir+'\'+strfilename) then
deletefile(strpth+'\'+strdir+'\'+strfilename);
end;
while FindNext(sr) = 0 do
begin
if (sr.Attr and FileAttrs) = sr.Attr then
begin
strfilename:=sr.name;
if fileexists(strpth+'\'+strdir+'\'+strfilename) then
deletefile(strpth+'\'+strdir+'\'+strfilename);
end;
end;
FindClose(sr);
removedir(strpth+'\'+strdir);
end;
end;
◇[DELPHI]取得TMemo 控件当前光标的行和列信息到Tpoint中
1.function ReadCursorPos(SourceMemo: TMemo): TPoint;
var Point: TPoint;
begin
point.y := SendMessage(SourceMemo.Handle,EM_LINEFROMCHAR,SourceMemo.SelStart,0);
point.x := SourceMemo.SelStart-SendMessage(SourceMemo.Handle,EM_LINEINDEX,point.y,0);
Result := Point;
end;
2.LineLength：=SendMessage（memol．handle，EM—LINELENGTH，Cpos，0）；//行长
◇[DELPHI]读硬盘序列号
function GetDiskSerial(DiskChar: Char): string;
var
SerialNum : pdword;
a, b : dword;
Buffer : array [0..255] of char;
begin
result := "";
if GetVolumeInformation(PChar(diskchar+":\"), Buffer, SizeOf(Buffer), SerialNum,
a, b, nil, 0) then
Result := IntToStr(SerialNum^);
end;
◇[INTERNET]CSS常用综合技巧
1。P:first-letter { font-size: 300%; float: left }//首字会比普通字体加大三倍。
2。<LINK REL=StyleSheet HREF="basics.css" TITLE="Contemporary">//连接一个外部样式表
3。嵌入一个样式表
<STYLE TYPE="text/css" MEDIA=screen>
<!--
@import url(http://www.htmlhelp.com/style.css);//外部导入一个样式表
@import url(/stylesheets/punk.css);//同上
BODY { background: url(foo.gif) red; color: black }
.punk { color: lime; background: #ff80c0 }//引用见5。
#wdg97 { font-size: larger }//引用见6。
-->
</STYLE>
4。<P STYLE="color: red; font-family: 'New Century Schoolbook', serif"> //内联样式
<SPAN STYLE="font-family: Arial">Arial</SPAN>//SPAN接受STYLE、CLASS和ID属性
<DIV CLASS=note><P>DIV可以包含段落、标题、表格甚至其它部分</P></DIV>
5。<H1 CLASS=punk>CLASS属性</H1>//定义见3。
6。<P ID=wdg97>ID属性</P>//定义见3。
7。属性列表
字体风格：font-style: [normal | italic | oblique];
字体大小：font-size: [xx-small | x-small | small | medium | large | x-large | xx-large | larger | smaller | <长度>
| <百分比>]
文本修饰：text-decoration:[ underline || overline || line-through || blink ]
文本转换：text-transform:[none | capitalize | uppercase | lowercase]
背景颜色：background-color:[<颜色> | transparent]
背景图象：background-image:[<URLs> | none]
行高：line-height: [normal | <数字> | <长度> | <百分比>]
边框样式：border-style: [ none | dotted | dashed | solid | double | groove | ridge | inset | outset ]
漂浮：float: [left | right | none]
8。长度单位
相对单位：
em (em，元素的字体的高度)
ex (x-height，字母 "x" 的高度)
px (像素，相对于屏幕的分辨率)
绝对长度：
in (英寸，1英寸=2.54厘米)
cm (厘米，1厘米=10毫米)
mm (米)
pt (点，1点=1/72英寸)
pc (帕，1帕=12点)
◇[DELPHI]VCL制作简要步骤
1.创建部件属性方法事件
（建立库单元，继承为新的类型，添加属性、方法、事件，注册部件，建立包文件）
2.消息处理
3.异常处理
4.部件可视
◇[DELPHI]动态连接库的装载
静态装载：procedure name;external 'lib.dll';
动态装载：var handle:Thandle;
handle:=loadlibrary('lib.dll');
if handle<>0 then
begin
{dosomething}
freelibrary(handle);
end;
◇[DELPHI]指针变量和地址
var x,y:integer;p:^integer;//指向INTEGER变量的指针
x:=10;//变量赋值
p:=@x;//变量x的地址
y:=p^;//为Y赋值指针P
@@procedure//返回过程变量的内存地址
◇[DELPHI]判断字符是汉字的一个字符
ByteType('你好haha吗',1) = mbLeadByte//是第一个字符
ByteType('你好haha吗',2) = mbTrailByte//是第二个字符
ByteType('你好haha吗',5) = mbSingleByte//不是中文字符
◇[DELPHI]memo的定位操作
memo1.lines.delete(0)//删除第1行
memo1.selstart:=10//定位10字节处
◇[DELPHI]获得双字节字符内码
function getit(s: string): integer;
begin
Result := byte(s[1]) * $100 + byte(s[2]);
end;
使用：getit('计')//$bcc6 即十进制 48326
◇[DELPHI]调用ADD数据存储过程
存储过程如下：
create procedure addrecord(
record1 varchar(10)
record2 varchar(20)
)
as
begin
insert into tablename (field1,field2) values(:record1,:record2)
end
执行存储过程：
EXECUTE procedure addrecord("urrecord1","urrecord2")
◇[DELPHI]将文件存到blob字段中
function blobcontenttostring(const filename: string):string;
begin
with tfilestream.create(filename,fmopenread) do
try
setlength(Result,size);
read(Pointer(Result)^,size);
finally
free;
end;
end;
//保存字段
begin
if (opendialog1.execute) then
begin
sFileName:=OpenDialog1.FileName;
adotable1.edit;
adotable1.fieldbyname('visio').asstring:=Blobcontenttostring(FileName);
adotable1.post;
end;
◇[DELPHI]把文件全部复制到剪贴板
uses shlobj,activex,clipbrd;
procedure Tform1.copytoclipbrd(var FileName:string);
var
FE:TFormatEtc;
Medium: TStgMedium;
dropfiles:PDropFiles;
pFile:PChar;
begin
FE.cfFormat := CF_HDROP;
FE.dwAspect := DVASPECT_CONTENT;
FE.tymed := TYMED_HGLOBAL;
Medium.hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TDropFiles)+length(FileName)+1);
if Medium.hGlobal<>0 then begin
Medium.tymed := TYMED_HGLOBAL;
dropfiles := GlobalLock(Medium.hGlobal);
try
dropfiles^.pfiles := SizeOf(TDropFiles);
dropfiles^.fwide := False;
longint(pFile) := longint(dropfiles)+SizeOf(TDropFiles);
StrPCopy(pFile,FileName);
Inc(pFile, Length(FileName)+1);
pFile^ := #0;
finally
GlobalUnlock(Medium.hGlobal);
end;
Clipboard.SetAsHandle(CF_HDROP,Medium.hGlobal);
end;
end;
◇[DELPHI]列举当前系统运行进程
uses TLHelp32;
procedure TForm1.Button1Click(Sender: TObject);
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
begin
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found := Process32First(Hand,lppe);
while found do
begin
ListBox1.Items.Add(StrPas(lppe.szExeFile));
found := Process32Next(Hand,lppe);
end;
end;
◇[DELPHI]根据BDETable1建立新表Table2
Table2:=TTable.Create(nil);
try
Table2.DatabaseName:=Table1.DatabaseName;
Table2.FieldDefs.Assign(Table1.FieldDefs);
Table2.IndexDefs.Assign(Table1.IndexDefs);
Table2.TableName:='new_table';
Table2.CreateTable();
finally
Table2.Free();
end;
◇[DELPHI]最菜理解DLL建立和引用
//先看DLL source(FILE-->NEW-->DLL)
library project1;
uses
SysUtils, Classes;
function addit(f:integer;s:integer):integer;export;
begin
makeasum:=f+s;
end;
exports
addit;
end.
//调用(IN ur PROJECT)
implementation
function addit(f:integer;s:integer):integer;far;external 'project1';//申明
{调用就是addit(2,4);结果显示6}
◇[DELPHI]动态读取程序自身大小
function GesSelfSize: integer;
var
f: file of byte;
begin
filemode := 0;
assignfile(f, application.exename);
reset(f);
Result := filesize(f);//单位是字节
closefile(f);
end;
◇[DELPHI]读取BIOS信息
with Memo1.Lines do
begin
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
end;
◇[DELPHI]动态建立MSSQL别名
procedure TForm1.Button1Click(Sender: TObject);
var MyList: TStringList;
begin
MyList := TStringList.Create;
try
with MyList do
begin
Add('SERVER NAME=210.242.86.2');
Add('DATABASE NAME=db');
Add('USER NAME=sa');
end;
Session1.AddAlias('TESTSQL', 'MSSQL', MyList); //ミMSSQL
Session1.SaveConfigFile;
finally
MyList.Free;
Session1.Active:=True;
Database1.DatabaseName:='DB';
Database1.AliasName:='TESTSQL';
Database1.LoginPrompt:=False;
Database1.Params.Add('USER NAME=sa');
Database1.Params.Add('PASSWORD=');
Database1.Connected:=True;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Database1.Connected:=False;
Session1.DeleteAlias('TESTSQL');
end;
◇[DELPHI]播放背景音乐
uses mmsystem
//播放音乐
MCISendString('OPEN e:\1.MID TYPE SEQUENCER ALIAS NN', '', 0, 0);
MCISendString('PLAY NN FROM 0', '', 0, 0);
MCISendString('CLOSE ANIMATION', '', 0, 0);
end;
//停止播放
MCISendString('OPEN e:\1.MID TYPE SEQUENCER ALIAS NN', '', 0, 0);
MCISendString('STOP NN', '', 0, 0);
MCISendString('CLOSE ANIMATION', '', 0, 0);
◇[DELPHI]接口和类的一个范例代码
Type{接口和类申明：区别在于不能在接口中申明数据成员、任何非公有的方法、公共方法不使用PUBLIC关键
字}
Isample=interface//定义Isample接口
function getstring:string;
end;
Tsample=class(TInterfacedObject,Isample)
public
function getstring:string;
end;
//function定义
function Tsample.getstring:string;
begin
result:='what show is ';
end;
//调用类对象
var sample:Tsample;
begin
sample:=Tsample.create;
showmessage(sample.getstring+'class object!');
sample.free;
end;
//调用接口
var sampleinterface:Isample;
sample:Tsample;
begin
sample:=Tsample.create;
sampleInterface:=sample;//Interface的实现必须使用class
{以上两行也可表达成sampleInterface:=Tsample.create;}
showmessage(sampleInterface.getstring+'Interface!');
//sample.free;{和局部类不同，Interface中的类自动释放}
sampleInterface:=nil;{释放接口对象}
end;
◇[DELPHI]任务条就看不当程序
var
ExtendedStyle : Integer;
begin
Application.Initialize;
ExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW AND NOT
WS_EX_APPWINDOW);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
◇[DELPHI]ALT+CTRL+DEL看不到程序
在implementation后添加声明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏
RegisterServiceProcess(GetCurrentProcessID, 0);//显示
◇[DELPHI]检测光驱符号
var drive:char;
cdromID:integer;
begin
for drive:='d' to 'z' do
begin
cdromID:=GetDriveType(pchar(drive+':\'));
if cdromID=5 then showmessage('你的光驱为:'+drive+'盘!');
end;
end;
◇[DELPHI]检测声卡
if auxGetNumDevs()<=0 then showmessage('No soundcard found!') else showmessage('Any soundcard
found!');
◇[DELPHI]在字符串网格中画图
StringGrid.OnDrawCell事件
with StringGrid1.Canvas do
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
◇[SQL SERVER]SQL中代替Like语句的另一种写法
比如查找用户名包含有"c"的所有用户, 可以用
use mydatabase
select * from table1 where username like'%c%"
下面是完成上面功能的另一种写法:
use mydatabase
select * from table1 where charindex('c',username)>0
这种方法理论上比上一种方法多了一个判断语句,即>0, 但这个判断过程是最快的, 我想信80%以上的运算都是
花在查找字
符串及其它的运算上, 所以运用charindex函数也没什么大不了. 用这种方法也有好处, 那就是对%,|等在不能直
接用like
查找到的字符中可以直接在这charindex中运用, 如下:
use mydatabase
select * from table1 where charindex('%',username)>0
也可以写成:
use mydatabase
select * from table1 where charindex(char(37),username)>0
ASCII的字符即为%
◇[DELPHI]SQL显示多数据库/表
SELECT DISTINCT A.bianhao,a.xingming, b.gongzi FROM "jianjie.dbf" a, "gongzi.DBF" b
WHERE A.bianhao=b.bianhao
◇[DELPHI]RFC(Request For Comment)相关
IETF(Internet Engineering Task Force)维护RFC文档http://www.ietf.cnri.reston.va.us
RFC882：报文头标结构
RFC1521：MIME第一部分，传输报文方法
RFC1945：多媒体文档传输文档
◇[DELPHI]TNMUUProcessor的使用
var inStream,outStream:TFileStream;
begin
inStream:=TFileStream.create(infile.txt,fmOpenRead);
outStream:=TFileStream(outfile.txt,fmCreate);
NMUUE.Method:=uuCode;{UUEncode/Decode}
//NMUUE.Method:=uuMIME;{MIME}
NMUUE.InputStream:=InStream;
NMUUE.OutputStream:=OutStream;
NMUUE.Encode;{编码处理}
//NMUUE.Decode;{解码处理}
inStream.free;
outStream.free;
end;
◇[DELPHI]TFileStream的操作
//从文件流当前位置读count字节到缓冲区BUFFER
function read(var buffer;count:longint):longint;override;
//将缓冲区BUFFER读到文件流中
function write(const buffer;count:longint):longint;override;
//设置文件流当前读写指针为OFFSET
function seek(offset:longint;origin:word):longint;override;
origin={soFromBeginning,soFromCurrent,soFromEnd}
//从另一文件流中当前位置复制COUNT到当前文件流当前位置
function copyfrom(source:TStream;count:longint):longint;
//读指定文件到文件流
var myFStream:TFileStream;
begin
myFStream:=TFileStream.create(OpenDialog1.filename,fmOpenRead);
end;
[JavaScript]检测是否安装IE插件Shockwave&Quicktime
<script LANGUAGE="JavaScript">
var myPlugin = navigator.plugins["Shockwave"];
if (myPlugin)
document.writeln("你已经安装了 Shockwave!")
else
document.writeln("你尚未安装 Shockwave!")
</script><br>
<script LANGUAGE="JavaScript">
var myPlugin = navigator.plugins["Quicktime"];
if (myPlugin)
document.writeln("你已经安装了Quicktime!")
else
document.writeln("你尚未安装 Quicktime!")
</script>
[INTERNET]表格中引用IFRAME效果
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td><ILAYER id="ad1" visibility="hidden" height="60"></ILAYER> <NOLAYER> <IFRAME
SRC="i:\jinhtml\zj\h21.htm" width="500" height="200" marginwidth="0" marginheight="110" hspace="10"
vspace="20" frameborder="0" scrolling="1"></IFRAME> </NOLAYER> </td>
</tr>
</table>
◇[DELPHI]WebBrowser控件技巧
1。实现打印功能
var vaIn, vaOut: OleVariant;
WebBrowser.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, vaIn,
vaOut);
2。WebBrowser从流中读取页面
function TForm1.LoadFromStream(const AStream: TStream): HRESULT;
begin
AStream.seek(0, 0);
Result := (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(AStream));
end;
3。"about:" protocol will let you Navigate to an HTML string:
procedure TForm1.LoadHTMLString(sHTML: String);
var Flags, TargetFrameName, PostData, Headers: OleVariant;
WebBrowser1.Navigate('about:' + sHTML, Flags, TargetFrameName, PostData, Headers)
4。"res:" protocol will let you Navigate to an HTML file stored as a resource. More informations is available from
the Microsoft site:
procedure TForm1.LoadHTMLResource;
var Flags, TargetFrameName, PostData, Headers: OleVariant;
WebBrowser1.Navigate('res://' + Application.ExeName + '/myhtml', Flags, TargetFrameName, PostData,
Headers)
使用brcc32.exe建立资源文件 (*.rc)
MYHTML 23 ".\html\myhtml.htm"
MOREHTML 23 ".\html\morehtml.htm"
{$R HTML.RES} //html.rc被编译成html.res
5。保存完整的HTML文件
var
HTMLDocument: IHTMLDocument2;
PersistFile: IPersistFile;
begin
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
PersistFile := HTMLDocument as IPersistFile;
PersistFile.Save(StringToOleStr('test.htm'), True);
while HTMLDocument.readyState <> 'complete' do
Application.ProcessMessages;
end;
◇[DELPHI]安装WebBrowser控件（内嵌IE控件）
你必须先确定系统已安装Internet Explorer4或以后版本，DELPHI菜单--Component- - Import ActiveX Contro
，列表中选择Microsoft Internet Controls"并ADD到一个已存在的包文件中，WebBrowser控件将显示在ActiveX
控件面板。
◇[DELPHI]实现windows2000半透明窗体
function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint;
stdcall; external user32;//函数声明
procedure TForm1.FormCreate(Sender: TObject);
var l:longint;
begin
l:=getWindowLong(Handle, GWL_EXSTYLE);
l := l Or $80000;
SetWindowLong (handle, GWL_EXSTYLE, l);
SetLayeredWindowAttributes(handle, 0, 180, 2);
end;
◇[DELPHI]程序显示广告WebBrowser加载图片
var Flag, frame, pData, Header: OLEVariant;
begin
WebBrowser1.Navigate('http://www.chineseall.com/images/logo.jpg', flag, frame,pData, Header)
end;
◇[DELPHI]计算一个目录的大小
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;
◇[DELPHI]清空一个目录
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean) :
Boolean;
var
SearchRec : TSearchRec;
Res : Integer;
begin
Result := False;
TheDirectory := NormalDir(TheDirectory);
Res := FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec);
try
while Res = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if ((SearchRec.Attr and faDirectory) > 0) and Recursive
then begin
EmptyDirectory(TheDirectory + SearchRec.Name, True);
RemoveDirectory(PChar(TheDirectory + SearchRec.Name));
end
else begin
DeleteFile(PChar(TheDirectory + SearchRec.Name))
end;
end;
Res := FindNext(SearchRec);
end;
Result := True;
finally
FindClose(SearchRec.FindHandle);
end;
end;
◇[DELPHI]发布ADO程序之安装ADO
运行一次 MDac_typ.exe ，这个文件在微软的 Windows、IE、Office、Visual Studio 中都有。
安装程序所安装后的目录与程序中设置的目录路径一样，C:\Program Files\Common Files\System\ado文件夹
中有没有ADO组件，装ACCESS2000就有ADO2.1，没有则安装MS OFfice2000，编译要去
掉project->Option->Packages对话框中的Build With RunTime Library的勾。
◇[DELPHI]拦截Windows系统消息：WM_CLOSE消息
procedure WMClose(var Msg: TMessage);message WM_CLOSE;
procedure TMainForm.WMClose(var Msg: TMessage);
begin
m_bCloseNoQuery := false;
inherited;
end;
十九、API的使用技巧
先人的DELPHI基础开发技巧
整理：房客 来源：大富翁论坛
◇[DELPHI]网络邻居复制文件
uses shellapi;
copyfile(pchar('newfile.txt'),pchar('//computername/direction/targer.txt'),false);
◇[DELPHI]产生鼠标拖动效果
通过MouseMove事件、DragOver事件、EndDrag事件实现，例如在PANEL上的LABEL：
var xpanel,ypanel,xlabel,ylabel:integer;
PANEL的MouseMove事件：xpanel:=x;ypanel:=y;
PANEL的DragOver事件：xpanel:=x;ypanel:=y;
LABEL的MouseMove事件：xlabel:=x;ylabel:=y;
LABEL的EndDrag事件：label.left:=xpanel-xlabel;label.top:=ypanel-ylabel;
◇[DELPHI]取得WINDOWS目录
uses shellapi;
var windir:array[0..255] of char;
getwindowsdirectory(windir,sizeof(windir));
或者从注册表中读取，位置：
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion
SystemRoot键，取得如：C:\WINDOWS
◇[DELPHI]在FORM或其他容器上画线
var x,y:array [0..50] of integer;
canvas.pen.color:=clred;
canvas.pen.style:=psDash;
form1.canvas.moveto(trunc(x[i]),trunc(y[i]));
form1.canvas.lineto(trunc(x[j]),trunc(y[j]));
◇[DELPHI]字符串列表使用
var tips:tstringlist;
tips:=tstringlist.create;
tips.loadfromfile('filename.txt');
edit1.text:=tips[0];
tips.add('last line addition string');
tips.insert(1,'insert string at NO 2 line');
tips.savetofile('newfile.txt');
tips.free;
◇[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 ... //隐藏
◇[DELPHI]执行程序外文件
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);
◇[DELPHI]取得系统运行的进程名
var hCurrentWindow:HWnd;szText:array[0..254] of char;
begin
hCurrentWindow:=Getwindow(handle,GW_HWndFrist);
while hCurrentWindow <> 0 do
begin
if Getwindowtext(hcurrnetwindow,@sztext,255)>0 then listbox1.items.add(strpas(@sztext));
hCurrentWindow:=Getwindow(hCurrentwindow,GW_HWndNext);
end;
end;
◇[DELPHI]关于汇编的嵌入
Asm End;
可以任意修改EAX、ECX、EDX；不能修改ESI、EDI、ESP、EBP、EBX。
◇[DELPHI]关于类型转换函数
FloatToStr//浮点转字符串
FloatToStrF//带格式的浮点转字符串
IntToHex//整数转16进制
TimeToStr
DateToStr
DateTimeToStr
FmtStr//按指定格式输出字符串
FormatDateTime('YYYY-MM-DD,hh-mm-ss',DATE);
◇[DELPHI]字符串的过程和函数
Insert(obj,target,pos);//字符串target插入在pos的位置。如插入结果大于target最大长度，多出字符将被截掉
。如Pos在255以外，会产生运行错。例如，st:='Brian'，则Insert（'OK',st,2）会使st变为'BrOKian'。
Delete(st,pos,Num);//从st串中的pos（整型）位置开始删去个数为Num（整型）个字符的子字串。例
如，st:='Brian'，则Delete(st,3,2)将变为Brn。
Str(value,st);//将数值value（整型或实型）转换成字符串放在st中。例如，a=2.5E4时，则str(a:10,st)将使st的
值为' 25000'。
Val(st,var,code);//把字符串表达式st转换为对应整型或实型数值，存放在var中。St必须是一个表示数值的字符
串，并符合数值常数的规则。在转换过程中，如果没有检测出错误，变量code置为0，否则置为第一个出错字
符的位置。例如，st:=25.4E3,x是一个实型变量，则val(st,x,code)将使X值为25400，code值为0。
Copy(st.pos.num);//返回st串中一个位置pos（整型）处开始的，含有num（整型）个字符的子串。如果pos大
于st字符串的长度，那就会返回一个空串，如果pos在255以外，会引起运行错误。例
如，st:='Brian'，则Copy(st,2,2)返回'ri'。
Concat(st1,st2,st3……,stn);//把所有自变量表示出的字符串按所给出的顺序连接起来，并返回连接后的值。如
果结果的长度255，将产生运行错误。例如，st1:='Brian',st2:=' ',st3:='Wilfred'，则Concat(st1,st2,st3)返
回'Brian Wilfred'。
Length(st);//返回字符串表达式st的长度。例如，st:='Brian'，则Length(st)返回值为5。
Pos(obj,target);//返回字符串obj在目标字符串target的第一次出现的位置，如果target没有匹配的串，Pos函数
的返回值为0。例如，target:='Brian Wilfred'，则Pos('Wil',target)的返回值是7，Pos('hurbet',target)的返回值
是0。
◇[DELPHI]关于处理注册表
uses Registry;
var reg:Tregistry;
reg:=Tregistry.create;
reg.rootkey:='HKey_Current_User';
reg.openkey('Control Panel\Desktop',false);
reg.WriteString('Title Wallpaper','0');
reg.writeString('Wallpaper',filelistbox1.filename);
reg.closereg;
reg.free;
◇[DELPHI]关于键盘常量名
VK_BACK/VK_TAB/VK_RETURN/VK_SHIFT/VK_CONTROL/VK_MENU/VK_PAUSE/VK_ESCAPE
/VK_SPACE/VK_LEFT/VK_RIGHT/VK_UP/VK_DOWN
F1--F12：$70(112)--$7B(123)
A-Z：$41(65)--$5A(90)
0-9：$30(48)--$39(57)
◇[DELPHI]初步判断程序母语
DELPHI软件的DOS提示：This Program Must Be Run Under Win32.
VC++软件的DOS提示：This Program Cannot Be Run In DOS Mode.
◇[DELPHI]操作Cookie
response.cookies("name").domain:='http://www.086net.com';
with response.cookies.add do
begin
name:='username';
value:='username';
end
◇[DELPHI]增加到文档菜单连接
uses shellapi,shlOBJ;
shAddToRecentDocs(shArd_path,pchar(filepath));//增加连接
shAddToRecentDocs(shArd_path,nil);//清空
◇[杂类]备份智能ABC输入法词库
windows\system\user.rem
windows\system\tmmr.rem
◇[DELPHI]判断鼠标按键
if GetAsyncKeyState(VK_LButton)<>0 then ... //左键
if GetAsyncKeyState(VK_MButton)<>0 then ... //中键
if GetAsyncKeyState(VK_RButton)<>0 then ... //右键
◇[DELPHI]设置窗体的最大显示
onFormCreate事件
self.width:=screen.width;
self.height:=screen.height;
◇[DELPHI]按键接受消息
OnCreate事件中处理：Application.OnMessage:=MyOnMessage;
procedure TForm1.MyOnMessage(var MSG:TMSG;var Handle:Boolean);
begin
if msg.message=256 then ... //ANY键
if msg.message=112 then ... //F1
if msg.message=113 then ... //F2
end;
◇[杂类]隐藏共享文件夹
共享效果：可访问，但不可见（在资源管理、网络邻居中）
取共享名为：direction$
访问：//computer/dirction/
◇[Java Script]Java Script网页常用效果
网页60秒定时关闭
<script language="java script"><!--
settimeout('window.close();',60000)
--></script>
关闭窗口
<a href="/" οnclick="javascript:window.close();return false;">关闭</a>
定时转URL
<meta http-equiv="refresh" content="40;url=http://www.086net.com">
设为首页
<a
οnclick="this.style.behavior='url(#default#homepage)';this.sethomepage('http://086net.com');"href="#">设
为首页</a>
收藏本站
<a href="javascript:window.external.addfavorite('http://086net.com','[未名码头]')">收藏本站</a>
加入频道
<a href="javascript:window.external.addchannel('http://086net.com')">加入频道</a>
◇[DELPHI]文本编辑相关
checkbox1.checked:=not checkbox1.checked;
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsBold] else
richedit1.font.style:=richedit1.font.style-[fsBold]//粗体
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsItalic] else
richedit1.font.style:=richedit1.font.style-[fsItalic]//斜体
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsUnderline] else
richedit1.font.style:=richedit1.font.style-[fsUnderline]//下划线
memo1.alignment:=taLeftJustify;//居左
memo1.alignment:=taRightJustify;//居右
memo1.alignment:=taCenter;//居中
◇[DELPHI]随机产生文本色
randomize;//随机种子
memo1.font.color:=rgb(random(255),random(255),random(255));
◇[DELPHI]DELPHI5 UPDATE升级补丁序列号
1000003185
90X25fx0
◇[DELPHI]文件名的非法字符过滤
for i:=1 to length(s) do
if s[i] in ['\','/',':','*','?','<','>','|'] then
◇[DELPHI]转换函数的定义及说明
datetimetofiledate (datetime:Tdatetime):longint; 将Tdatetime格式的日期时间值转换成DOS格式的日期时间值
datetimetostr (datetime:Tdatetime):string; 将Tdatatime格式变量转换成字符串，如果datetime参数不包含日期
值，返回字符串日期显示成为00/00/00，如果datetime参数中没有时间值，返回字符串中的时间部分显示成为
00：00：00 AM
datetimetostring (var result string;
const format:string;
datetime:Tdatetime); 根据给定的格式字符串转换时间和日期值，result为结果字符串，format为转换格式字符
串，datetime为日期时间值
datetostr (date:Tdatetime) 使用shortdateformat全局变量定义的格式字符串将date参数转换成对应的字符串
floattodecimal (var result:Tfloatrec;value:
extended;precision,decimals:
integer); 将浮点数转换成十进制表示
floattostr (value:extended):string 将浮点数value转换成字符串格式，该转换使用普通数字格式，转换的有效位
数为15位。
floattotext (buffer:pchar;value:extended;
format:Tfloatformat;precision,
digits:integer):integer; 用给定的格式、精度和小数将浮点值value转换成十进制表示形式，转换结果存放
于buffer参数中，函数返回值为存储到buffer中的字符位数，buffer是非0结果的字符串缓冲区。
floattotextfmt (buffer:pchar;value:extended;
format:pchar):integer 用给定的格式将浮点值value转换成十进制表示形式，转换结果存放于buffer参数中，函
数返回值为存储到buffer中的字符位数。
inttohex (value:longint;digits:integer):
string; 将给定的数值value转换成十六进制的字符串。参数digits给出转换结果字符串包含的数字位数。
inttostr (value:longint):string 将整数转换成十进制形式字符串
strtodate (const S:string):Tdatetime 将字符串转换成日期值，S必须包含一个合法的格式日期的字符串。
strtodatetime (const S:string):Tdatetime 将字符串S转换成日期时间格式，S必须具有MM/DD/YY
HH：MM：SS[AM|PM]格式，其中日期和时间分隔符与系统时期时间常量设置相关。如果没有指定AM或PM信息
，表示使用24小时制。
strtofloat (const S:string):extended; 将给定的字符串转换成浮点数，字符串具有如下格式：
[+|-]nnn…[.]nnn…[<+|-><E|e><+|->nnnn]
strtoint (const S:string):longint 将数字字符串转换成整数，字符串可以是十进制或十六进制格式，如果字符串
不是一个合法的数字字符串，系统发生ECONVERTERROR异常
strtointdef (const S:string;default:
longint):longint; 将字符串S转换成数字，如果不能将S转换成数字，strtointdef函数返回参数default的值。
strtotime (const S:string):Tdatetime 将字符串S转换成TDATETIME值，S具有HH：MM：SS[AM|PM]格式，实际
的格式与系统的时间相关的全局变量有关。
timetostr (time:Tdatetime):string; 将参数TIME转换成字符串。转换结果字符串的格式与系统的时间相关常量的
设置有关。
◇[DELPHI]程序不出现在ALT+CTRL+DEL
在implementation后添加声明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏
RegisterServiceProcess(GetCurrentProcessID, 0);//显示
用ALT+DEL+CTRL看不见
◇[DELPHI]程序不出现在任务栏
uses windows
var
ExtendedStyle : Integer;
begin
Application.Initialize;
//==============================================================
ExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW
AND NOT WS_EX_APPWINDOW);
//===============================================================
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
◇[DELPHI]如何判断拨号网络是开还是关
if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then
showmessage('在线!')
else showmessage('不在线!');
◇[DELPHI]实现IP到域名的转换
function GetDomainName(Ip:string):string;
var
pH:PHostent;
data:twsadata;
ii:dword;
begin
WSAStartup($101, Data);
ii:=inet_addr(pchar(ip));
pH:=gethostbyaddr(@ii,sizeof(ii),PF_INET);
if (ph<>nil) then
result:=pH.h_name
else
result:='';
WSACleanup;
end;
◇[DELPHI]处理“右键菜单”方法
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey:=HKEY_CLASSES_ROOT;
reg.OpenKey('*\shell\check\command', true);
reg.WriteString('', '"' + application.ExeName + '" "%1"');
reg.CloseKey;
reg.OpenKey('*\shell\diary', false);
reg.WriteString('', '操作(&C)');
reg.CloseKey;
reg.Free;
showmessage('DONE!');
end;
◇[DELPHI]发送虚拟键值ctrl V
procedure sendpaste;
begin
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);
keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), 0, 0);
keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);
end;
◇[DELPHI]当前的光驱的盘符
procedure getcdrom(var cd:char);
var
str:string;
drivers:integer;
driver:char;
i,temp:integer;
begin
drivers:=getlogicaldrives;
temp:=(1 and drivers);
for i:=0 to 26 do
begin
if temp=1 then
begin
driver:=char(i+integer('a'));
str:=driver+':';
if getdrivetype(pchar(str))=drive_cdrom then
begin
cd:=driver;
exit;
end;
end;
drivers:=(drivers shr 1);
temp:=(1 and drivers);
end;
end;
2379
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
