Delphi小经验总结
2017-04-27 23:27
344 查看
1.
实现用鼠标点住窗体的任意位置，拖动窗体
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
releasecapture;
perform(WM_SYSCOMMAND,$f012,0);
end;
2.
//屏蔽系统功能键；
SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,nil,0);
//恢复功能键
SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,nil,0);
3.
while Frm_Login.Login_Off = False do
Application.ProcessMessages;//等待，并不断检测Frm_Login.Login_Off
ProcessMessages does not allow the application to Go idle, whereas HandleMessage
does.
4.
//不在任务栏上显示图标
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
5.
刷新局部屏幕
Rect.Left:=x-50;
Rect.Top:=y-50;
Rect.Right:=x+85;
Rect.Bottom:=y+85;
RedrawWindow(0,@Rect,0,RDW_ERASE or RDW_INVALIDATE or RDW_INTERNALPAINT or RDW_ERASENOW or RDW_ALLCHILDREN);
sleep(5); //若不延时,将不能刷新局部屏幕
6.
Alphablend:=true; //呵呵，这个就是让窗口变的透明的办法了
Alphablendvalue:=100;
FormStyle:=fsStayOnTop; //让窗体总在最前面
7.function Trunc(X: Extended): Int64; //将real转为integer形
8.delphi+ado远程连接sql server 2000服务器的问题，
ADOConnection.ConnectionString:=
'Provider=SQLOLEDB.1;Password=YourPWD;User ID=YourID;'+
'Initial Catalog=数据库名;Data Source=数据服务器名;'+
'NetWork Library=DBMSSOCN;NetWork Address=所在的IP,1433';
ADOConnection.Open;
9.通过计算机名取得IP
var
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup(2, WSAData);
HostEnt := gethostbyname(PChar(Edit2.Text));
with HostEnt^ do
sIP := Format('%d.%d.%d.%d', [Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);
WSACleanup;
10.自动填写IE的网页的输入框的内容}
{procedure TForm1.PutData;
var
ShellWindow: IShellWindows;
nCount: integer;
spDisp: IDispatch;
i,j,X: integer;
vi: OleVariant;
IE1: IWebBrowser2;
IDoc1: IHTMLDocument2;
iELC : IHTMLElementCollection ;
S,S2 : string;
HtmlInputEle : IHTMLInputElement;
HtmlSelEle : IHTMLSelectElement;
begin
ShellWindow := CoShellWindows.Create;
nCount := ShellWindow.Count;
for i := 0 to nCount - 1 do
begin
vi := i;
spDisp := ShellWindow.Item(vi);
if spDisp = nil then continue;
spDisp.QueryInterface( iWebBrowser2, IE1 );
if IE1 <> nil then
begin
IE1.Document.QueryInterface(IHTMLDocument2,iDoc1);
if iDoc1 <> nil then
begin
ielc:=idoc1.Get_all;
for j:=0 to ielc.length-1 do
begin
Application.ProcessMessages;
spDisp := ielc.item(J, 0);
if SUCCEEDED(spDisp.QueryInterface(IHTMLInputElement ,HtmlInputEle))then
with HtmlInputEle do
begin
S2:=Type_;
S2:=UpperCase(S2);
//我把所有的input都填上 try ， checkbox 都打勾
if (StrComp(PChar(S2),'TEXT')=0) or (StrComp(PChar(S2),'PASSWORD')=0) then
value :='try' //S:=S+#9+Value
else if StrComp(PChar(S2),'CHECKBOX')=0 then
begin
checked := True;
end;
end;
if SUCCEEDED(spDisp.QueryInterface(IHTMLselectelement ,HtmlSelEle))then
with HtmlSelEle, Memo1.Lines do
begin
S:=S+#9+IntToStr(selectedIndex+1); //这个是获取数据了
end;
end; //END FOR
Memo2.Lines.Add(S);
exit;
end;
end;
end;
end;
}
11.访问作者主页：shellexecute(handle,nil,pchar('http://www.jijian.sdu.edu.cn/shaojian'),nil,nil,sw_shownormal);
12.给MDI主窗口加背景
在MDI程序中,由于MDI的主窗口一般的功能是提供子窗口显示的位置和提供菜单、工具条、状态条等，而窗口的客户区则一般不会有其它的用途，如果在这里画上一些软件的标志、公司的标志或者其它的背景图案的话，不仅可以使MDI的主窗口更加充实、美观，而且还可以更加突出公司的形象和增加公司标志在客户心中的地位。
由于MDI主窗口的特性，使用普通OnPaint和使用TImage等方法都不会产生作用。下面将用编写一个简单的MDI程序来介绍如何实现。
第一步：打开Delphi(Delphi 1,2,3都可以)，创建一个新的工程。
第二步：将Form1的FormStyle设置为fsMDIForm，设置成MDI的主窗口。
第三步：在Form1上增加一个Image元件，并选择要设置的背景到Image的Picture中。
第四步：在Form1的Private中定义：
FClientInstance,
FPrevClientProc : TFarProc;
PROCEDURE ClientWndProc(VAR Message: TMessage);
第五步：在实现(implementation)中加入上述过程的具体内容：
PROCEDURE TForm1.ClientWndProc(VAR Message: TMessage);
VAR
MyDC : hDC;
Ro, Co : Word;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
FOR Ro := 0 TO ClientHeight DIV Image1.Picture.Height DO
FOR Co := 0 TO ClientWIDTH DIV Image1.Picture.Width DO
BitBlt(MyDC, Co*Image1.Picture.Width, Ro*Image1.Picture.Height,
Image1.Picture.Width, Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
第六步：在Form1的创建事件中加入：
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
上面的步骤已经完成了MDI主窗口背景图案的设置，下面可以增加一个MDIChild窗口，实现MDI程序。
第七步：新增加一个Form，并将FormStyle设置为fsMDIChild。
现在你可以编译运行这个程序，你会发现，Image元件并不会在Form上显示出来，但是整个Form的客户区域被Image中的图像所铺满。
(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);
1.关于MDI主窗体背景新解
在Form中添加Image控件
设BMP图象
name为 IMG_BK
在Foem的Create事件中写入
Self.brush.bitmap:=img_bk.picture.bitmap;
2.在标题栏处画VCL控件(一行解决问题!!!)
在 form 的onpaint 事件中
控件.pointto(getdc(0),left,top);
3 Edit 中只输入数字
SetWindowLong(Edit1.Handle, GWL_STYLE,
GetWindowLong(Edit1.Handle, GWL_STYLE) or
ES_NUMBER);
4.类似MDI方式新解
在要设置child的oncreate方式下写入:
self.parent:='要设置为mainform的Form';
5. 屏幕的Refresh(只需一行!)
RedrawWindow(0,nil,0,RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
| |
--- ----
handle RGN(可刷新局部屏幕)
6.类似DOS下的CLS指令的WINDOWS指令!
paintdesktop(getdc(0));
7.扩展控件新功能
在编程中 ,我们经常要控制控件的动作,但该控件又没有提供该方法
这时 ,可通过发消息给该控件 ,以达到我们的目的!
如:
button1.perform(wm_keydown,13,0);
listbox1.perform(wm_vscroll,sb_linedown,0);
等等 可少去 重载之苦!!!!!
8.闪烁标题如打印机超时(一行)
form 放一timer 控件
time 事件 中 写入 ;
flashwindow(application.handle,true);
9.在桌面上加个VCL控件!(不是画的,不可refresh)
windows.setparent(控件.handle,0);
注: 想放哪都行 (如'开始处状态栏')
10.关于 '类似MDI方式新解(一行就行!!!!)'的修正
windows.setparent(self.handle,'要设置为mainform的Form');
11 普通Form象MDI中mainform始终在最底层
SetActiveWindow(0);
或 SetwindowPos(...);
12 执行下列语句开始Windows屏幕保护程序
SendMessage(HWND_BROADCAST,WM_SYSCOMMAND,SC_SCREENSAVE,0);
13 button 的 caption 多行显示：
SetWindowLong(Button1.handle, GWL_STYLE,
GetWindowlong(Button1.Handle, GWL_STYLE) or
BS_MULTILINE);
必要时加上 Button1.Invalidate;
14.整死windows98 :)
asm int $19 end
//实现使窗口的关闭变灰(h: 窗口的句柄)
function TFrmPublic.GrayedCloseItem(h: HWND): Boolean;
var
hM: HMENU;
begin
if h <> 0 then //有效句柄
begin
hM := GetSystemMenu(h, False);
result := EnableMenuItem(hM,SC_CLOSE,MF_BYCOMMAND+MF_DISABLED+MF_GRAYED);
end
else
result := False;
end;
//实现使窗口的关闭有效(h: 窗口的句柄)
function TFrmPublic.EnableCloseItem(h: HWND): Boolean;
var
hM: HMENU;
begin
if h <> 0 then //有效句柄
begin
hM := GetSystemMenu(h, False);
result := EnableMenuItem(hM,SC_CLOSE,MF_BYCOMMAND+MF_ENABLED);
end
else
result := False;
end;
function GetKbStatus():string;
//返回当前键盘状态，包括NumLoce、Caps Lock、Insert
//每个状态信息占两个字符，顺序为:NumLoce、Caps Lock、Insert
//Copy Right 549@11:29 2003-7-22
var Status:string;
KeyStates:TKeyboardState;
begin
GetKeyboardState(KeyStates);
if Odd(KeyStates[VK_NUMLOCK])then
Status:='数字'
else
Status:='光标';
if Odd(KeyStates[VK_CAPITAL]) then
Status:=status+'大写'
else
Status:=status+'小写';
if Odd(KeyStates[VK_INSERT]) then
Status:=status+'插入'
else
Status:=status+'改写';
Result:=Status;
end;
给MDI主窗口加背景
在MDI程序中,由于MDI的主窗口一般的功能是提供子窗口显示的位置和提供菜单、工具条、状态条等，而窗口的客户区则一般不会有其它的用途，如果在这里画上一些软件的标志、公司的标志或者其它的背景图案的话，不仅可以使MDI的主窗口更加充实、美观，而且还可以更加突出公司的形象和增加公司标志在客户心中的地位。
由于MDI主窗口的特性，使用普通OnPaint和使用TImage等方法都不会产生作用。下面将用编写一个简单的MDI程序来介绍如何实现。
第一步：打开Delphi(Delphi 1,2,3都可以)，创建一个新的工程。
第二步：将Form1的FormStyle设置为fsMDIForm，设置成MDI的主窗口。
第三步：在Form1上增加一个Image元件，并选择要设置的背景到Image的Picture中。
第四步：在Form1的Private中定义：
FClientInstance,
FPrevClientProc : TFarProc;
PROCEDURE ClientWndProc(VAR Message: TMessage);
第五步：在实现(implementation)中加入上述过程的具体内容：
PROCEDURE TForm1.ClientWndProc(VAR Message: TMessage);
VAR
MyDC : hDC;
Ro, Co : Word;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
FOR Ro := 0 TO ClientHeight DIV Image1.Picture.Height DO
FOR Co := 0 TO ClientWIDTH DIV Image1.Picture.Width DO
BitBlt(MyDC, Co*Image1.Picture.Width, Ro*Image1.Picture.Height,
Image1.Picture.Width, Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
第六步：在Form1的创建事件中加入：
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
上面的步骤已经完成了MDI主窗口背景图案的设置，下面可以增加一个MDIChild窗口，实现MDI程序。
第七步：新增加一个Form，并将FormStyle设置为fsMDIChild。
现在你可以编译运行这个程序，你会发现，Image元件并不会在Form上显示出来，但是整个Form的客户区域被Image中的图像所铺满。
]
金额改大写:
Function XTOD(I: real): String;
Const
d = '零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿';
Var
m, K : String;
j : integer;
Begin
k := '';
m := floattostr(int(I * 100));
For J := length(M) Downto 1 Do
Begin
K := k + d[(strtoint(m[length(M) - j + 1])) * 2 + 1] +
d[(strtoint(m[length(M) - j + 1])) * 2 + 2] + d[(10 + j) * 2 - 1] +
d[(10 + j) * 2];
End;
Result:=k;
End;
实现用鼠标点住窗体的任意位置，拖动窗体
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
releasecapture;
perform(WM_SYSCOMMAND,$f012,0);
end;
2.
//屏蔽系统功能键；
SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,nil,0);
//恢复功能键
SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,nil,0);
3.
while Frm_Login.Login_Off = False do
Application.ProcessMessages;//等待，并不断检测Frm_Login.Login_Off
ProcessMessages does not allow the application to Go idle, whereas HandleMessage
does.
4.
//不在任务栏上显示图标
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
5.
刷新局部屏幕
Rect.Left:=x-50;
Rect.Top:=y-50;
Rect.Right:=x+85;
Rect.Bottom:=y+85;
RedrawWindow(0,@Rect,0,RDW_ERASE or RDW_INVALIDATE or RDW_INTERNALPAINT or RDW_ERASENOW or RDW_ALLCHILDREN);
sleep(5); //若不延时,将不能刷新局部屏幕
6.
Alphablend:=true; //呵呵，这个就是让窗口变的透明的办法了
Alphablendvalue:=100;
FormStyle:=fsStayOnTop; //让窗体总在最前面
7.function Trunc(X: Extended): Int64; //将real转为integer形
8.delphi+ado远程连接sql server 2000服务器的问题，
ADOConnection.ConnectionString:=
'Provider=SQLOLEDB.1;Password=YourPWD;User ID=YourID;'+
'Initial Catalog=数据库名;Data Source=数据服务器名;'+
'NetWork Library=DBMSSOCN;NetWork Address=所在的IP,1433';
ADOConnection.Open;
9.通过计算机名取得IP
var
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup(2, WSAData);
HostEnt := gethostbyname(PChar(Edit2.Text));
with HostEnt^ do
sIP := Format('%d.%d.%d.%d', [Byte(h_addr^[0]), Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);
WSACleanup;
10.自动填写IE的网页的输入框的内容}
{procedure TForm1.PutData;
var
ShellWindow: IShellWindows;
nCount: integer;
spDisp: IDispatch;
i,j,X: integer;
vi: OleVariant;
IE1: IWebBrowser2;
IDoc1: IHTMLDocument2;
iELC : IHTMLElementCollection ;
S,S2 : string;
HtmlInputEle : IHTMLInputElement;
HtmlSelEle : IHTMLSelectElement;
begin
ShellWindow := CoShellWindows.Create;
nCount := ShellWindow.Count;
for i := 0 to nCount - 1 do
begin
vi := i;
spDisp := ShellWindow.Item(vi);
if spDisp = nil then continue;
spDisp.QueryInterface( iWebBrowser2, IE1 );
if IE1 <> nil then
begin
IE1.Document.QueryInterface(IHTMLDocument2,iDoc1);
if iDoc1 <> nil then
begin
ielc:=idoc1.Get_all;
for j:=0 to ielc.length-1 do
begin
Application.ProcessMessages;
spDisp := ielc.item(J, 0);
if SUCCEEDED(spDisp.QueryInterface(IHTMLInputElement ,HtmlInputEle))then
with HtmlInputEle do
begin
S2:=Type_;
S2:=UpperCase(S2);
//我把所有的input都填上 try ， checkbox 都打勾
if (StrComp(PChar(S2),'TEXT')=0) or (StrComp(PChar(S2),'PASSWORD')=0) then
value :='try' //S:=S+#9+Value
else if StrComp(PChar(S2),'CHECKBOX')=0 then
begin
checked := True;
end;
end;
if SUCCEEDED(spDisp.QueryInterface(IHTMLselectelement ,HtmlSelEle))then
with HtmlSelEle, Memo1.Lines do
begin
S:=S+#9+IntToStr(selectedIndex+1); //这个是获取数据了
end;
end; //END FOR
Memo2.Lines.Add(S);
exit;
end;
end;
end;
end;
}
11.访问作者主页：shellexecute(handle,nil,pchar('http://www.jijian.sdu.edu.cn/shaojian'),nil,nil,sw_shownormal);
12.给MDI主窗口加背景
在MDI程序中,由于MDI的主窗口一般的功能是提供子窗口显示的位置和提供菜单、工具条、状态条等，而窗口的客户区则一般不会有其它的用途，如果在这里画上一些软件的标志、公司的标志或者其它的背景图案的话，不仅可以使MDI的主窗口更加充实、美观，而且还可以更加突出公司的形象和增加公司标志在客户心中的地位。
由于MDI主窗口的特性，使用普通OnPaint和使用TImage等方法都不会产生作用。下面将用编写一个简单的MDI程序来介绍如何实现。
第一步：打开Delphi(Delphi 1,2,3都可以)，创建一个新的工程。
第二步：将Form1的FormStyle设置为fsMDIForm，设置成MDI的主窗口。
第三步：在Form1上增加一个Image元件，并选择要设置的背景到Image的Picture中。
第四步：在Form1的Private中定义：
FClientInstance,
FPrevClientProc : TFarProc;
PROCEDURE ClientWndProc(VAR Message: TMessage);
第五步：在实现(implementation)中加入上述过程的具体内容：
PROCEDURE TForm1.ClientWndProc(VAR Message: TMessage);
VAR
MyDC : hDC;
Ro, Co : Word;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
FOR Ro := 0 TO ClientHeight DIV Image1.Picture.Height DO
FOR Co := 0 TO ClientWIDTH DIV Image1.Picture.Width DO
BitBlt(MyDC, Co*Image1.Picture.Width, Ro*Image1.Picture.Height,
Image1.Picture.Width, Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
第六步：在Form1的创建事件中加入：
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
上面的步骤已经完成了MDI主窗口背景图案的设置，下面可以增加一个MDIChild窗口，实现MDI程序。
第七步：新增加一个Form，并将FormStyle设置为fsMDIChild。
现在你可以编译运行这个程序，你会发现，Image元件并不会在Form上显示出来，但是整个Form的客户区域被Image中的图像所铺满。
(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);
1.关于MDI主窗体背景新解
在Form中添加Image控件
设BMP图象
name为 IMG_BK
在Foem的Create事件中写入
Self.brush.bitmap:=img_bk.picture.bitmap;
2.在标题栏处画VCL控件(一行解决问题!!!)
在 form 的onpaint 事件中
控件.pointto(getdc(0),left,top);
3 Edit 中只输入数字
SetWindowLong(Edit1.Handle, GWL_STYLE,
GetWindowLong(Edit1.Handle, GWL_STYLE) or
ES_NUMBER);
4.类似MDI方式新解
在要设置child的oncreate方式下写入:
self.parent:='要设置为mainform的Form';
5. 屏幕的Refresh(只需一行!)
RedrawWindow(0,nil,0,RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
| |
--- ----
handle RGN(可刷新局部屏幕)
6.类似DOS下的CLS指令的WINDOWS指令!
paintdesktop(getdc(0));
7.扩展控件新功能
在编程中 ,我们经常要控制控件的动作,但该控件又没有提供该方法
这时 ,可通过发消息给该控件 ,以达到我们的目的!
如:
button1.perform(wm_keydown,13,0);
listbox1.perform(wm_vscroll,sb_linedown,0);
等等 可少去 重载之苦!!!!!
8.闪烁标题如打印机超时(一行)
form 放一timer 控件
time 事件 中 写入 ;
flashwindow(application.handle,true);
9.在桌面上加个VCL控件!(不是画的,不可refresh)
windows.setparent(控件.handle,0);
注: 想放哪都行 (如'开始处状态栏')
10.关于 '类似MDI方式新解(一行就行!!!!)'的修正
windows.setparent(self.handle,'要设置为mainform的Form');
11 普通Form象MDI中mainform始终在最底层
SetActiveWindow(0);
或 SetwindowPos(...);
12 执行下列语句开始Windows屏幕保护程序
SendMessage(HWND_BROADCAST,WM_SYSCOMMAND,SC_SCREENSAVE,0);
13 button 的 caption 多行显示：
SetWindowLong(Button1.handle, GWL_STYLE,
GetWindowlong(Button1.Handle, GWL_STYLE) or
BS_MULTILINE);
必要时加上 Button1.Invalidate;
14.整死windows98 :)
asm int $19 end
//实现使窗口的关闭变灰(h: 窗口的句柄)
function TFrmPublic.GrayedCloseItem(h: HWND): Boolean;
var
hM: HMENU;
begin
if h <> 0 then //有效句柄
begin
hM := GetSystemMenu(h, False);
result := EnableMenuItem(hM,SC_CLOSE,MF_BYCOMMAND+MF_DISABLED+MF_GRAYED);
end
else
result := False;
end;
//实现使窗口的关闭有效(h: 窗口的句柄)
function TFrmPublic.EnableCloseItem(h: HWND): Boolean;
var
hM: HMENU;
begin
if h <> 0 then //有效句柄
begin
hM := GetSystemMenu(h, False);
result := EnableMenuItem(hM,SC_CLOSE,MF_BYCOMMAND+MF_ENABLED);
end
else
result := False;
end;
function GetKbStatus():string;
//返回当前键盘状态，包括NumLoce、Caps Lock、Insert
//每个状态信息占两个字符，顺序为:NumLoce、Caps Lock、Insert
//Copy Right 549@11:29 2003-7-22
var Status:string;
KeyStates:TKeyboardState;
begin
GetKeyboardState(KeyStates);
if Odd(KeyStates[VK_NUMLOCK])then
Status:='数字'
else
Status:='光标';
if Odd(KeyStates[VK_CAPITAL]) then
Status:=status+'大写'
else
Status:=status+'小写';
if Odd(KeyStates[VK_INSERT]) then
Status:=status+'插入'
else
Status:=status+'改写';
Result:=Status;
end;
给MDI主窗口加背景
在MDI程序中,由于MDI的主窗口一般的功能是提供子窗口显示的位置和提供菜单、工具条、状态条等，而窗口的客户区则一般不会有其它的用途，如果在这里画上一些软件的标志、公司的标志或者其它的背景图案的话，不仅可以使MDI的主窗口更加充实、美观，而且还可以更加突出公司的形象和增加公司标志在客户心中的地位。
由于MDI主窗口的特性，使用普通OnPaint和使用TImage等方法都不会产生作用。下面将用编写一个简单的MDI程序来介绍如何实现。
第一步：打开Delphi(Delphi 1,2,3都可以)，创建一个新的工程。
第二步：将Form1的FormStyle设置为fsMDIForm，设置成MDI的主窗口。
第三步：在Form1上增加一个Image元件，并选择要设置的背景到Image的Picture中。
第四步：在Form1的Private中定义：
FClientInstance,
FPrevClientProc : TFarProc;
PROCEDURE ClientWndProc(VAR Message: TMessage);
第五步：在实现(implementation)中加入上述过程的具体内容：
PROCEDURE TForm1.ClientWndProc(VAR Message: TMessage);
VAR
MyDC : hDC;
Ro, Co : Word;
begin
with Message do
case Msg of
WM_ERASEBKGND:
begin
MyDC := TWMEraseBkGnd(Message).DC;
FOR Ro := 0 TO ClientHeight DIV Image1.Picture.Height DO
FOR Co := 0 TO ClientWIDTH DIV Image1.Picture.Width DO
BitBlt(MyDC, Co*Image1.Picture.Width, Ro*Image1.Picture.Height,
Image1.Picture.Width, Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
第六步：在Form1的创建事件中加入：
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
上面的步骤已经完成了MDI主窗口背景图案的设置，下面可以增加一个MDIChild窗口，实现MDI程序。
第七步：新增加一个Form，并将FormStyle设置为fsMDIChild。
现在你可以编译运行这个程序，你会发现，Image元件并不会在Form上显示出来，但是整个Form的客户区域被Image中的图像所铺满。
]
金额改大写:
Function XTOD(I: real): String;
Const
d = '零壹贰叁肆伍陆柒捌玖分角元拾佰仟万拾佰仟亿';
Var
m, K : String;
j : integer;
Begin
k := '';
m := floattostr(int(I * 100));
For J := length(M) Downto 1 Do
Begin
K := k + d[(strtoint(m[length(M) - j + 1])) * 2 + 1] +
d[(strtoint(m[length(M) - j + 1])) * 2 + 2] + d[(10 + j) * 2 - 1] +
d[(10 + j) * 2];
End;
Result:=k;
End;
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- DELPHI性能优化的经验总结
- Delphi经验总结(1)
- [转载]Delphi中消息经验总结.
- Delphi经验总结(3)
- Delphi小经验总结
- delphi项目开发经验2008年09月18日 星期四 10:07随着项目的失败，这些天一直在总结失败的原因，到底是为什么？
- Delphi调用WebService（通过SoapHeader认证）经验总结
- Delphi经验总结(2)
- 由PPP项目总结的几点项目经验
- 关于ASPNET在IIS一些问题的经验总结
- Delphi程序设计之--经验技巧
- 在.NET中调用Oracle9i存储过程经验总结
- 关于ASP.NET在IIS一些问题的经验总结
- [导入]Delphi开发经验四则
- 在.NET中调用Oracle9i存储过程经验总结
- 定义变量也是如此痛苦，经验值得总结。
- arcims开发经验总结(1) （aimsLayers.js 文件变量含义）
- arcims开发经验总结(2) (地图放大缩小、鹰眼实现逻辑)
- 大项目研发经验总结之摩西十戒
- 考完了托福，总结一下9天复习参加托福的经验吧