Delphi 函数使用技巧

转自 http://blog.sina.com.cn/s/blog_4c4d069f01000811.html

//如何让窗口闪烁，就象qq有消息时候！
   procedure TForm1.Timer1Timer(Sender: TObject);
     begin
         FlashWindow(Form1.Handle, TRUE);
         FlashWindow(Application.handle, TRUE);
     end;

//窗口调用时窗口名称用变量.
a:='form2'         ;
   (application.FindComponent(a) as tform).show ;

//图表工具中,数据源的设置
DBChart1.Series[0].DataSource:=ADOQuery1;
DBChart1.Series[0].XLabelsSource:='field1' ;
DBChart1.Series[0].YValues.ValueSource:='field2';

DBChart1.ZoomPercent(100);
DBChart1.UndoZoom;
//窗口动画
  AnimateWindow(Handle,2000,AW_BLEND);
//弹出消息
Application.MessageBox(Pchar('本月【 '+变量+' 】'+#13+'有未确认的内部领料单！'),'操作提示',MB_OK+MB_IconStop+MB_SystemModal);

//刷新DBGRid内的数据
adoquery1.Requery([eoAsyncFetch]);

//返回ADOQuery1的从第5条记录开始的16条记录
adoquery.recno=5
       for 循环 12次

//在KeyPress事件中：转为大写
if (key>#96) and (Key<#123) then
key:=char(ord(Key)-32);

edit6.text:=Grdlst.GetFooterValue(0, Grdlst.Columns[6]);

//调试用
var
InsertList:TstringList;

InsertList:=TstringList.Create;
InsertList.Append(SelectSQL);
InsertList.SaveToFile('e:\DelSql\a.txt')       ;

DBChart1.LeftAxis.Maximum:=12;

//dbgrideh是否为空
DataSource.DataSet.IsEmpty

//向下一条记录
  Grdlst.DataSource.DataSet.Next;
  Grdlst.DataSource.DataSet.Locate('Mat_no',NextMat_no,[loPartialKey]);

//使窗体标题栏闪烁
   FlashWindow(Handle,True);
   FlashWindow(Handle,False);

var
   hDesktop:THandle;
begin
   //获取桌面句柄
   hDesktop:=FindWindow('ProgMan',nil);
   //隐藏桌面上的图标
   ShowWindow(hDesktop,SW_HIDE);
  hDesktop:=FindWindow('ProgMan',nil);
   //显示桌面上的图标
   ShowWindow(hDesktop,SW_SHOW);

//禁止软件重复运行
var
   errNO:integer;
   hMutex:HWND;
begin
   hMutex:=CreateMutex(nil,False,pchar(application.title));
   errNO:=GetLastError;
   If errNO=ERROR_ALREADY_EXISTS Then begin   //检测是否重复运行
     application.MessageBox('软件重复运行','重复运行',MB_OK);
     application.Terminate;
end;
     //初始化变量
end;

  DBChart1.BottomAxis.Automatic:=false;
       DBChart1.BottomAxis.SetMinMax(A, Now);//A-Now就是你要显示的X轴的宽度

uses DateUtils;
A可以为   IncDay(Now, -5)//X轴的宽度为5天
A可以为   IncHour(Now, -3)//X轴的宽度为3小时等等

 

//对DbGrideh 进行排序
procedure TForm1.DBGridEh1TitleClick(Column: TColumnEh);
var
  sortstring: string;
begin //进行排序
  with Column do
  begin
     if FieldName = '' then
         Exit;
     case Title.SortMarker of
         smNoneEh:
             begin
                 Title.SortMarker := smDownEh;
                 sortstring := Column.FieldName + ' ASC';
             end;
         smDownEh:
                 begin
                 Title.SortMarker := smUpEh;
                 sortstring := Column.FieldName + ' ASC';
                 end;
         smUpEh:
                   begin
                   Title.SortMarker := smNoneEh;
                   sortstring := Column.FieldName + ' DESC';
                   end;
     end; //数据集排序。
     try
     adoquery1.Sort := sortstring //adoquery1为实际数据集变量名
     except
     end;
  end;
end;

//去掉dbgrideh 中的0值
procedure TForm1.ADOTable1bGetText(Sender: TField; var Text: String;
   DisplayText: Boolean);
begin
  if trim(sender.AsString)='0' then
       Text:=''
   else
   Text:=sender.AsString;

end;

//去掉dbgrideh 中的0值
procedure TForm1.DBGridEh1DrawColumnCell
IF Column.Field.DataType=ftFloat   Then
       IF Column.Field.AsFloat=0 Then
           表格名.Canvas.TextRect(Rect,rect.Left,rect.Top,'');

 

//动态修改显示器分辨率
procedure TForm1.FormCreate(Sender: TObject);
var
  x,y:longint;
begin
  form1.Scaled :=true;
   x:= GetSystemMetrics(SM_CXSCREEN);
   y:= GetSystemMetrics(SM_CYSCREEN);
   if (x<>800 ) or (y<>600) then
     begin
           form1.Height :=form1.Height*x div 800;
           form1.Width :=form1.Width*y div 600;
           scaleby(x,800);
     end;
end;

//*********向某个字段的下一行移动

procedure TForm1.DBGridEh1KeyPress(Sender: TObject; var Key: Char);
begin
If not (screen.ActiveControl is TDBGridEh) then
  if (Key = #13) then
  begin
         Key := #0;
         PerForm(Wm_NextDlgCtl,0,0)
  end;
If (screen.ActiveControl is TDBGridEh) and (grdlst.DataSource.DataSet<>nil)
     and (grdlst.DataSource.DataSet.Active) and (Key = #13) then
begin
     grdlst.DataSource.DataSet.Next;
     IF grdlst.DataSource.DataSet.Eof then
           grdlst.DataSource.DataSet.Last;
end;
end;

//新增记录时某个字段的赋给一个值.
procedure TForm1.ADOQuery1NewRecord(DataSet: TDataSet);
begin
adoquery1.FieldByName('a').Value:='kkk';
end;

//窗体不断振动
procedure TForm1.Button1Click(Sender: TObject);
var
   N         : Integer; //Counter
   TL,TT : Integer; //Backup for LEFT and TOP of teh FORM
begin
   TL := Left; //Backups Left of the Form
   TT := Top;   //Backups Top   of the Form
   for N:=1 to 100 do begin   //Counter Time
     Left:= (TL-10) + (Random(20)); {Shake Range in Horizontal Driection}
     Top := (TT-10) + (Random(20)); {Shake Range in Vertical     Driection}
   end;
   Left := TL; //Restores Left of the Form
   Top   := TT; //Restores Top   of the Form
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   myfilepath,targerfile: String;
begin
   myfilepath:= 'e:\a.txt';         //源
   targerfile:='\\cwb_42_jck2\stom\a.txt';       //目标
   if not fileexists(targerfile) then
   begin
       copyfile(pchar(myfilepath),pchar(targerfile),true);
       showmessage('ok');
   end;
end;

TPrintDBGridEh1.PageFooter.CenterText.Add('&[Pages] - &[Page]');
在printdbgrideh里有很多参数可以用：
&[Page]--当前页码
&[ShortDate]、&[Date]、&[LongDate]--当前日期
&[Time]--时间
&[Pages]--总页数

var
   shelpfile:string;
begin
   sHelpFile:=ExtractFilePath(Application.ExeName)+'books.chm';
   HtmlHelp( handle, sHelpFile,HH_DISPLAY_TOPIC, nil);
end;

//每行显示3个中文字
Function DivideStrToLine(In_Str:String;In_StrPerLine:Integer):String;
var
   iLine,iIndex,iLength:Integer;
Begin
   Result   := '';
   iLength := Length(In_Str);
   iIndex   := 1;
   iLine     := 1;
   while (iIndex <= iLength) do
   Begin
       if (ByteType(In_Str,iIndex) = mbSingleByte) then
       Begin
           Result := Result + Copy(In_Str,iIndex,1);
           Inc(iIndex);
       End
       Else
       if (ByteType(In_Str,iIndex) = mbLeadByte) then
       Begin
           Result   := Result + Copy(In_Str,iIndex,2);
           iIndex   := iIndex + 2;
       End;
       if ((iIndex < iLength) and (iIndex >= iLine * In_StrPerLine)) then
       Begin
           Result := Result + #13;
           Inc(iLine) ;
       End;
   End;
End;
  DBChart1.Series[0].XLabel[1]:=DivideStrToLine('中国人民解放军中共中央政治局委员',6);;
 
  DBChart1.Series[0].DataSource:=ADOQuery1;
   DBChart1.Series[0].XLabelsSource:='field1' ;
   DBChart1.Series[0].YValues.ValueSource:='field2';
   DBChart1.BottomAxis.LabelsMultiLine := true;
  DBChart1.Series[0].XLabel[0]:='abc'+#13+'def';

 

var
   memo1:Tfrxmemoview;
begin
  memo1:= frxReport1.FindObject('memo4') as   Tfrxmemoview;
  memo1.Text:='linweiqianglinweiqiang';
  frxReport1.ShowReport;
end;

 

(1)直接显示当前记录
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Bitmap.Assign(Table1Bitmap);
  //Table1Bitmap为在Table中添加的字段
       // DBImage1.Picture.Bitmap.Assign(adoquery1.FieldByName('b')) ;
end;

(2)直接显示
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Bitmap.Assign(
     TBLOBField(Table1.Fields[1]));
       //DBImage1.Picture.Bitmap.Assign(TBLOBField(adoquery1.Fields[1])) ;
end;
//Image1.Picture.Bitmap.Assign(Table1.Fields[1]);也行

 

把BMP图片保存进数据库
procedure TForm1.Button1Click(Sender: TObject);
var
     s:tstream;
begin
s:=tfilestream.Create('d:\a.bmp',fmopenread);
try
with adoquery1 do
begin
sql.Clear;
sql.text:='insert into table2(a,b) values(:a,:b)';
parameters.ParamByName('a').Value:=43121;
parameters.ParamByName('b').LoadFromStream(s,ftblob);
execsql;
showmessage('ok');
end;
finally
s.Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with adoquery1 do
  begin
  sql.Clear;
  sql.Text:='select a,b from   table2';
  open;
  DBImage1.Picture.Bitmap.Assign(adoquery1.FieldByName('b')) ;
  DBImage1.Picture.Bitmap.Assign(TBLOBField(adoquery1.Fields[1])) ;

  end;
  adoquery1.Close;
  showmessage('ok');
end;

把JPG图片保存进数据库

USES         JPEG;

procedure TForm1.Button3Click(Sender: TObject);
var
     JPEGImage: TJPEGImage;
     Stream: TMemoryStream;
begin
     if OpenpictureDialog1.Execute then
     begin
     JPEGImage:= TJPEGImage.Create;
     Stream:= TMemoryStream.Create;
     ADOQuery1.SQL.Text:='select * from table2 ';
     ADOQuery1.Open;
     ADOQuery1.Insert;
     JPEGImage.LoadFromFile(OpenPictureDialog1.FileName);
     JPEGImage.SaveToStream(Stream);
     TBlobField(ADOQuery1.FieldByName('Image_Picture')).LoadFromStream(Stream);
     ADOQuery1.Post;
     JPEGImage.Free;
     Stream.Free;
     end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
         tempstream:TStringStream;
         tempjpeg:TJPEGImage;
begin
   try
             ADOQuery1.SQL.Text:='select * from table2 ';
             ADOQuery1.Open;
             tempstream:=TStringStream.Create(' ');       
             TBlobField(adoQuery1.FieldByName('Image_Picture')).SaveToStream(tempstream);
             tempstream.Position:=0;
             tempjpeg:=TJPEGImage.Create;
             tempjpeg.LoadFromStream(tempstream);
             DBImage1.Picture.Bitmap.Assign(tempjpeg);
   finally
             tempstream.Free;
             tempjpeg.Free;
   end;
end;

 

查看网卡物理地址
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls,WinSock;

Function sendarp(ipaddr:ulong; temp:dword; ulmacaddr:pointer; ulmacaddrleng:pointer) : DWord; StdCall; External 'Iphlpapi.dll' Name 'SendARP';
procedure TForm1.Button1Click(Sender: TObject);
var
     myip             : ulong;
     mymac           : array[0..5] of byte;
     mymaclength: ulong;
     r                   : integer;
begin
     myip := inet_addr(PChar(edit1.Text)); //  www.csdn.net
     mymaclength := length(mymac);
     r := sendarp(myip,0,@mymac,@mymaclength);
     if   r<>0 then
         begin
           showmessage('找不到该机器!')   ;
           exit;
         end;
     edit2.Text:= format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[mymac[0],mymac[1],mymac[2],mymac[3],mymac[4],mymac[5]]);
     showmessage(format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[mymac[0],mymac[1],mymac[2],mymac[3],mymac[4],mymac[5]]));
end;