一生delphi编程经验(二)

翻译|其它|编辑:郝浩|2004-07-15 10:50:00.000|阅读 1833 次

概述:

# 界面/图表报表/文档/IDE等千款热门软控件火热销售中 >>


(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);


标签:

本站文章除注明转载外,均为本站原创或翻译。欢迎任何形式的转载,但请务必注明出处、不得修改原文相关链接,如果存在内容上的异议请邮件反馈至chenjj@evget.com


为你推荐

  • 推荐视频
  • 推荐活动
  • 推荐产品
  • 推荐文章
  • 慧都慧问
扫码咨询


添加微信 立即咨询

电话咨询

客服热线
023-68661681

TOP