本人今天把自已以前的一些delphi编程经验进行个小总结，总结完后突有一个
这样的想法：如果我把这些总结发给网上的delphi朋友，而他们如果也有些自已
的delphi编程小结，也发给我(如果愿意的话),这样大家的进步肯定是很快的。
本人email：yesterday97@hotmail.com
(1).按下ctrl和其它键之后发生一事件。
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in Shift) and (key =67) then
showmessage('keydown Ctrl+C');
end;
(2).Dbgrid中用Enter键代替Tab键.
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if ActiveControl = DBGrid1 then
begin
TDBGrid(ActiveControl).SelectedIndex := TDBGrid(ActiveControl).SelectedIndex + 1;
Key := #0;
end;
end;
(3).Dbgrid中选择多行发生一事件。
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
bookmarklist:Tbookmarklist;
bookmark:tbookmarkstr;
begin
bookmark:=adoquery1.Bookmark;
bookmarklist:=dbgrid1.SelectedRows;
try
begin
for i:=0 to bookmarklist.Count-1 do
begin
adoquery1.Bookmark:=bookmarklist[i];
with adoquery1 do
begin
edit;
fieldbyname('mdg').AsString:=edit2.Text;
post;
end;
end;
end;
finally
adoquery1.Bookmark:=bookmark;
end;
end;
(4).Form的一个出现效果。
procedure TForm1.Button1Click(Sender: TObject);
var
r:thandle;
i:integer;
begin
for i:=1 to trunc(width/1.414) do
begin
r:=CreateEllipticRgn(trunc(width/2)-i,trunc(height/2)-i,trunc(width/2)+i,trunc(height/2)+i);
SetWindowRgn(handle,r,true);
Application.ProcessMessages;
sleep(1);
end;
end;
(5).用Enter代替Tab在编辑框中移动隹点。
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
if not (Activecontrol is Tmemo) then
begin
key:=#0;
keybd_event(vk_tab,mapvirtualkey(vk_tab,0),0,0);
end;
end;
end;
(6).Progressbar加上色彩。
const
{$EXTERNALSYM PBS_MARQUEE}
PBS_MARQUEE = 08;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
CommCtrl;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Set the Background color to teal
Progressbar1.Brush.Color := clTeal;
// Set bar color to yellow
SendMessage(ProgressBar1.Handle, PBM_SETBARCOLOR, 0, clYellow);
end;
(7).住点移动时编辑框色彩不同。
procedure TForm1.Edit1Enter(Sender: TObject);
begin
(sender as tedit).Color:=clred;
end;
procedure TForm1.Edit1Exit(Sender: TObject);
begin
(sender as tedit).Color:=clwhite;
end;
(8).备份和恢复
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
try
adoconnection1.Connected:=False;
adoconnection1.ConnectionString:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source=FRIEND-YOFZKSCO;'+
'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=FRIEND-YOFZKSCO;Use Encryption for Data=False;Tag with column collation when possible=False';
adoconnection1.Connected:=True;
with adoQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('Backup DataBase sfa to disk ='''+opendialog1.FileName+'''');
ExecSQL;
end;
except
ShowMessage('±?·Y꧰ü');
Exit;
end;
end;
Application.MessageBox('1§?2?ú￡?êy?Y±?·Y3é1|','ìáê?',MB_OK + MB_ICONINFORMATION);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
try
adoconnection1.Connected:=false;
adoconnection1.ConnectionString:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source=FRIEND-YOFZKSCO;'+
'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=FRIEND-YOFZKSCO;Use Encryption for Data=False;Tag with column collation when possible=False';
adoconnection1.Connected:=true;
with adoQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('Restore DataBase sfa from disk ='''+opendialog1.FileName+'''');
ExecSQL;
end;
except
ShowMessage('???′꧰ü');
Exit;
end;
end;
Application.MessageBox('1§?2?ú￡?êy?Y???′3é1|','ìáê?',MB_OK + MB_ICONINFORMATION);
end;
(9).查找局域网上的sqlserver报务器。
uses Comobj;
procedure TForm1.Button1Click(Sender: TObject);
var
SQLServer:Variant;
ServerList:Variant;
i,nServers:integer;
sRetValue:String;
begin
SQLServer := CreateOleObject('SQLDMO.Application');
ServerList:= SQLServer.ListAvailableSQLServers;
nServers:=ServerList.Count;
for i := 1 to nservers do
ListBox1.Items.Add(ServerList.Item(i));
SQLServer:=NULL;
serverList:=NULL;
end;
(10).窗体打开时的淡入效果。
procedure TForm1.FormCreate(Sender: TObject);
begin
AnimateWindow (Handle, 400, AW_CENTER);
end;
(11).动态创建窗体。
procedure TForm1.Button1Click(Sender: TObject);
begin
try
form2:=Tform2.Create(self);
form2.ShowModal;
finally
form2.Free;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
form1:=nil;
end;
(12).复制文件。
procedure TForm1.Button1Click(Sender: TObject);
begin
try
copyfileA(pchar('C:/AAA.txt'),pchar('D:/AAA.txt'),false);
except
showmessage('sfdsdf');
end;
end;
(13).复制文件夹。
uses shellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
lpFileOp: TSHFileOpStruct;
begin
with lpFileOp do
begin
Wnd:=Self.Handle;
wfunc:=FO_COPY;
pFrom:=pchar('C:/AAA');
pTo:=pchar('D:/AAA');
fFlags:=FOF_ALLOWUNDO;
hNameMappings:=nil;
lpszProgressTitle:=nil;
fAnyOperationsAborted:=True;
end;
if SHFileOperation(lpFileOp)<>0 then
ShowMessage('删除失败');
end;
(14).改变Dbgrid的选定色。
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
if gdSelected in state then
SetBkColor(dbgrid1.canvas.handle,clgreen)
else
setbkcolor(dbgrid1.canvas.handle,clwhite);
dbgrid1.Canvas.TextRect(rect,0,0,field.AsString);
dbgrid1.Canvas.Textout(rect.Left,rect.Top,field.AsString);
end;
(15).检测系统是否已安装了ADO。
uses registry;
function Tform1.ADOInstalled:Boolean;
var
r:TRegistry;
s:string;
begin
r := TRegistry.create;
try
with r do
begin
RootKey := HKEY_CLASSES_ROOT;
OpenKey( '/ADODB.Connection/CurVer', false );
s := ReadString('');
if s <> '' then Result := True
else Result := False;
CloseKey;
end;
finally
r.free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if ADOInstalled then showmessage('this computer has installed ADO');
end;
(16).取利主机的ip地址。
uses winsock;
procedure TForm1.Button1Click(Sender: TObject);
var
IP:string;
IPstr:String;
buffer:array[1..32] of char;
i:integer;
WSData:TWSAdata;
Host:PHostEnt;
begin
if WSAstartup(2,WSData)<>0 then
begin
showmessage('WS2_32.DLL3?ê??ˉ꧰ü.');
exit;
end;
try
if GetHostname(@buffer[1],32)<>0 then
begin
showmessage('??óDμ?μ??÷?ú??.');
exit;
end;
except
showmessage('??óD3é1|·μ???÷?ú??');
exit;
end;
Host:=GetHostbyname(@buffer[1]);
if Host=nil then
begin
showmessage('IPμ??·?a??.');
exit;
end
else
begin
edit2.Text:=Host.h_name;
edit3.Text:=chr(host.h_addrtype+64);
for i:=1 to 4 do
begin
IP:=inttostr(ord(host.h_addr^[i-1]));
if i<4 then
ipstr:=ipstr+IP+'.'
else
edit1.Text:=ipstr+ip;
end;
end;
WSACleanup;
end;
(17).取得计算机名。
function tform1.get_name:string;
var ComputerName: PChar; size: DWord;
begin
GetMem(ComputerName,255);
size:=255;
if GetComputerName(ComputerName,size)=False then
result:=''
else
result:=ComputerName;
FreeMem(ComputerName);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption:=get_name;
end;
(18).取得硬盘序列号。
function tform1.GetHDSerialNumber: LongInt;
{$IFDEF WIN32}
var
pdw : pDWord;
mc, fl : dword;
{$ENDIF}
begin
{$IfDef WIN32}
New(pdw);
GetVolumeInformation('c:/',nil,0,pdw,mc,fl,nil,0);
Result := pdw^;
dispose(pdw);
{$ELSE}
Result := GetWinFlags;
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.Text:=inttostr(gethdserialnumber);
end;
(19).限定光标移动范围。
procedure TForm1.Button1Click(Sender: TObject);
var
rect1:trect;
begin
rect1:=button2.BoundsRect;
mapwindowpoints(handle,0,rect1,2);
clipcursor(@rect1);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
screenrect:trect;
begin
screenrect:=rect(0,0,screen.Width,screen.Height);
clipcursor(@screenrect);
end;
(20).限制edit框只能输入数字。
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (key in ['0'..'9','.',#8]) then
begin
key:=#0;
Messagebeep(0);
end;
end;
(21).dbgrid中根据任一条件某一格变色。
procedure TForm_main.DBGridEh1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumnEh;
State: TGridDrawState);
begin
if (trim(DataModule1.ADOQuery1.FieldByName('dczt').AsString)='OK') then
begin
if datacol=6 then
begin
DbGrideh1.Canvas.Brush.Color:=clGradientActiveCaption;
DbGrideh1.DefaultDrawColumnCell(Rect,datacol,column,state);
end;
end;
end;
(22).打开word文件。
procedure TfjfsglForm.SpeedButton4Click(Sender: TObject);
var
MSWord: Variant;
str:string;
begin
if trim(DataModule1.adoquery27.fieldbyname('fjmc').asstring)<>'' then
begin
str:=trim(DataModule1.ADOQuery27.fieldbyname('fjmc').AsString);
MSWord:= CreateOLEObject('Word.Application');//
MSWord.Documents.Open('d:/Program Files/Common Files/Sfa/'+str, True);//
MSWord.Visible:=1;//
str:='';
MSWord.ActiveDocument.Range(0, 0);//
MSWord.ActiveDocument.Range.InsertAfter(str);//?úWord?D???ó×?·?'Title'
MSWord.ActiveDocument.Range.InsertParagraphAfter;
end
else
showmessage('');
end;
(23).word文件传入和传出数据库。
uses IdGlobal;
procedure TdjhyForm.SpeedButton2Click(Sender: TObject);
var
sfilename:string;
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;
DataModule1.ADOQuery14.Edit;
DataModule1.ADOQuery14.FieldByName('word').AsString:=blobcontenttostring(sfilename);
DataModule1.ADOQuery14.Post;
end;
end;
procedure TdjhyForm.SpeedButton1Click(Sender: TObject);
var
sfilename:string;
bs:Tadoblobstream;
begin
bs:=Tadoblobstream.Create(TBLOBfield(DataModule1.ADOQuery14.FieldByName('word')),bmread);
try
sfilename:=extractfilepath(application.ExeName)+trim(DataModule1.adoquery14.fieldbyname('hybh').AsString);
sfilename:=sfilename+'.'+'doc';
bs.SaveToFile(sfilename);
try
djhyopenform:=Tdjhyopenform.Create(self);
djhyopenform.olecontainer1.CreateObjectFromFile(sfilename,false);
djhyopenform.OleContainer1.Iconic:=true;
djhyopenform.ShowModal;
finally
djhyopenform.Free;
end;
finally
bs.free;
end;
end;
(24).中文标题的提示框。
procedure TdjhyForm.SpeedButton5Click(Sender: TObject);
begin
if Application.MessageBox('', Mb_YesNo + Mb_IconWarning) =Id_yes then DataModule1.ADOQuery14.Delete;
end;
(25).运行一应用程序文件。
WinExec('HH.EXE D:/Program files/common files/MyshipperCRM e-sales help/MyshipperCRM e-sales help.chm',SW_NORMAL);