Delphi小经验总结

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;