1、对于单个控ӞComponet-->install component..-->PAS或DCU文g-->installQ?
2、对于带*.dpk文g的控件包QFile-->Open(下拉列表框中?.dpk)-->install卛_Q?
3、对于带*.bpl文g的控件包QInstall Packages-->Add-->bpl文g名即可；
4、如果以上Install按钮为失效的话，试试Compile按钮Q?
5、是run time lib则在option下的packages下的runtimepackes加之?
如果~译时提C文件找不到的话Q一般是控g的安装目录不在Delphi的Lib目录中，
有两U方法可以解冻I
1、反安装的源文g拷入到Delphi的Lib目录下；
2、或者Tools-->Environment Options中把控g源代码\径加入到Delphi的Lib目录中即可? 注意Q所安装的控件是否与你所用的Delphi版本盔R应?
]]>
copy:http://www.jackfeng.com/archives/276/
{-------------------------------------------------------------------------------
q程?
作?
日期:
参数:
-------------------------------------------------------------------------------}
function MakeFileList(Path,FileExt:string):TStringList ;
var
sch:TSearchrec;
begin
Result:=TStringlist.Create;
if rightStr(trim(Path), 1) <> '\'
then
else
if not DirectoryExists(Path) then
begin
end;
if FindFirst(Path + '*', faAnyfile, sch) = 0 then
begin
end;
end;
------------------------------------------------------------------------------------------------------------------------------------
字符截取函数LeftStr, MidStr, RightStr
q几个函数都包含在StrUtils中，所以需要uses StrUtils;
假设字符串是 Dstr := ’Delphi is the BEST’, 那么
LeftStr(Dstr, 5) := ’Delph’
MidStr(Dstr, 6, 7) := ’i is th’
RightStr(Dstr, 6) := ’e BEST’
~~~~~~~~~~~~~~~~~~~~~~~~~
function RightStr
(Const Str: String; Size: Word): String;
begin
if Size > Length(Str) then Size := Length(Str) ;
RightStr := Copy(Str, Length(Str)-Size+1, Size)
end;
function MidStr
(Const Str: String; From, Size: Word): String;
begin
MidStr := Copy(Str, From, Size)
end;
function LeftStr
(Const Str: String; Size: Word): String;
begin
LeftStr := Copy(Str, 1, Size)
end;
q几个函数经常结合Pos, Length, Copy使用
]]>
copy:http://hi.baidu.com/yunfanleo/blog/item/0c51d9cdbc0531550eb34558.html
Format是一个很常用Q却又似乎很烦的Ҏ(gu)Q本囑֯q个Ҏ(gu)的帮助进行一些翻译，让它有一个完整的概貌Q以 供大家查询之用：
首先看它的声明：
function Format(const Format: string; const Args: array of const):
string; overload;
事实上FormatҎ(gu)有两个种形式Q另外一U是三个参数的，主要区别在于它是U程安全的，
但ƈ不多用，所以这里只对第一个介l：
function Format(const Format: string; const Args: array of const):
string; overload;
Format参数是一个格式字W串Q用于格式化Args里面的值的。Args又是什么呢Q?br />
它是一个变体数l，卛_里面可以有多个参敎ͼ而且每个参数可以不同?br />
如以下例子：
Format('my name is %6s',['wind']);
q回后就是my name is wind
现在来看Format参数的详l情况：
Format里面可以写普通的字符Ԍ比如'my name is',但有些格式指令字W具有特D意义，比如"%6s"格式指oh以下的Ş式：
"%" [index ":"] ["-"] [width] ["." prec] type
它是?%"开?而以typel束Qtype表示一个具体的cd。中间是用来
格式化typecd的指令字W，是可选的?/font>
先来看看type,type可以是以下字W：
d 十制敎ͼ表示一个整型?br />
u 和d一h整型|但它是无W号的，而如果它对应的值是负的Q则q回时是一??2ơ方减去q个l对值的?如：
Format('this is %u',[Q?]);
q回的是Qthis is 4294967294
f 对应点?br />
e U学表示法，对应整型数和点敎ͼ比如
Format('this is %e',[-2.22]);
q回的是Qthis is -2.22000000000000E+000,{一下再说明如果数的精度羃?yu)?/font>
g q个只能对应点型，且它会将g多余的数L,比如
Format('this is %g',[02.200]);
q回的是Qthis is 2.2
n 只能对应点型，D{化ؓL的Ş式。看一个例子就明白?br />
Format('this is %n',[4552.2176]);
q回的是this is 4,552.22
注意有两点，一是只表示到小数后两位Q等一下说怎么消除q种情况, 二是Q即使小数没有被截断Q它也不会也像整数部分一h逗号来分开?/font>
m钱币cdQ但关于货币cd有更好的格式化方法，q里只是单的格式?另外它只对应于Q点?br />
Format('this is %m',[9552.21]);
q回Qthis is K?,552.21
p 对应于指针类型，q回的值是指针的地址Q以十六q制的Ş式来表示
例如Q?br />
var X:integer;
p:^integer;
begin
X:=99;
p:=@X;
Edit1.Text:=Format('this is %p',[p]);
end;
Edit1的内Ҏ(gu)Qthis is 0012F548
s 对应字符串类型，不用多说了吧
x 必须是一个整形|以十六进制的形式q回
Edit1.Text:=Format('this is %X',[15]);
q回是：this is F
cd讲述完毕Q下面介l格式化Type的指令：
[index ":"]q个要怎么表达呢，看一个例?br />
Format('this is %d %d',[12,13]);
其中W一?d的烦引是0Q第二个%d?Q所以字W显C的时候是q样 this is 12 13
而如果你q样定义Q?br />
Format('this is %1:d %0:d',[12,13]);
那么q回的字W串变成了this is 13 12。现在明白了吗，[index ":"]
中的index指示Args中参数显C的序q有一U情况，如果q样
Format('%d %d %d %0:d %d', [1, 2, 3, 4])
返? 2 3 1 2?/font>
如果你想q回的是1 2 3 1 4Q必这样定Q?br /> Format('%d %d %d %0:d %3:d', [1, 2, 3, 4])
但用的时候要注意Q烦引不能超出Args中的个数Q不然会引v异常?br />
Format('this is %2:d %0:d',[12,13]);
׃Args中只?2 13 两个敎ͼ所以Index只能??Q这里ؓ2错了[width] 指定被格式化的值占的宽度，看一个例子就明白?/font>
Format('this is %4d',[12]);
输出是：this is 12,q个是比较容易，不过如果Width的值小于参数的长度Q则没有效果?br />
如：
Format('this is %1d',[12]);
输出是：this is 12
["-"]q个指定参数向左齐，和[width]合在一h可以看到效果Q?br />
Format('this is %-4d,yes',[12]);
输出是：this is 12 ,yes
["." prec] 指定_ֺQ对于QҎ(gu)效果最佻I
Format('this is %.2f',['1.1234]);
输出 this is 1.12
Format('this is %.7f',['1.1234]);
输出?this is 1.1234000
而对于整型数Q如果prec比如整型的位数小Q则没有效果反之比整形值的位数大，则会在整型值的前面?补之
Format('this is %.7d',[1234]);
输出是：this is 0001234]
对于字符型，刚好和整型值相反，如果prec比字W串型的长度大则没有效果Q反之比字符串型的长度小Q则会截断尾部的字符
Format('this is %.2s',['1234']);
输出?this is 12,而上面说的这个例子：
Format('this is %e',[-2.22]);
q回的是Qthis is -2.22000000000000E+000,怎么L多余?呢，q个p?/font>
Format('this is %.2e',[-2.22]);
好了Q第一个ȝ讲完了，应该对他的应用很熟?zhn)了?/font>
///////////////////////////////////////////////////////////////
?FormatDateTime的用?br />
他的声明为：
function FormatDateTime(const Format: string;
DateTime: TDateTime): string;
overload;
当然和Format一栯有一U，但这里只介绍常用的第一U?Format参数是一个格式化字符丌Ӏ? DateTime是时间类型。返回值是一U格式化后的字符?重点来看Format参数中的指o字符
c 以短旉格式昄旉Q即全部是数字的表示
FormatdateTime('c',now);
输出为：2004-8-7 9:55:40
d 对应于时间中的日期，日期是一位则昄一位，两位则显CZ?br />
FormatdateTime('d',now);
输出可能??1
dd 和d的意义一P但它始终是以两位来显C的
FormatdateTime('dd',now);
输出可能?1?1
ddd 昄的是星期?br />
FormatdateTime('ddd',now);
输出? 星期?/font>
dddd 和ddd昄的是一L。但上面两个如果在其他国家可能不一栗ddddd 以短旉格式昄q月?br />
FormatdateTime('ddddd',now);
输出为：2004-8-7
dddddd 以长旉格式昄q月?br />
FormatdateTime('dddddd',now);
输出为：2004q???/font>
e/ee/eee/eeee 以相应的位数昄q?br />
FormatdateTime('ee',now);
输出为：04 Q表C?4q_
m/mm/mmm/mmmm 表示?br />
FormatdateTime('m',now);
输出为：8
FormatdateTime('mm',now);
输出? 08
FormatdateTime('mmm',now);
输出? 八月
FormatdateTime('mmmm',now);
输出? 八月
和ddd/dddd 一P在其他国家可能不同yy/yyyy 表示q?br />
FormatdateTime('yy',now);
输出?04
FormatdateTime('yyyy',now);
输出?2004,
h/hh,n/nn,s/ss,z/zzz 分别表示时Q分Q秒,毫秒
t 以短旉格式昄旉
FormatdateTime('t',now);
输出?10:17
tt 以长旉格式昄旉
FormatdateTime('tt',now);
输出?0:18:46
ampm 以长旉格式昄上午q是下午
FormatdateTime('ttampm',now);
输出为：10:22:57上午
大概如此Q如果要在Format中加普通的字符Ԍ可以用双引号隔开那些特定义的字符Q这h通字W串中如果含Ҏ(gu)
的字W就不会被显CZؓ旉格式啦：
FormatdateTime('"today is" c',now);
输出为：today is 2004-8-7 10:26:58
旉中也可以?-"?\"来分开日期Q?br />
FormatdateTime('"today is" yy-mm-dd',now);
FormatdateTime('"today is" yy\mm\dd',now);
输出为： today is 04-08-07
也可以用":"来分开旉
FormatdateTime('"today is" hh:nn:ss',now);
输出为：today is 10:32:23
/////////////////////////////////////////////////////////////////
?FormatFloat的用?/font>
常用的声明：
function FormatFloat(const Format: string; Value: Extended): string;
overload;
和上面一样Format参数为格式化指o字符QValue为ExtendedcdZ么是q个cdQ因为它是所有Q 点g表示范围最大的Q如果传入该Ҏ(gu)的参数比如Double或者其他，则可以保存不会超围?/font>
关键是看Format参数的用?br />
0 q个指定相应的位数的指o?br />
比如Q?br />
FormatFloat('000.000',22.22);
输出的就?22.220
注意一点，如果整数部分?的个数小于Value参数中整数的位数Q则没有效果如：
FormatFloat('0.00',22.22);
输出的是Q?2.22
但如果小数部分的0于Value中小数的倍数Q则会截ȝ应的数和位数如Q?br />
FormatFloat('0.0',22.22);
输出的是Q?2.2
也可以在整数0中指定逗号Q这个整C数必d?个，才会有逗号出句
FormatFloat('0,000.0',2222.22);
输出是：2,222.2
如果q样
FormatFloat('000,0.0',2222.22);
它的输出q是Q?,222.2
注意它的规律,#?的用法一P目前我还没有出有什么不同?/font>
FormatFloat('##.##',22.22);
输出是：22.00
E U学表示法，看几个例子大概就明白?br />
FormatFloat('0.00E+00',2222.22);
输出?2.22E+03
FormatFloat('0000.00E+00',2222.22);
输出?2222.22E+00
FormatFloat('00.0E+0',2222.22);
22.2E+2
明白了吗Q全靠E双?来支配的?br />
q个Ҏ(gu)q不难，大概是q样子了?/font>
上面三个Ҏ(gu)是很常用的，没有什么技巧，只要记得q些规范?yu)p了?/font>
ȝ一下Format的用?
Format('x=%d',[12]);//'x=12'//最普?br />
Format('x=%3d',[12]);//'x=12'//指定宽度
Format('x=%f',[12.0]);//'x=12.00'//点?br />
Format('x=%.3f',[12.0]);//'x=12.000'//指定数
Format('x=%8.2f'[12.0])//'x=12.00';
Format('x=%.*f',[5,12.0]);//'x=12.00000'//动态配|?br />
Format('x=%.5d',[12]);//'x=00012'//前面补充0
Format('x=%.5x',[12]);//'x=0000C'//十六q制
Format('x=%1:d%0:d',[12,13]);//'x=1312'//使用索引
Format('x=%p',[nil]);//'x=00000000'//指针
Format('x=%1.1e',[12.0]);//'x=1.2E+001'//U学记数?br />
Format('x=%%',[]);//'x=%'//得到"%"
S:=Format('%s%d',[S,I]);//S:=S+StrToInt(I);//q接字符?/font>
]]>
Delphi+Codesoft 7.0 调用条码格式文g打印
procedure TFormMain.btnPrintClick(Sender: TObject);
Var
s: string;
i : Integer;
BarApp,BarDoc,BarVars:Variant; // OLE 变量
Begin
if not FileExists(edtBClabelName.Text) then
begin
stat.Panels[2].Text := 'The Barcode Document is not Exists.';
ShowMessage('The Barcode Document is not Exists.');
Exit;
btnOpen.SetFocus;
end;
BarApp := CreateOleObject('lppx.Application');
//arApp.Visible:=True;
BarApp.Visible:=False;
BarDoc:=BarApp.ActiveDocument;
BarVars:=BarDoc.Variables;
BarDoc.Open(edtBClabelName.Text);
// 变量赋?br /> if chkParam.Checked then
begin
BarDoc.Variables.Item('var1').Value:= edtPN.Text;
BarDoc.Variables.Item('var2').Value:= edtPartName.Text;
BarDoc.Variables.Item('var3').Value:= edtDesc.Text;
end;
// 打印标签
Bardoc.Printlabel(seqty.Value);
// Feed
BarDoc.FormFeed;
// 关闭
Bardoc.Close;
BarApp.Quit;
End;
如果报Undeclare identified 'CreateOleObject' 错误Q?则引入ComObj 卛_
]]>
我下载的ODAC版本是ODAC_5.70.0.28Q下載地址:http://www.delphifans.com/SoftView/SoftView_2131.html
我的Delphi?.0
W一步：在odac570src_0.28\Source\Delphi7打开dac70.dpk,然后~译
W二步：打开dacvcl70.dpkQ然后编?/p>
W三步：打开dcldac70.dpkQ然后编?/p>
W四步：打开odac70.dpkQ然后编?/p>
W五步：打开odacvcl70.dpkQ然后编译（如果你想要创建CLX应用E序的话Q那么就要单独编?nbsp; OdacClx.pasQ?nbsp;
W六步：打开dclodac70.dpkQ然后编译，然后点击“安装”?
在用或~译时也会出现这个错误， 解决Ҏ(gu)把{$I _TrialIntfOld.inc}注释掉就O(jin)K?/p>
来源Q大富翁
关于文g、目录操?
Chdir('c:\abcdir'); // 转到目录
Mkdir('dirname'); //建立目录
DirectoryExists('dirname') //判斷目錄是否存在
Rmdir('dirname'); //删除目录(目錄不存在會q?
GetCurrentDir; //取当前目录名Q无'\'
Getdir(0,s); //取工作目录名s:='c:\abcdir';
Deletfile('abc.txt'); //删除文g
Renamefile('old.txt','new.txt'); //文g更名
ExtractFilename(filelistbox1.filename); //取文件名
ExtractFileExt(filelistbox1.filename); //取文件后~
目录处理函数三则:DelTree,XCopy,Move
private
{ Private declarations }
procedure _XCopy(ASourceDir:String; ADestDir:String);
procedure _Move(ASourceDir:String; ADestDir:String);
procedure _DelTree(ASourceDir:String);
//----------------------------------------------------------
procedure TForm1._XCopy(ASourceDir:String; ADestDir:String);
var
FileRec:TSearchrec;
Sour:String;
Dest:String;
begin
Sour:=ASourceDir;
Dest:=ADestDir;
if Sour[Length(Sour)]<>'\' then Sour := Sour + '\';
if Dest[Length(Dest)]<>'\' then Dest := Dest + '\';
if not DirectoryExists(ASourceDir) then
begin
ShowMessage('来源目录不存?!');
exit;
end;
if not DirectoryExists(ADestDir) then
begin
ForceDirectories(ADestDir);
end;
if FindFirst(Sour+'*.*',faAnyfile,FileRec) = 0 then
repeat
if ((FileRec.Attr and faDirectory) <> 0) then
begin
if (FileRec.Name<>'.') and (FileRec.Name<>'..') then
begin
_XCopy(Sour+FileRec.Name,Dest+FileRec.Name);
end;
end
else
begin
CopyFile(PChar(Sour+FileRec.Name),PChar(Dest+FileRec.Name),false);
end;
until FindNext(FileRec)<>0;
FindClose(FileRec);
end;
//------------------------------------------------------------------
procedure TForm1._Move(ASourceDir:String; ADestDir:String);
var
FileRec:TSearchrec;
Sour:String;
Dest:String;
begin
Sour:=ASourceDir;
Dest:=ADestDir;
if Sour[Length(Sour)]<>'\' then Sour := Sour + '\';
if Dest[Length(Dest)]<>'\' then Dest := Dest + '\';
if not DirectoryExists(ASourceDir) then
begin
ShowMessage('来源目录不存?!');
exit;
end;
if not DirectoryExists(ADestDir) then
begin
ForceDirectories(ADestDir);
end;
if FindFirst(Sour+'*.*',faAnyfile,FileRec) = 0 then
repeat
if ((FileRec.Attr and faDirectory) <> 0) then
begin
if (FileRec.Name<>'.') and (FileRec.Name<>'..') then
begin
_XCopy(Sour+FileRec.Name,Dest+FileRec.Name);
_DelTree(Sour+FileRec.Name);
FileSetAttr(Sour+FileRec.Name,faArchive);
RemoveDir(Sour+FileRec.Name);
end;
end
else
begin
CopyFile(PChar(Sour+FileRec.Name),PChar(Dest+FileRec.Name),false);
FileSetAttr(Sour+FileRec.Name,faArchive);
deletefile(Sour+FileRec.Name);
end;
until FindNext(FileRec)<>0;
FindClose(FileRec);
FileSetAttr(Sour,faArchive);
RemoveDir(Sour);
end;
//-----------------------------------------------------------
procedure TForm1._DelTree(ASourceDir:String);
var
FileRec:TSearchrec;
Sour:String;
begin
Sour:=ASourceDir;
if Sour[Length(Sour)]<>'\' then Sour := Sour + '\';
if not DirectoryExists(ASourceDir) then
begin
ShowMessage('来源目录不存?!');
exit;
end;
if FindFirst(Sour+'*.*',faAnyfile,FileRec) = 0 then
repeat
//if (FileRec.Attr = faDirectory) then
if ((FileRec.Attr and faDirectory) <> 0) then
begin
if (FileRec.Name<>'.') and (FileRec.Name<>'..') then
begin
_DelTree(Sour+FileRec.Name);
FileSetAttr(Sour+FileRec.Name,faArchive);
RemoveDir(Sour+FileRec.Name);
end;
end
else
begin
FileSetAttr(Sour+FileRec.Name,faArchive);
deletefile(Sour+FileRec.Name);
end;
until FindNext(FileRec)<>0;
FindClose(FileRec);
FileSetAttr(Sour,faArchive);
RemoveDir(Sour);
end;
利用递归实现删除某一目录下所有文?br />
var Form1: TForm1;
rec_stack:array [1..30] of TSearchRec;
rec_pointer:integer;
Del_Flag:Boolean;
---------------------------------------------------------------
procedure TForm1.DeleteTree(s:string);
VAR searchRec:TSearchRec;
begin
if FindFirst(s+'\*.*', faAnyFile, SearchRec)=0 then
repeat
if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
begin
if (SearchRec.Attr and faDirectory>0) then
begin
rec_stack[rec_pointer]:=SearchRec;
rec_pointer:=rec_pointer-1;
DeleteTree(s+'\'+SearchRec.Name);
rec_pointer:=rec_pointer+1;
SearchRec:=rec_stack[rec_pointer];
end
else
begin
try
FileSetAttr(s+'\'+SearchRec.Name,faArchive);
DeleteFile(s+'\'+SearchRec.Name);
except
Application.MessageBox(PChar('Delete file:'+s+'\'+SearchRec.Name+' Error!'),'Info',MB_OK);
Del_Flag:=False;
end;
end;
end;
until (FindNext(SearchRec)<>0);
FindClose(SearchRec);
if rec_pointer<30 then
begin
try
FileSetAttr(s,faArchive);
RemoveDir(s);
except
Application.MessageBox(PChar('Delete Directory:'+s+' Error!'),'Info',MB_OK);
Del_Flag:=False;
end;
end;
end;
---------------------------------------------------------
Del_Flag:=True;
rec_pointer:=30;
DeleteTree('c:\temp');
if Del_Flag then Application.MessageBox(PChar('目录c:\temp的内容已成功清除!'),'信息',MB_OK);
轻轻松松查找文g
在^常的~程当中Q经怼到查找某一个目录下某一cL件或者所有文件的问题Qؓ了适应不同的需要，我们l常不得不编写大量的cM的代码，有没有可能写一个通用的查找文件的E序Q找C个文件后p行处理的呢？q样我们只要~写处理文g的部分就可以了，不需要编写查找文件的部分Q答案是肯定的。下面的q个E序p实现q个功能Q?br />
//说明Q?br />
//TFindCallBack为回调函敎ͼFindFile函数扑ֈ一个匹配的文g之后׃调用q个函数?br />
//TFindCallBack的第一个参数找到的文g名，你在回调函数中可以根据文件名q行操作?br />
//TFindCallBack的第二个参数为找到的文g的记录信息，是一个TSearchRecl构?br />
//TFindCallBack的第三、四个参数分别ؓ军_是否l止文g的查找，临时军_是否查找某个子目录！
//FindFile的参敎ͼ
//W一个决定是否退出查找，应该初始化ؓfalseQ?br />
//W二个ؓ要查找\径；
//W三个ؓ文g名，可以包含Windows所支持的Q何通配W的格式Q默认所有的文g
//W四个ؓ回调函数Q默认ؓI?br />
//W五个决定是否查扑֭目录Q默认ؓ查找子目?br />
//W六个决定是否在查找文g的时候处理其他的消息Q默认ؓ处理其他的消?br />
//若有意见和徏议请E_MailQKingron@163.net
type
TFindCallBack=procedure (const filename:string;const info:TSearchRec;var bQuit,bSub:boolean);
procedure FindFile(var quit:boolean;const path: String;const filename:string='*.*';
proc:TFindCallBack=nil;bSub:boolean=true;const bMsg:boolean=true);
var
fpath: String;
info: TsearchRec;
procedure ProcessAFile;
begin
if (info.Name<>'.') and (info.Name<>'..') and ((info.Attr and faDirectory)<>faDirectory) then
begin
if assigned(proc) then
proc(fpath+info.FindData.cFileName,info,quit,bsub);
end;
end;
procedure ProcessADirectory;
begin
if (info.Name<>'.') and (info.Name<>'..') and ((info.attr and fadirectory)=fadirectory) then
findfile(quit,fpath+info.Name,filename,proc,bsub,bmsg);
end;
begin
if path[length(path)]<>'\' then
fpath:=path+'\'
else
fpath:=path;
try
if 0=findfirst(fpath+filename,faanyfile and (not fadirectory),info) then
begin
ProcessAFile;
while 0=findnext(info) do
begin
ProcessAFile;
if bmsg then application.ProcessMessages;
if quit then
begin
findclose(info);
exit;
end;
end;
end;
finally
findclose(info);
end;
try
if bsub and (0=findfirst(fpath+'*',faanyfile,info)) then
begin
ProcessADirectory;
while findnext(info)=0 do
ProcessADirectory;
end;
finally
findclose(info);
end;
end;
例子Q?br />
procedure aaa(const filename:string;const info:tsearchrec;var quit,bsub:boolean);
begin
form1.listbox1.Items.Add(filename);
quit:=form1.qqq;
bsub:=form1.checkbox1.Checked;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
listbox1.Clear;
qqq:=false;
button1.Enabled:=false;
findfile(qqq,edit1.text,edit2.text,aaa,checkbox1.checked,checkbox2.checked);
showmessage(inttostr(listbox1.items.count));
button1.Enabled:=true;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
qqq:=true;
end;
]]>
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, Menus, ExtCtrls, BmpRgn, StdCtrls, IniFiles,
Buttons;
type
TForm1 = class(TForm)
img1: TImage;
bvl1: TBevel;
lbl1: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMEraseBkGnd( Var Msg: TWMEraseBkGnd ); message WM_ERASEBKGND;
procedure WMNCHitTest( Var msg: TWMNCHitTest ); message WM_NCHITTEST;
public
{ Public declarations }
procedure SetTheRegion;
procedure AppException(Sender: TObject; E: Exception);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// This routine takes care of drawing the bitmap on the form.
procedure TForm1.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
var
Brush: TBrush;
begin
Brush := TBrush.Create;
Brush.Color := Color;
FillRect( Msg.DC, ClientRect, Brush.Handle);
Brush.Free;
with img1.Picture.Bitmap do
BitBlt( Msg.DC, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
Msg.Result := 1;
end;
// This routine takes care of letting the user move the form
// around on the desktop.
procedure TForm1.WMNCHitTest( var msg: TWMNCHitTest );
var
i: integer;
p: TPoint;
AControl: TControl;
MouseOnControl: boolean;
begin
inherited;
if msg.result = HTCLIENT then begin
p.x := msg.XPos;
p.y := msg.YPos;
p := ScreenToClient( p);
MouseOnControl := false;
for i := 0 to ControlCount-1 do begin
if not MouseOnControl
then begin
AControl := Controls[i];
if ((AControl is TWinControl) or (AControl is TGraphicControl))
and (AControl.Visible) then
begin
MouseOnControl := PtInRect( AControl.BoundsRect, p);
end;
end
else
break;
end;
if (not MouseOnControl) then
msg.Result := HTCAPTION;
end;
end;
procedure TForm1.SetTheRegion;
var
HR: HRGN;
begin
HR := BmpToRegion( Self, img1.Picture.Bitmap);
SetWindowRgn( handle, HR, true);
Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnException := AppException;
SetTheRegion;
end;
procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
Application.ProcessMessages;
Application.ShowException(E);
Application.Terminate;
end;
end.
注意:
(1) img1: TImage;的Visible屬性必須設|為false
(2) BmpRgn 為外部dcu文g,需要導?/strong>
]]>
vFile: Textfile;
begin
sDir:='指定目錄';
if Copy(sDir, Length(sDir), 1) <> '\' then
sDir := sDir + '\';
//sDir:=ExtractFilePath(Application.ExeName)+'\';
ForceDirectories(sDir + 'TESTLOG');
sBackupFile := sDir + 'TESTLOG\'+FormatDateTime('YYYYMMDDHH',now())+'.log';
AssignFile(vFile, sBackupFile);
if FileExists(sBackupFile) then
Append(vFile)
else
Rewrite(vFile);
if not Err then
WriteLn(vFile, FormatDateTime('yyyy/mm/dd hh:mm:ss', Now) +' [Error ]' +' - ' + sTrlog)
else
WriteLn(vFile, FormatDateTime('yyyy/mm/dd hh:mm:ss', Now) +' [ ]' +' - ' + sTrlog);
CloseFile(vFile);
end;
]]>
一、什么是 CnWizardsQ?br /> ======================
CnWizards ?CnPack 目l的d产品之一Q中文全U是 CnPack IDE 专家包，
英文全称?CnPack IDE WizardsQ简U?CnWizards。CnWizards 是一l集成在
Delphi/C++Builder/BDS ?IDE 中，用于增强 IDE 功能、提?IDE 的可用性及
开发效率的免费、开放源码工兗?/p>
==================================
二、CnWizards 主要面对哪类用户？
==================================
CnWizards 产品主要面对使用 Delphi 5 6 7、C++Builder 5 6 ?BDS 2005
2006、RAD Studio 2007 2009 2010 的开发者?br />
CnWizards 目前的发布版本包括简体中文、繁体中文、英三种语言?/p>
注：׃~译的兼Ҏ(gu)问题，对于 Delphi 2009QCnWizards 只支持其正式版即
12.0.3170.16989 或以上版本，而不支持低于此版本的内测版。如需要在内测?br />
中安?CnWizardsQ需要获?CnWizards 的代码自行编译?/p>
==============================
三、CnWizards 主要有哪些功能？
==============================
CnWizards ?Delphi / C++Builder / BDS ?IDE 中提供了十多个可独立讄?br /> 子专Ӟ数十U功能，主要包括Q?/p>
* 代码输入助手
* 代码l构匚w高亮与画U?br />
* 增强的单元窗体列表功?br />
* TabOrder 讄专家
* H体设计器的动工具?br />
* MSDN 帮助集成功能
* 代码~辑器工h与功能扩?br />
* 工程相关的扩展功?br />
* lg面板多行昄支持
* H体|顶与折叠功?br />
* 源代码统计功?br />
* 引用单元清理
* 其他大量增强与改q?/p>
关于界面截图可参考：http://www.cnpack.org/images/cnwizards.gif
此外QCnWizards q附带下列独立运行的工P
* CnWizards 讄导入导出工具
* DFM H体转换工具
* IDE 配置备䆾/恢复和清除打开文g历史工具
* 调试信息输出单元 CnDebug 与调试信息查看器 CnDebugViewer
* ASCII 字符?br />
* IDE 外部专家理工具
* 源码模块关系分析工具
CnWizards 以与开源协议兼容的 CnPack 协议发布Q因而是开源、免费的?br /> M个h或商业团体可以免费?CnWizardsQ无需支付M费用?/p>
======================
四、关?CnPack 开发组
======================
CnPack 是由互联|上一中国程序员开发的开放源码的自由软g目Q当前主?br /> 的工作成果包?CnPack lg包、CnWizards 专家包以?CVSTracNT 错误跟踪p?br /> l等?009 q?CnPack 开发组成ؓ?Embarcadero 的技术合作伙伴?br /> CnPack 开发团队目前规模有 260 余hQƈ且还在不断发展壮大中?/p>
CnPack |站Qhttp://www.cnpack.org
CnPack 论坛Qhttp://bbs.cnpack.org
每日构徏版： http://www.cnpack.org/downbuilds.php
理员信： master@cnpack.org
======================
五、更新记?br />
======================
0.9.5 ?Bug 修复ZQ较 0.9.4 的更斎ͼ
* 高亮当前标识W增加前景色与边框色的设|?br /> * 引用单元清理修正对inline处理p|的问题?br /> * 增加IDE讄为单核方式运行的选项?br /> * 修正BDS的嵌入式设计界面~辑器工h讄未保存的问题?br /> * 在BDS的嵌入式设计界面增加~辑器工h?br /> * ~辑器扩展修正复制ƈq加功能在D2010下导致ؕ码的问题?br /> * 其它的错误修正和改进?br />
相关下蝲:
CnWizards V0.9.5.554 安装E序 (已下?nbsp;7455 ?
CnWizards V0.9.5.554 源代码（包括 CnPack lg?CnVcl 内测版） (已下?nbsp;1355 ?
]]>
| function Pos(Substr: string; S: string): Integer; |
它的作用是在字符串S中查扑֭W串SubstrQ返回值是Substr在S中第一ơ出现的位置Q如果没有找刎ͼq回gؓ0?
]]>
myFile : TextFile;
text : String;
sFileName : String;
begin
sFileName := 'F:/test.txt';
AssignFile(myFile, sFileName);
if FileExists(sFileName) then
Append(myFile)// 以追加的方式打开文g
else
ReWrite(myFile);
Writeln(myFile, 'Hello World, By Bob!');
Writeln(myFile, FormatDateTime('yyyy/mm/dd hh:nn:ss', now));
CloseFile(myFile);
ReSet(myFile);
while not Eof(myFile) do
begin
Readln(myFile, text);
showmessage(text);
end;
CloseFile(myFile);
end;
]]>
?http://hi.baidu.com/graspa/blog/item/d17d928b4ec949d0fc1f1007.html/cmtid/196abb648679f0fcf73654ae
一、有必要了解INI文g的结构：
;注释
[节名]
关键??/font>
...
---- INI文g允许有多个小节，每个节又允许有多个关键字， “=”后面是该关键字的倹{?/font>
---- 值的cd有三U：字符丌Ӏ整型数值和布尔倹{其中字W串存贮在INI文g中时没有引号Q布?yu)真值用1表示Q布?yu)假值用0表示?/font>
---- 注释以分?#8220;;”开头?/font>
二、定?/font>
---- 1、在Interface的Uses节增加IniFilesQ?/font>
---- 2、在Var变量定义部分增加一行：
myinifile:Tinifile;
---- 然后Q就可以对变量myinifileq行创徏、打开、读取、写入等操作了?/font>
三、打开INI文g
myinifile:=Tinifile.create('program.ini');
--- 上面q一行语句将会ؓ变量myinifile与具体的文g program.ini建立联系Q然后，可以通过变量myinifileQ来dprogram.ini文g中的关键字的g?/font>
---- 值得注意的是Q如果括号中的文件名没有指明路径的话Q那么这个Program.ini文g会存储在Windows目录?把Program.ini文g存储在应用程序当前目录中的方法是Qؓ其指定完整的路径及文件名。下面的两条语句可以完成q个功能Q?/font>
Filename:=ExtractFilePath(Paramstr(0))+'program.ini';
myinifile:=Tinifile.Create(filename);
四、读取关键字的?/font>
--- 针对INI文g支持的字W串、整型数倹{布?yu)gU数据类型，TINIfilescL供了三种不同的对象方法来dINI文g中关键字的倹{?/font>
--- 假设已定义变量vs、vi、vb分别为string?integer、booleancd?/font>
vs:=myinifile.Readstring('节?,'关键?,~省?;
vi:=myinifile.Readinteger('节?,'关键?,~省?;
vb:=myinifile.Readbool('节?,'关键?,~省?;
--- 其中~省gؓ该INI文g不存在该关键字时q回的缺省倹{?/font>
五、写入INI文g
---- 同样的，TInifilecM提供了三U不同的对象Ҏ(gu)Q向INI文g写入字符丌Ӏ整型数及布?yu)类型的关键字?/font>
myinifile.writestring('节?,'关键?,变量或字W串?;
myinifile.writeinteger('节?,'关键?,变量或整型数?;
myinifile.writebool('节?,'关键?,变量或True或False);
---- 当这个INI文g不存在时Q上面的语句q会自动创徏该INI文g?/font>
六、删除关键字
---- 除了可用写入Ҏ(gu)增加一个关键字QTinifilec还提供了一个删除关键字的对象方法：
myinifile.DeleteKey('节?,'关键?);
七、小节操?/font>
--- 增加一个小节可用写入的Ҏ(gu)来完成，删除一个小节可用下面的对象Ҏ(gu)Q?/font>
myinifile.EraseSection('节?);
--- 另外Tinifilec还提供了三U对象方法来对小节进行操作：
--- myinifile.readsection('节?,TStrings变量);可将指定节中的所有关键字名读取至一个字W串列表变量中；
--- myinifile.readsections(TStrings变量);可将INI文g中所有小节名d至一个字W串列表变量中去?/font>
---- myinifile.readsectionvalues('节?,TStrings变量);可将INI文g中指定小节的所有行Q包括关键字?、|d至一个字W串列表变量中去?/font>
八、释?/font>
在适当的位|用下面的语句释放myinifileQ?/font>
myinifile.distory;
?ji)、一个实?/font>
---- 下面用一个简单的例子(如图)Q演CZ建立、读取、存贮INI文g的方法。myini.ini文g中包含有“E序参数”节Q和用户名称Q字W串Q、是? 正式用户Q布?yu)|和已q行旉Q整型|三个关键字。程序在H体建立dq些数据Qƈ在窗体释放时写myini.ini文g?/font>
--- 附源E序清单
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
inifiles, //配置操作文g
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
CheckBox1: TCheckBox;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
myinifile:TInifile;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
filename:string;
begin
filename:=ExtractFilePath(paramstr(0))+'myini.ini';
myinifile:=TInifile.Create(filename);
edit1.Text:= myinifile.readstring('E序参数','用户名称','~省的用户名U?);
edit2.text:= inttostr(myinifile.readinteger('E序参数','已运行时?,0));
checkbox1.Checked:= myinifile.readbool('E序参数','是否正式用户',False);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
myinifile.writestring('E序参数','用户名称',edit1.Text);
myinifile.writeinteger('E序参数','已运行时?,strtoint(edit2.text));
myinifile.writebool('E序参数','是否正式用户',checkbox1.Checked);
myinifile.Destroy;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
edit2.Text:=inttostr(strtoint(edit2.text)+1);
end;
end.
]]>