[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:[email protected]','','',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秒定時關閉
關閉窗口
關閉
定時轉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;
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。//連接一個外部樣式表
3。嵌入一個樣式表
4。 //內聯樣式
Arial//SPAN接受STYLE、CLASS和ID屬性 DIV可以包含段落、標題、表格甚至其它部分
5。CLASS屬性 //定義見3。
6。ID屬性 //定義見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:[ | 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
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!")
