myfun.pas

西门子Prodave6.0 的Delphi 版本, 需要安装 Prodave60软件,支持以太网通讯

end;
//______________________________________________________________________________
//  DoBeep处理函数..摘自他人，作者未知
//感觉很棒就应用过来用了。HOHO....
//  利用写端口直接发声
Procedure AsmShutUp;
Begin
  Asm
    In AL, $61
    And AL, $FC
    Out $61, AL
  End;
End;

Procedure AsmBeep (Freq : Word);
Label
  Skip;
Begin
  Asm
        Push BX
        In AL, $61
        Mov BL, AL
        And AL, 3
        Jne Skip
        Mov AL, BL
        Or AL, 3
        Out $61, AL
        Mov AL, $B6
        Out $43, AL
  Skip: Mov AX, Freq
        Out $42, AL
        Mov AL, AH
        Out $42, AL
        Pop BX
  End;
End;

Procedure HardBleep(Freq : Word; MSecs : LongInt);
Const
  HiValue =50000;
Var
  iCurrTickCount, iFirstTickCount : DWord;
  iElapTime : LongInt;
Begin
  If (Freq>=20)And (Freq<=5000)Then Begin
    AsmBeep (Word (1193181 Div LongInt (Freq)));
    If MSecs>=0 Then Begin
      iFirstTickCount:=GetTickCount;
      Repeat
        If MSecs>1000 Then Application.ProcessMessages;
        iCurrTickCount:=GetTickCount;
        If iCurrTickCount<iFirstTickCount Then iElapTime:=HiValue-iFirstTickCount+iCurrTickCount
        Else iElapTime:=iCurrTickCount-iFirstTickCount;
      Until iElapTime>=MSecs;
      AsmShutUp;
    End;
  End;
End;

Procedure DoBleep(Freq:Word; MSecs:LongInt);
Begin
  If MSecs<-1 Then MSecs:=0;
  If SysWinNT Then
    Windows.Beep (Freq, MSecs)
  Else
    HardBleep (Freq, MSecs);
End;

Procedure ShutUp;
Begin
   If SysWinNT Then
     Windows.Beep (1, 0)
   Else
     AsmShutUp;
End;

Procedure InitSysType;
Var
  VersionInfo : TOSVersionInfo;
Begin
  VersionInfo.dwOSVersionInfoSize:=SizeOf (VersionInfo);
  GetVersionEx (VersionInfo);
  SysWinNt:=VersionInfo.dwPlatformID=VER_PLATFORM_WIN32_NT;
End;
//------------------------------------------------------------------------------
// DoBeep所有代码结束
//------------------------------------------------------------------------------
//______________________________________________________________________________


{------------------------------}
{-----十或十六进制转二进制-----}
{------------------------------}

Function  TFun.IntToBit(const source:word;const Bit:TBitType):string;
var
  str:string[16];
  bInt:byte;
  i:integer;
begin
    str:='';
    bInt:=0;
    for i:=1 to 16 do
    begin
       asm
         mov ax,word ptr[source]
         shl ax,1                (*最高位移至CF寄存器中*)
         mov word ptr[Source],ax (*保存移动后Source的值*)
         mov DL,0
         rcl DL,1                (*从CF中得到移出的最高位*)
         add DL,$30              (*加$30,将数值转化为ASCII码值*)
         mov byte ptr[bInt],DL
       end;
       str:=str+chr(bInt);
    end;
  case  bit of
   HighBit:str:=copy(str,1,8);  (*取高8位*)
   LowBit:str:=Copy(str,9,8);   (*取低8位*)
  end;
  result:=str;
end;
//________________________________________________________________________________

{--------------------------}
{-----二进制转到十进制-----}
{--------------------------}
Function TFun.BitToInt(sBin:string):integer;
var
  TempBin:string[16];
  bChar:byte;
  dwInt:word;
  i:integer;
begin
  TempBin:=StringOfchar('0',16-length(sBin))+sBin;(*不足16位，高位补零*)
  dwInt:=0;
  for i:=1 to 16  do
  begin
     bChar:=ord(TempBin[i]); //得到TempBin字串列表值
     asm
       mov al,byte ptr[bChar]
       sub al,$30 //ASCCII码-$30=对应的数字值
       RCR al,1   //移入CF寄存器
       RCl word ptr[dwInt],1 //dwInt右移
     end;
  end;
 result:=dwInt
end;
//________________________________________________________________________________

{--------------------------}
{-----十六进制转十进制-----}
{--------------------------}
Function TFun.HexToInt(sHex:string):integer;
var
 i:integer;
 dwRes:word;
 bInt:byte;
begin
   SHex:=StringOfchar('0',4-length(sHex))+sHex;(*不足4位十六进制，高位补零*)
   dwRes:=0;
   for i:=1 to 4 do
   begin
       case AnsiIndexStr(LowerCase(sHex[i]),['a','b','c','d','e','f']) of
          0:bInt:=10;
          1:bInt:=11;
          2:bInt:=12;
          3:bInt:=13;
          4:bInt:=14;
          5:bInt:=15;
       else
         bInt:=strToint(sHex[i])
       end;//end case
       asm
          xor ax,ax
          mov al,byte ptr[bInt]
          SHL word ptr[dwRes],4
          OR word ptr[dwRes],ax
       end
   end;//end for
   result:=dwRes
end;
//________________________________________________________________________________

{------------------------------}
{   (string)十六进制转二进制   }
{------------------------------}
Function TFun.HexToBit(sHex:string;Const Bit:TBitType):string;
begin
    result:=IntToBit(HexToInt(sHex),Bit)
end;
//________________________________________________________________________________


{------------------------------}
{   (string)二进制转十六进制   }
{------------------------------}
Function TFun.BitToHex(sBin:string;const Bit:integer):string;//2 to 16
begin
  result:=IntTohex(BitToint(sBin),bit)
end;
//________________________________________________________________________________

{----------------------------------------------}
{      将十六进制表示的十制制转为实际的十进制数}
{如: $12===>12  | $32===>32 ...                }
{    $24=38-2*6=24                             }
{----------------------------------------------}
Function TFun.HexBCDToint(sHexBCD:Byte):integer;
begin
    asm
      xor ax,ax
      mov al,byte ptr[sHexBCD]
      And al,$F0 (*得到高位*)
      shr al,4
      imul ax,6  (*得到6的倍数*)
      sub byte ptr[sHexBCD],al
    end;
    Result:=sHexBCD
End;
//------------------------------------------------------------------------------
{将int转为Hex值的BCD码}
function TFun.IntToBCD(Int:byte):word;
var
  iL,iH:integer;
begin
  iH:=integer(int div 10);
  iL:=int-iH*10;
  result:=ih*16+il;
end;
//________________________________________________________________________________

{--------------------}
{  托动无标题窗体    }
{--------------------}
//procedure TFun.DragWindow(handle:Thandle);
procedure TFun.MoveWindow(handle:Thandle);
begin
  ReleaseCapture;
  SendMessage(handle,WM_SYSCOMMAND,SC_MOVE or 2,0)
end;
//________________________________________________________________________________

{-------------------------------}
{  得到程序的当前目录           }
{并将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);