?? myfun.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);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -