function.pas

功能包中的大部分功能模块为本人自己所写。。部分收录我的网友的作品及网上比较精典的程序段。

//________________________________________________________________________________

{-------------------------------}
{  得到程序的当前目录           }
{并将exeName与得到的path合成返回}
{-------------------------------}
Function TFun.GetAppPath(AddLastName:string):string;
begin
  //默认为application.exename
  result:=ExTractFilePath(application.ExeName)+AddLastName;
end;
//________________________________________________________________________________

{----------------------}
{  显示或掩藏TaskBar  }
{----------------------}
procedure TFun.HideTaskBar(bHide:boolean=False);
var
  TaskBarHWN:integer;
begin
  TaskBarHWN:=Findwindow('Shell_TrayWnd',nil);
  if not bhide then
    SetWindowPos(TaskBarHWN,0,0,0,0,0,SWP_HIDEWINDOW)
  else
  SetWindowPos(TaskBarHWN,0,0,0,0,0,SWP_SHOWWINDOW)
end;
//________________________________________________________________________________
{-----------------------------}
{      模拟鼠标click          }
{-----------------------------}
procedure TFun.SendMouseClick(const WinHandle: HWND;
                              const PosX,PosY: integer;
                              const ClickFlag:TClickType);
begin
   case ClickFlag of
      leftDown:Sendmessage(WinHandle,WM_LButtonDown,0,PosX+PosY*65536);//左键按下
     rightDown:Sendmessage(WinHandle,WM_RButtonDown,0,PosX+PosY*65536);//右键按下
       midDown:Sendmessage(WinHandle,WM_MBUTTONDOWN,0,PosX+PosY*65536);//中间键按下
       //-----
        leftUp:Sendmessage(WinHandle,WM_LButtonUp,0,PosX+PosY*65536);//左键放开
       rightUp:Sendmessage(WinHandle,WM_RButtonUp,0,PosX+PosY*65536);//右键放开
         midUp:Sendmessage(WinHandle,WM_MButtonUp,0,PosX+PosY*65536);//中键放开
       //-----
        leftDB:Sendmessage(WinHandle,WM_LBUTTONDBLCLK,0,PosX+PosY*65536);//左键双击
       rightDB:Sendmessage(WinHandle,WM_RBUTTONDBLCLK,0,PosX+PosY*65536);//左键双击
         midDB:Sendmessage(WinHandle,WM_MBUTTONDBLCLK,0,PosX+PosY*65536);//中键双击
   end;
end;
//________________________________________________________________________________
{-------------------}
{  *模拟键盘事件*   }
{-------------------}
procedure TFun.SendKey(const WinHandle: HWND; const Vkey: word;
  const KeyClickFlag: TClickType);
begin
  case KeyClickFlag of
    vkeyDown:postMessage(WinHandle,WM_KEYDOWN,vkey,MapVirtualKey(Vkey,0));
      vkeyUp:postMessage(WinHandle,WM_KEYUP,vkey,MapVirtualKey(Vkey,0));
   vkeyClick:
       begin
        postMessage(WinHandle,WM_KEYDOWN,vkey,MapVirtualKey(Vkey,0));
        postMessage(WinHandle,WM_KEYUP,vkey,MapVirtualKey(Vkey,0));
       end; 
  end;
end;
//________________________________________________________________________________

{----------------------------}
{   得到指定窗体的大小       }
{得到的坐标为全屏坐标        }
{----------------------------}
procedure TFun.GetWinRect(const WinHandle: HWND; var winRect: TwinRect);
var
  R:TRect;
begin
  GetWindowRect(winHandle,R);
  winRect.Top:=R.Top;
  winRect.Left:=R.Left;
  winRect.Width:=R.Right-r.Left;
  winRect.Height:=R.Bottom-R.Top
end;
//________________________________________________________________________________
{-----------------------}
{ 分钟到标准时间的转换  }
{ mm===>hh:mm:ss        }
{2004-3-30号修正        }
{-----------------------}
function TFun.MinuteToTime(Minute: Double): TdateTime;
var
  ihh,imm,iss:integer;
begin
    ihh:=Round(Minute/60-0.5);//得到 时
    imm:=round(Minute-ihh*60-0.5);       //得到 分
    iss:=round((minute-ihh*60-imm)*100-0.5);//得到秒
    //----------得到秒后再重算一次---------
    imm:=imm+iss div 60;
    if iss>60 then iss:=iss-60;
    ihh:=ihh+imm div 60;
    if ihh>12 then ihh:=ihh-12*round(ihh / 12-0.5);
  result:=strTotime(format('%.2d:%.2d:%.2d',[ihh,imm,iss]))
end;
//______________________________________________________________________________
//--------------------------
//返回天数的MinuteToTime
//added 2004-3-30
//--------------------------
function TFun.MinuteToTime(Minute: Double;
  var DayCount: integer): TdateTime;
var
  ihh,imm,iss:integer;
begin
    DayCount:=0;
    ihh:=Round(Minute/60-0.5);//得到 时
    imm:=round(Minute-ihh*60-0.5);       //得到 分
    iss:=round((minute-ihh*60-imm)*100-0.5);
    imm:=imm+iss div 60;
    if iss>=60 then iss:=iss-60;
    ihh:=ihh+imm div 60;
    if ihh>=24 then  DayCount:=round(ihh/24);
    if ihh>=12 then ihh:=ihh-12*round(ihh/12);
  result:=strTotime(format('%.2d:%.2d:%.2d',[ihh,imm,iss]))
end;
//------------------------------------------------------------------------------
// 
//------------------------------------------------------------------------------

{--------------}
{精确毫秒级延时}
{--------------}
procedure TFun.TimeDelay(DT: Dword);
var
  TT:Dword;
begin
  TT:=GetTickCount;
  while getTickCount-TT<DT do
  application.ProcessMessages;//防止死锁
end;
//______________________________________________________________________________

{-------------------}
{  设定网络Ip地址   }
{-------------------}
procedure TFun.SetIPaddress(SIP: TNetValue;const isAuto:boolean);
var
  reg:Tregistry;
begin
  reg:=Tregistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  if reg.OpenKey('\SYSTEM\ControlSet001\Services\{6CF72061-4BB8-47D6-96CD-76886198826A}\Parameters\Tcpip',true) then
  begin
    if not isAuto then
    begin
       reg.WriteString('IpAddress',sIP.IpAddress);
       reg.WriteString('SubnetMask',sIP.SubnetMask);
       reg.WriteString('DefaultGateway',sIP.DefaultGateway);
       reg.WriteBool('EnableDHCP',false);
    end else
    begin
       reg.WriteBool('EnableDHCP',true);
       reg.WriteString('IpAddress','0.0.0.0');
    end;
  end;
  reg.CloseKey;
  reg.Free;
end;
//______________________________________________________________________________

{----------------------------------}
{得到memo的行号，当前位置，行长度等}
{----------------------------------}
procedure TFun.GetMemoMousePos(m: Tmemo;var posValue:TmemoPos);
begin
  posValue.LinePos:=sendmessage(m.Handle,EM_LINEFROMCHAR,m.SelStart,0);//得到行号
  posValue.CharPos:=sendmessage(m.Handle,EM_LINEINDEX,posValue.LinePos,0);//得到字符位置
  posValue.lineLenght:=sendmessage(m.Handle,EM_LINELENGTH,posValue.CharPos,0);//得到长的长度
end;
{重载RichEdit对像处理}
procedure TFun.GetMemoMousePos(m:TRichEdit;var posValue:TmemoPos);
begin
  posValue.LinePos:=sendmessage(m.Handle,EM_LINEFROMCHAR,m.SelStart,0);//得到行号
  posValue.CharPos:=sendmessage(m.Handle,EM_LINEINDEX,posValue.LinePos,0);//得到字符位置
  posValue.lineLenght:=sendmessage(m.Handle,EM_LINELENGTH,posValue.CharPos,0);//得到长的长度
end;
//______________________________________________________________________________
//Memo翻页
procedure TFun.setScrollPos(MHandle: Thandle; const pos: TClickType);
begin
  if pos=pageDown then
    SendMessage(MHandle,wm_Keydown,Vk_next,-1)
  else
    SendMessage(MHandle,wm_KeyUp,Vk_next,-1)
end;
//______________________________________________________________________________
{------------------------}
{   打开和关闭显示器     }
{      for  win9x        }
{------------------------}
procedure TFun.DisplayOFFON(SW: boolean);
begin
  if SW then
    (*打开显示器*)
     SendMessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,-1)
  else
    (*关闭显示器*)
    SendMessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,0)
end;
//______________________________________________________________________________
{-------------------}
{  显示和隐藏桌面   }
{-------------------}
procedure TFun.HideDesktop(sw: Boolean);
begin
  if sw then
    (*显示*)
    showWindow(findwindow('Progman',nil),sw_Show)
  else
    (*隐藏*)
     showWindow(findwindow('Progman',nil),sw_Hide)
end;
//______________________________________________________________________________
{-----------------------}
{  同时隐藏桌面和任务栏 }
{-----------------------}
procedure TFun.HideDesktopAndTaskBar(sw: Boolean);
begin
    HideTaskBar(SW);//关闭和打开显示器
    HideDesktop(sw);//显示和隐藏桌面
end;
//______________________________________________________________________________

{屏蔽ALT+F4和ALT+Ctrl+Del}
{      仅用于win9X       }
procedure TFun.DisbleQuikKey(sw: boolean);
var
  temp,iC:integer;
begin
  if sw then iC:=0 else iC:=1;
  //iC=1为屏蔽,0为恢复
 SystemParametersInfo(Spi_screensaverrunning,iC,@temp,0);
end;
//______________________________________________________________________________
{---------------------------------}
{       让程序只运行一次          }
{---------------------------------}
Function  TFun.AppRunOnce:Boolean;
var
  HW:Thandle;
  sClassName,sTitle:string;
begin
  sClassName:=application.ClassName;
  sTitle:=application.Title;
  application.Title:='F982D120-BA1E-4199-8FBD-F4EED2F6E8A7'; //更改当前app标题
  HW:=findwindow(pchar(sClassName),pchar(sTitle));
  (*如果发现已有实例在运行，则关闭自己*)
  if HW<>0 then application.Terminate;
  application.Title:=sTitle; //恢复app标题
  result:=Hw<>0 //存在则返回true,无返回false
end;
//______________________________________________________________________________
{----------------------------}
{判断字符串是不是有效数字字符}
{----------------------------}
function TFun.IsStrAsNumber(NumStr:string):Bool;
var
  i:integer;
begin
  result:=True;
  if not (Numstr[1] in ['1','2','3','4','5','6','7','8','9']) then
  begin
    {首位为0，或者是其他的非数字字符，则提前返回false}
    result:=false;
    exit
  end;
//--------------
  for i:=1 to length(NumStr) do
  begin
    if not (Numstr[i] in ['0','1','2','3','4','5','6','7','8','9']) then
    begin
      result:=false;
      exit
    end;
  end;(* for i:=1 to length(NumStr) do*)
end;
//______________________________________________________________________________
{-----------------}
{ 如：发送ALT+F  }
{-----------------}
procedure TFun.SendComBoKey(const CtrlKey, FnKey: word);
begin
  keybd_event(CtrlKey, MapVirtualKey(CtrlKey, 0),0,0);
  keybd_event(FnKey, MapVirtualKey(FnKey, 0),0,0);
  keybd_event(FnKey, MapVirtualKey(FnKey, 0),KEYEVENTF_KEYUP,0);
  keybd_event(CtrlKey, MapVirtualKey(CtrlKey, 0),KEYEVENTF_KEYUP,0);
end;
//______________________________________________________________________________
{------------------------}
{  得到汉字的首字母      }
{------------------------}
function TFun.GetPYIndexChar( hzchar:string):char;
begin
  case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
    $B0A1..$B0C4 : result := 'A';
    $B0C5..$B2C0 : result := 'B';
    $B2C1..$B4ED : result := 'C';
    $B4EE..$B6E9 : result := 'D';
    $B6EA..$B7A1 : result := 'E';
    $B7A2..$B8C0 : result := 'F';
    $B8C1..$B9FD : result := 'G';
    $B9FE..$BBF6 : result := 'H';
    $BBF7..$BFA5 : result := 'J';
    $BFA6..$C0AB : result := 'K';
    $C0AC..$C2E7 : result := 'L';
    $C2E8..$C4C2 : result := 'M';
    $C4C3..$C5B5 : result := 'N';
    $C5B6..$C5BD : result := 'O';
    $C5BE..$C6D9 : result := 'P';
    $C6DA..$C8BA : result := 'Q';
    $C8BB..$C8F5 : result := 'R';
    $C8F6..$CBF9 : result := 'S';
    $CBFA..$CDD9 : result := 'T';
    $CDDA..$CEF3 : result := 'W';
    $CEF4..$D188 : result := 'X';
    $D1B9..$D4D0 : result := 'Y';
    $D4D1..$D7F9 : result := 'Z';
  else
    result := char(0);
  end;
end;
//______________________________________________________________________________
{-------------------------}
{  得到桌面列表试图的句柄 }
{-------------------------}
function TFun.GetDesktopListViewHandle: THandle;
var
  S: String;
begin
  Result := FindWindow('ProgMan', nil);
  Result := GetWindow(Result, GW_CHILD);