pubunit.pas

基于delphi媒体播放器的源代码 很全面

unit PubUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, ToolWin, ExtCtrls, MPlayer, Menus,MMSystem,
  Registry,Winsock,ShellAPI,DBGrids;


//=====================================================================================================================

    function GetMaxInTwo(CanShu01,CanShu02:Double):Double; 

    function GetMinInTwo(CanShu01,CanShu02:Double):Double; 

    function GetWindowsDirectory():String; 

    function GetApplicationDirectory():String; 

    function SetODBCConfig(DateFilePath,ODBCName:String):Boolean; 

    function GetDiskFree(DiskName:Byte):String; 

    function GetDiskSize(DiskName:Byte):String; 

    function GetRoundInt(CustomDouble:Double):Double; 

    function SetDoubleFormat(CustomDouble:Double;XiaoShuWei:Integer):Double; //自定义小数位

    function GetHostIP():TStrings;  //获取本主机的IP地址

    function GetUserName():AnsiString; //取得用户名称

    function GetWindowsProductID(): string; // 取得 Windows 产品序号


//=====================================================================================================================

    procedure ErrorMsgBox();  //全程异常错误消息过程

    procedure SetButtonCaptionAToB(CustomButton:TButton;AString,BString:String); 

    procedure SetFormPicture(CustomForm:TForm;PictureFile:String); //设置窗口的背景图像

    procedure SetDBGridPicture(CustomDBGrid:TDBGrid;PictureFile:String); //设置窗口的背景图像

    procedure SetCDRomOpen(); 

    procedure SetCDromClose(); 

    procedure SetWaveLeft(Volume:Integer);  
    procedure SetWaveRigth(Volume:Integer);  

    procedure SetWaveBalance(Volume:Integer);

    procedure SetWindowsReboot();  
    procedure SetWindowsClose();  

    procedure IsEditNumber(CustomEdit:TEdit);  

    procedure IsEditEmpty(CustomEdit:TEdit); 

    procedure SetTextXuanZhuan(OutForm:TForm;FontName,FontCaption:String;FontSize,FontOutTop,FontOutLeft,
                               FontOutJiaoDu:Integer;FontColor:TColor);  //设置输出字体的旋转效果

    procedure SetWallPicture(BmpFileName:String);  

    procedure SetFormRounder(CustomForm:TForm;FormLeft,FormTop,FormWidth,
                                              FormHeight,LeftHuDu,RightHuDu:Integer); //园脚窗口

    procedure SetTaskBarHide(); 

    procedure SetTaskBarShow(); 

    procedure SetPicture90(YuanImage,GuoImage:TImage); 

    procedure SetPicture180(YuanImage,GuoImage:TImage);  //旋转图像180 度

    procedure SetPicture270(YuanImage,GuoImage:TImage); // 旋转图像270 度

    procedure ExecuteExeApp(CustomExeName,CustomFileName:String); //运行外部应用程序

    procedure SetApplicationHide(); 

    procedure SetSystemMenu(CustomForm:TForm;MenuName:String); 

    procedure CopyFileDirectory(Handle:THandle;OldDirectory,NewDirectory:String);//拷贝整个目录

    procedure DeleteFileDirectory(Handle:THandle;OldDirectory:String);//删除整个目录


//=====================================================================================================================

  Function LeftStr(inString : String; numChars : integer) : String;

  Function RightStr(inString : String; numChars : integer) : String;

  Function LTrim(inString : String) : String;

  Function RTrim(inString : String) : String;

  Function SubStr(inString : String; numChars, strSize : integer) : String;

  Function InStr(Text, Pattern : String) : Integer;

  function GetSecondFromString(TimeStr: string): dword;

  function GetFrameFromString(TimeStr: string): dword;

  function GetStringFromFrame(frames: dword): string;

  function ChInStr(str: string): boolean;

  function IsDigit(str: string): boolean;

const
   FPS = 25;  //for PAL, 30 frames per second
   

implementation

Function LeftStr;
Begin
  Result := Copy(inString,1,numChars)
End;

Function RightStr;
Var
  index: integer;
Begin
  If numChars >= Length(inString) Then
    RightStr := inString
  Else
    Begin
      index := Length(inString) - numChars+1;
      RightStr := Copy(inString,index,numChars)
    End
End;

Function LTrim;
Var
  p : Integer;
Begin
  if Length(inString)<1 then exit;

  p := 1;
  While (inString[p] = ' ') and (p <= Length(inString)) Do
    inc( p );
  If p > 1 Then
    Begin
      Move(inString[p], inString[1], Succ(Length(inString)) - p);
//      dec(inString[0], pred(p));
      SetLength(inString, Length(inString)-p+1);
    End;
   LTrim := inString;
End;

Function RTrim;
Begin
  While inString[Length(inString)-1] = ' ' Do
    //dec( inString[0] );
    SetLength(inString, Length(inString)-1);
  RTrim := inString;
End;

Function SubStr;
Begin
  SubStr := Copy(inString, numChars, StrSize );
End;

Function InStr;
Begin
  InStr := Pos( Pattern, Text );
End;

function GetFrameFromString(TimeStr: string): dword;
//get dword of frames from 00:00:00.00
var
   hour1,minute1,second1,frame1: dword;
   s1: string;
   i: integer;
begin
     i := InStr(TimeStr,':');
     hour1 := StrToInt(LeftStr(TimeStr, i-1));
     s1 := RightStr(TimeStr, Length(TimeStr)-i);  //00:00.00
     minute1 := StrToInt(LeftStr(s1, 2));
     s1 := RightStr(s1, Length(s1)-3);  //00.00
     second1 := StrToInt(LeftStr(s1, 2));
     s1 := RightStr(s1, Length(s1)-3);  //00
     frame1 := StrToInt(s1);

     Result := DWORD(DWORD(hour1)*3600 + DWORD(minute1)*60 + DWORD(second1)) //second
              *FPS + frame1;
end;

function GetSecondFromString(TimeStr: string): dword;
//get dword of frames from 00:00:00
var
   hour1,minute1,second1: dword;
   s1: string;
   i :integer;
begin
     i := InStr(TimeStr,':');
     hour1 := StrToInt(LeftStr(TimeStr, i-1));
     s1 := RightStr(TimeStr, Length(TimeStr)-i);  //00:00.00
     minute1 := StrToInt(LeftStr(s1, 2));
     s1 := RightStr(s1, Length(s1)-3);  //00.00
     second1 := StrToInt(LeftStr(s1, 2));

     Result := DWORD(DWORD(hour1)*3600 + DWORD(minute1)*60 + DWORD(second1));
end;

function GetStringFromFrame(frames: dword): string;
var
   ttt: dword;
   frameStr,hourStr,minuteStr,secondStr: string;
begin
     ttt := frames mod FPS;
     frameStr := IntToStr(ttt);
     if Length(frameStr)<2 then frameStr := '0'+frameStr;

     ttt := (frames div FPS) mod 60;
     secondStr := IntToStr(ttt);
     if Length(secondStr)<2 then secondStr := '0'+secondStr;

     ttt := ((frames div FPS) div 60) mod 60;
     minuteStr := IntToStr(ttt);
     if Length(minuteStr)<2 then minuteStr := '0'+minuteStr;

     ttt := (frames div FPS) div 3600;
     hourStr := IntToStr(ttt);
     if Length(hourStr)<2 then hourStr := '0'+hourStr;

     Result := hourStr+':'+minuteStr+':'+secondStr+'.'+frameStr;
end;

function ChInStr(str: string): boolean;
var
  i: integer;
begin
    Result := False;
    for i:=1 to Length(str) do
    begin
       if ((str[i]<='Z') and (str[i]>='A'))
        or ((str[i]<='z') and (str[i]>='a'))
        or ((str[i]<='9') and (str[i]>='0'))
        or (str[i]='~')
        or (str[i]='_')
        or (str[i]='.')
       then continue
       else begin
          Result := True;
          break;
       end;
    end;
end;

function IsDigit(str: string): boolean;
var
   i: integer;
begin
    Result := True;
    for i:=1 to Length(str) do
    begin
       if (str[i]>'9') or (str[i]<'0') then
       begin
          Result := False;
          break;
       end;
    end;
end;


function GetMaxInTwo(CanShu01,CanShu02:Double):Double; //判断两个整数大小返回大值
begin
        if CanShu01 > CanShu02 then
                Result:=CanShu01
             else
                Result:=CanShu02;
end;  {判断两各整数大小返回大值}


function GetMinInTwo(CanShu01,CanShu02:Double):Double; //判断两个整数大小返回小值
begin
             if CanShu01 < CanShu02 then
                Result:=CanShu01
             else
                Result:=CanShu02;
end;  {判断两各整数大小返回小值}


function GetWindowsDirectory():String; //返回Windows 的启动路径
var
    WinBoot:string;
begin
    try
            SetLength(WinBoot,256);
            Windows.GetWindowsDirectory(PChar(WinBoot),256);
            SetLength(WinBoot,StrLen(PChar(WinBoot)));
            Result:=WinBoot;
     except
           PubUnit.ErrorMsgBox;
     end;
end;


function GetApplicationDirectory():String;  //返回应用程序EXE文件的启动目录
begin
     try
             Result:=ExtractFilePath(Application.ExeName);
     except
           PubUnit.ErrorMsgBox;
     end;
end;

function SetODBCConfig(DateFilePath,ODBCName:String):Boolean; //动态配置ODBC(Access97,2000)
var
    RegisterTemp:TRegistry;
    bData : Array[0..0] of byte;
begin
     RegisterTemp:=TRegistry.Create;
with registerTemp do
     begin
          RootKey:=HKEY_LOCAL_MACHINE;//设置根键值为HKEY_LOCAL_MACHINE

         if OpenKey('Software\ODBC\ODBC.INI\ODBC Data Sources',True) then
             begin //注册一个DSN名称
                 WriteString(ODBCName,'Microsoft Access Driver (*.mdb)');
             end
         else
             begin//创建键值失败
                 Application.MessageBox('增加ODBC数据源失败','提示信息',0+48);
                 Result:=False;
                 exit;
             end;
                 CloseKey;

          if OpenKey('Software\ODBC\ODBC.INI\'+ODBCName,True) then
             begin
                WriteString('DBQ',DateFilePath);//数据库目录
                WriteString('Description',ODBCName);//数据源描述
                WriteString('Driver',GetWindowsDirectory()+'\System\Odbcjt32.dll');//驱动程序DLL文件
                WriteInteger('DriverId', 25 );//驱动程序标识
                WriteString('FIL',ODBCName);//Filter依据
                WriteInteger('SafeTransaction',0);//支持的事务操作数目
                WriteString('UID','admin');//用户名称
                bData[0] := 0;
                WriteBinaryData('Exclusive',bData,1);//非独占方式
                WriteBinaryData('ReadOnly',bData,1);//非只读方式
             end
         else//创建键值失败
                begin
                        Application.MessageBox('增加ODBC数据源失败','提示信息',0+48);
                        Result:=False;
                exit;
                end;

                CloseKey;

        //写入DSN数据库引擎配置信息
        if OpenKey('Software\ODBC\ODBC.INI\'+ODBCName+'\Engines\Jet',True) then
                begin
                        WriteString('ImplicitCommitSync','Yes');
                        WriteInteger('MaxBufferSize',512);//缓冲区大小
                        WriteInteger('PageTimeout',10);//页超时
                        WriteInteger('Threads',3);//支持的线程数目
                        WriteString('UserCommitSync','Yes');
                end
        else//创建键值失败
                begin
                        Application.MessageBox('增加ODBC数据源失败','提示信息',0+48);
                        Result:=False;
                        exit;
                end;

        CloseKey;
        Result:=True;
    Free;
end;

end;

function GetDiskFree(DiskName:Byte):String; //判断磁盘剩余空间
var
       Temp:Double;
begin
       Temp:=DiskFree(DiskName)/1024/1024;
       if Temp < 0 then
          Application.MessageBox('您输入了无效的盘符代号,1:A 2:B 3:C','提示信息',0+48)
          else
          Result:=FloatToStr(Temp)+'兆';
end;

function GetDiskSize(DiskName:Byte):String; //判断磁盘总空间
var
       Temp:Double;
begin
       Temp:=DiskSize(DiskName)/1024/1024;
       if Temp < 0 then
          Application.MessageBox('您输入了无效的盘符代号,1:A 2:B 3:C','提示信息',0+48)
          else
          Result:=FloatToStr(Temp)+'兆';
end;

function GetRoundInt(CustomDouble:Double):Double; //得到四舍五入结果
var
    Temp:Double;
begin
    Temp:=Int(CustomDouble);
    Temp:=Temp+1;
    Temp:=Temp-CustomDouble;
    if Temp >0.5 then
           Result:=Int(CustomDouble)
       else
           Result:=Int(CustomDouble+1);
end;   //四舍五入取得证数结果

function SetDoubleFormat(CustomDouble:Double;XiaoShuWei:Integer):Double; //自定义小数位