pubunit.pas

mp3播放器的delphi设计

       else
           Result:=Int(CustomDouble+1);
end;   //四舍五入取得证数结果

function SetDoubleFormat(CustomDouble:Double;XiaoShuWei:Integer):Double; //自定义小数位
begin
  if XiaoShuWei >= 7 then
     begin
     Application.MessageBox('您只能得到最多带6位小树的结果!','提示信息',0+48);
     Result:=CustomDouble;
     exit;
     end;

     if XiaoShuWei = 1 then XiaoShuWei:=10;
     if XiaoShuWei = 2 then XiaoShuWei:=100;
     if XiaoShuWei = 3 then XiaoShuWei:=1000;
     if XiaoShuWei = 4 then XiaoShuWei:=10000;
     if XiaoShuWei = 5 then XiaoShuWei:=100000;
     if XiaoShuWei = 6 then XiaoShuWei:=1000000;
     CustomDouble:=CustomDouble * XiaoShuWei;
     CustomDouble:=GetRoundInt(CustomDouble);
     CustomDouble:=CustomDouble/XiaoShuWei;
     Result:=CustomDouble;
end;   //返回用户指定的小数位后的结果

function GetHostIP():TStrings;  //获取本主机的IP地址
type
	TaPInAddr = Array[0..10] of PInAddr;
	PaPInAddr = ^TaPInAddr;
var
	phe: PHostEnt;
	pptr: PaPInAddr;
	Buffer: Array[0..63] of Char;
	I: Integer;
	GInitData: TWSAData;
begin
	WSAStartup($101,GInitData);
	Result:=TStringList.Create;
	Result.Clear;
	GetHostName(Buffer,SizeOf(Buffer));
	phe := GetHostByName(buffer);

	if phe = nil then
                 Exit;

	pPtr := PaPInAddr(phe^.h_addr_list);
	I := 0;
	while pPtr^[I] <> nil do
		begin
			Result.Add(inet_ntoa(pptr^[I]^));
			Inc(I);
		end;
			WSACleanup;
end;  //获取本主机的IP地址

function GetUserName():AnsiString; //取得用户名称
var
        lpName: PAnsiChar;
        lpUserName: PAnsiChar;
        lpnLength: DWORD;
begin
        Result := '';
        lpName:='';
        lpnLength := 0;
        WNetGetUser(nil,nil,lpnLength); // 取得字串长度
        if lpnLength > 0 then
                begin
                        GetMem(lpUserName,lpnLength);
                        if WNetGetUser(lpName,lpUserName,lpnLength) = NO_ERROR then
                              Result :=lpUserName;
                        FreeMem(lpUserName,lpnLength);
                end;

end;    //取得用户名称

function GetWindowsProductID(): string; // 取得 Windows 产品序号
var
        reg: TRegistry;
begin
        Result := '';
        reg := TRegistry.Create;
        with reg do
                begin
                        RootKey := HKEY_LOCAL_MACHINE;
                        OpenKey('Software\Microsoft\Windows\CurrentVersion',False);
                        Result := ReadString('ProductID');
                end;
        reg.Free;
end;   // 取得 Windows 产品序号

//=====================================================================================================================
                                  //一下是过程实体实现区

procedure ErrorMsgBox();  //全程异常错误消息过程
begin
     Application.MessageBox('您执行了非法操作,程序出现异常错误!','提示信息',0+64); //错误提示过程
end;


procedure SetButtonCaptionAToB(CustomButton:TButton;AString,BString:String); //按钮标题二互换
begin
  try
     if CustomButton.Caption = AString then
        CustomButton.Caption:= BString
     else
        CustomButton.Caption:= AString;
  except
           PubUnit.ErrorMsgBox;
  end;
end;  {按钮标题"A","B"二中不同字符串互换}


procedure SetFormPicture(CustomForm:TForm;PictureFile:String); //设置窗口的背景图像
Var
   Bitmap: Tbitmap;
   Rect1: TRect;
begin
     try
              Rect1.Left:=0;//设置显示区域
              Rect1.Right:=CustomForm.Width;
              Rect1.Top:=0 ;
              Rect1.Bottom:=CustomForm.Height;
              Bitmap:=TBitmap.Create;//创建对象
              Bitmap.LoadFromFile(PictureFile);// 动态装入文件
              CustomForm.Canvas.StretchDraw(Rect1,Bitmap);// 显示位图图形文件
              Bitmap.FreeImage;// 释放资源
     except
             PubUnit.ErrorMsgBox;
     end;

end;

procedure SetDBGridPicture(CustomDBGrid:TDBGrid;PictureFile:String); //设置窗口的背景图像
Var
   Bitmap: Tbitmap;
   Rect1: TRect;
begin
    try
              Rect1.Left:=0;//设置显示区域
              Rect1.Right:=CustomDBGrid.Width;
              Rect1.Top:=0 ;
              Rect1.Bottom:=CustomDBGrid.Height;
              Bitmap:=TBitmap.Create;//创建对象
              Bitmap.LoadFromFile(PictureFile);// 动态装入文件
              CustomDBGrid.Canvas.StretchDraw(Rect1,Bitmap);// 显示位图图形文件
              Bitmap.FreeImage;// 释放资源
     except
             PubUnit.ErrorMsgBox;
     end;
end;

procedure SetCDRomOpen(); //打开电脑光驱
begin
     try
        MMSystem.mciSendString('set cdaudio door open wait',nil,0,0);
         {调用api函数打开光驱,加入多媒体函数库MMSystem}
     except
             PubUnit.ErrorMsgBox;
     end;
end;

procedure SetCDromClose(); //关闭电脑光驱
begin
     try
            MMSystem.mciSendString('set cdaudio door closed wait',nil,0,0);
            {调用api函数关闭光驱,加入多媒体函数库MMSystem}
     except
             PubUnit.ErrorMsgBox;
     end;
end;

procedure SetWaveLeft(Volume:Integer);  //设置声音为左声道(Integer 1~13)
var
   Wave:String;
begin
   try
             Wave :='$' + inttohex(0,4)+
                          inttohex(Volume*5000,4);
             MMSystem.waveOutSetVolume(0,StrToInt(Wave));
    except
             PubUnit.ErrorMsgBox;
    end;
end;

procedure SetWaveRigth(Volume:Integer);  //设置声音为右声道(Integer 1~13)
var
   Wave:string;
begin
     try
             Wave :='$' + inttohex(Volume*5000,4) +
                          inttohex(0,4);
             MMSystem.waveOutSetVolume(0,StrToInt(Wave));
     except
             PubUnit.ErrorMsgBox;
     end;
end;

procedure SetWaveBalance(Volume:Integer);//设置声音为双声道(Integer 1~13)
var
   Wave:String;
begin
     try
         Wave :='$' + inttohex(Volume *5000,4) +
                      inttohex(Volume*5000,4);
         MMSystem.waveOutSetVolume(0,StrToInt(Wave));
     except
             PubUnit.ErrorMsgBox;
     end;
end;

procedure SetWindowsReboot();  //设置Windows 重新启动（电脑不会断电）
begin
     try
           Windows.ExitWindowsEx(EWX_REBOOT,0);
     except
             PubUnit.ErrorMsgBox;
     end;
end;

procedure SetWindowsClose();  //设置 Windows 关闭(电脑将断电)
begin
     try
             Windows.ExitWindowsEx(EWX_POWEROFF,0);
     except
             PubUnit.ErrorMsgBox;
     end;
end;

procedure IsEditNumber(CustomEdit:TEdit);  //判断文本框中的数据是否为数字
var
     Hui_Da:Integer;
begin
   try
     if Length(CustomEdit.Text)=0 then
        exit;

     if StrToInt(CustomEdit.Text)>= 0 then
        CustomEdit.Text:=CustomEdit.Text
   except
     Hui_Da:=Application.MessageBox('您输入了无效的数据格式,您要修改吗?','提示信息',1+48);
           if Hui_Da = 1 then
              CustomEdit.SetFocus
           else
              CustomEdit.Text:=CustomEdit.Text;
   end;
end;       //判断文本框中的数据是否为数字

procedure IsEditEmpty(CustomEdit:TEdit);  //判断文本框中是否委控制
begin
     if Length(CustomEdit.Text)=0 then
        Application.MessageBox('您输入了无效的数据格式,数据不能为空!','提示信息',0+48);
end;

procedure SetTextXuanZhuan(OutForm:TForm;FontName,FontCaption:String;FontSize,FontOutTop,
                FontOutLeft,FontOutJiaoDu:Integer;FontColor:TColor); //设置输出字体的旋转效果
var
    lf : TLogFont;
    tf : TFont;
begin
            with OutForm.Canvas do
             begin
                Font.Name := FontName;
                Font.Size := FontSize;
                tf := TFont.Create;
                tf.Assign(Font);
                GetObject(tf.Handle,sizeof(lf),@lf);
                lf.lfEscapement :=-FontOutJiaoDu;
                lf.lfOrientation :=-FontOutJiaoDu;
                tf.Handle := CreateFontIndirect(lf);
                Font.Assign(tf);
                tf.Free;
                Font.Color :=FontColor;
                TextOut(FontOutLeft,FontOutTop,FontCaption);
             end;
end;

procedure SetWallPicture(BmpFileName:String);  //动态更改壁纸
begin
     SystemParametersInfo(SPI_SETDESKWALLPAPER,0,
                         PChar(BmpFileName),SPIF_SENDWININICHANGE);
end;

procedure SetFormRounder(CustomForm:TForm;FormLeft,FormTop,FormWidth,
                                          FormHeight,LeftHuDu,RightHuDu:Integer); //园脚窗口
var
     hr :THandle;
begin
     hr:=CreateRoundrectRgn(FormLeft,FormTop,FormWidth,FormHeight,LeftHuDu,RightHuDu);//定义园角矩形(win API函数)
     SetWindowRgn(CustomForm.handle,hr,true); //设置园角窗口
end;


procedure SetTaskBarHide();  //隐藏任务栏
var
        wndHandle : THandle;
        wndClass : array[0..50] of Char;
begin
        StrPCopy(@wndClass[0],'Shell_TrayWnd');
        wndHandle := FindWindow(@wndClass[0],nil);
        ShowWindow(wndHandle,SW_HIDE);
end;

procedure SetTaskBarShow();  //现实任务栏
var
        wndHandle : THandle;
        wndClass : array[0..50] of Char;
begin
        StrPCopy(@wndClass[0],'Shell_TrayWnd');
        wndHandle := FindWindow(@wndClass[0],nil);
        ShowWindow(wndHandle,SW_RESTORE);
end;

procedure SetPicture90(YuanImage,GuoImage:TImage); // 旋转图像90 度
var
        i,j:integer;
begin
        //确定旋转后位图的大小
        GuoImage.Picture.Bitmap.Height:=YuanImage.picture.width;
        GuoImage.Picture.Bitmap.Width:=YuanImage.picture.height;
        for i:=0 to YuanImage.Height do
        for j:=0 to YuanImage.Width do
        GuoImage.canvas.Pixels[(YuanImage.Height-i),j]:=YuanImage.canvas.Pixels[j,i];

end;

procedure SetPicture180(YuanImage,GuoImage:TImage);  //旋转图像180 度
var
        i,j:integer;
begin
        //确定旋转后位图的大小
        GuoImage.Picture.Bitmap.Height:=YuanImage.picture.Height;
        GuoImage.Picture.Bitmap.Width:=YuanImage.picture.Width;
        for i:=0 to YuanImage.Height do
        for j:=0 to YuanImage.Width do
        GuoImage.canvas.Pixels[(YuanImage.Width-j),(YuanImage.Height-i)]:=YuanImage.canvas.Pixels[j,i];

end;

procedure SetPicture270(YuanImage,GuoImage:TImage); // 旋转图像270 度
var
        i,j:integer;
begin
        //确定旋转后位图的大小
        GuoImage.Picture.Bitmap.Height:=YuanImage.picture.width;
        GuoImage.Picture.Bitmap.Width:=YuanImage.picture.height;
        for i:=0 to YuanImage.Height do
        for j:=0 to YuanImage.Width do
        GuoImage.canvas.Pixels[i,(YuanImage.Width-j)]:=YuanImage.canvas.Pixels[j,i];

end;

procedure ExecuteExeApp(CustomExeName,CustomFileName:String); //运行外部应用程序
begin
    Shellexecute(Application.Handle,'Open',PChar(CustomExeName),PChar(CustomFileName),nil,sw_shownormal);
end;

procedure SetApplicationHide(); //隐藏应用程序在任务栏上的显示
begin
     SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

procedure SetSystemMenu(CustomForm:TForm;MenuName:String); //添加系统菜单
var
        SysHMenu : HMENU;
const
        CM_MyMsg = WM_USER + 400;
begin
        SysHMenu:=GetSystemMenu(CustomForm.Handle,False);
        AppendMenu(SysHMenu,MF_STRING,CM_MyMsg,PChar(MenuName));
end;

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

procedure CopyFileDirectory(Handle:THandle;OldDirectory,NewDirectory:String);//拷贝整个目录
var
     OpStruc:TSHFileOpStruct;
      FromBuf, ToBuf: Array [0..128] of Char;
begin
      FillChar(FromBuf,Sizeof(FromBuf),0);
      FillChar(ToBuf,Sizeof(ToBuf),0);
      StrPCopy(FromBuf,Pchar(OldDirectory));
      StrPCopy(ToBuf,Pchar(NewDirectory));
//设置OpStruc
with OpStruc do
begin
     Wnd:= Handle;
     wFunc := FO_COPY;
     pFrom := @FromBuf;
      pTo := @ToBuf ;
      fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
      fAnyOperationsAborted:= False;
      hNameMappings:= nil;
      lpszProgressTitle:= nil;
end;
if SHFileOperation(OpStruc) = 0 then
    MessageBox(Handle,'原目录已经成功复制完毕.','提示信息',0+48);
end;

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

procedure DeleteFileDirectory(Handle:THandle;OldDirectory:String);//删除整个目录
var
    OpStruc:TSHFileOpStruct;
begin
try
    //设置OpStruc
     with OpStruc do
          begin
              Wnd:=Handle ;
              wFunc:=FO_DELETE ;
              pFrom:=PChar(OldDirectory);
              fFlags:=FOF_ALLOWUNDO;
          end ;
     SHFileOperation(OpStruc);
except
     exit;
end;          
end;

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


end.