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);
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(
'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
TimeToStr
DateToStr
DateTimeToStr
FmtStr
FormatDateTime(
'YYYY-MM-DD,hh-mm-ss'
,DATE);
◇[DELPHI]字符串的过程和函数
Insert(obj,target,pos);
Delete(st,pos,Num);
Str(value,st);
Val
(st,
var
,code);
Copy(st
.
pos
.
num);
Concat(st1,st2,st3……,stn);
Length(st);
Pos(obj,target);
◇[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
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
...
if
msg
.
message=
112
then
...
if
msg
.
message=
113
then
...
end
;
◇[杂类]隐藏共享文件夹
共享效果:可访问,但不可见(在资源管理、网络邻居中)
取共享名为:direction$
访问:
◇[Java Script]Java Script网页常用效果
网页
60
秒定时关闭
关闭窗口
关闭
定时转URL
数据源,一个是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
;
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的自动完成
var
lastKey:
Word
;
procedure
TForm1
.
AutoCompleteChange(Sender: TObject);
var
SearchStr:
string
;
retVal:
integer
;
begin
SearchStr := (Sender
as
TCombobox).Text;
if
lastKey <> VK_BACK
then
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
;
end
;
lastKey :=
0
;
end
;
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
public
end
;
procedure
TForm1
.
WMQueryEndSession(
var
Message: TWMQueryEndSession);
begin
Showmessage(
'computer is about to shut down'
);
end
;
◇[DELPHI]获取网上邻居
procedure
getnethood();
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
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,
WM_VSCROLL,
SB_PAGEDOWN,
0
)
end
;
'u'
:
begin
SendMessage(Memo
.
Handle,
WM_VSCROLL,
SB_PAGEUP,
0
);
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
2
。
3
。嵌入一个样式表
4
。
Arial
DIV
可以包含段落、标题、表格甚至其它部分
5
。
CLASS
属性
6
。ID属性
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:[ | 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
freelibrary(handle);
end
;
◇[DELPHI]指针变量和地址
var
x,y:
integer
;p:^
integer
;
x:=
10
;
p:=@x;
y:=p^;
@@
procedure
◇[DELPHI]判断字符是汉字的一个字符
ByteType(
'你好haha吗'
,
1
) = mbLeadByte
ByteType(
'你好haha吗'
,
2
) = mbTrailByte
ByteType(
'你好haha吗'
,
5
) = mbSingleByte
◇[DELPHI]memo的定位操作
memo1
.
lines
.
delete(
0
)
memo1
.
selstart:=
10
◇[DELPHI]获得双字节字符内码
function
getit(s:
string
):
integer
;
begin
Result :=
byte
(s[
1
]) *
$100
+
byte
(s[
2
]);
end
;
使用:getit(
'计'
)
◇[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建立和引用
library
project1;
uses
SysUtils, Classes;
function
addit(f:
integer
;s:
integer
):
integer
;export;
begin
makeasum:=f+s;
end
;
exports
addit;
end
.
implementation
function
addit(f:
integer
;s:
integer
):
integer
;far;external
'project1'
;
◇[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);
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
Isample=
interface
function
getstring:
string
;
end
;
Tsample=
class
(TInterfacedObject,Isample)
public
function
getstring:
string
;
end
;
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;
showmessage(sampleInterface
.
getstring+
'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:
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;
NMUUE
.
InputStream:=InStream;
NMUUE
.
OutputStream:=OutStream;
NMUUE
.
Encode;
inStream
.
free;
outStream
.
free;
end
;
◇[DELPHI]TFileStream的操作
function
read(
var
buffer;count:
longint
):
longint
;override;
function
write
(
const
buffer;count:
longint
):
longint
;override;
function
seek(offset:
longint
;origin:
word
):
longint
;override;
origin=
function
copyfrom(source:TStream;count:
longint
):
longint
;
var
myFStream:TFileStream;
begin
myFStream:=TFileStream
.
create(OpenDialog1
.
filename,fmOpenRead);
end
;
var
myPlugin = navigator
.
plugins["Shockwave"];
if
(myPlugin)
document
.
writeln
("你已经安装了 Shockwave!")
else
document
.
writeln
("你尚未安装 Shockwave!")
var
myPlugin = navigator
.
plugins["Quicktime"];
if
(myPlugin)
document
.
writeln
("你已经安装了Quicktime!")
else
document
.
writeln
("你尚未安装 Quicktime!")
Procedure
TForm1
.
Edit1Enter(Sender:TObject);
begin
(Sender
As
TEdit).Color:=ClInfo;
file
:
end
;
Procedure
TForm1
.
Edit1Exit(Sender:TObject);
Begin
(Sender
As
TEdit).Color:=ClWhite;
file
:
End
;
file
:
Procedure
TForm1
.
Button1(Sender:TObject);
var
Index:
Integer
;
Begin
For
Index:=
0
to
ControlCount-
1
do
Begin
if
Components[Index]
is
TEdit
then
begin
(Components[Index]
As
TEdit).Color:=ClLime;
end
End
本文来自CSDN博客,转载请标明出处:http: