求：相关commondialog打开、保存、打印文件

类型：转载   责任编辑：asp.net   日期：2007/05/23

热门软件下载：

初学者，用到有关commondialog方面的问题，包括打开文件、保存文件、打印文件等各种操作，求：相关各种操作的实例代码。

网友回答：

打开文件的代码如下,首先在你的FORM1中要有commondialog1与command1控件.  
  Private   Sub   Command1_Click()  
    设置“CancelError”为   True  
  CommonDialog1.CancelError   =   True  
  On   Error   GoTo   ErrHandler  
    设置标志  
  CommonDialog1.Flags   =   cdlOFNHideReadOnly  
    设置过滤器  
  CommonDialog1.Filter   =   "All   Files   (*.*)|*.*|Text   Files"   &   _  
  "(*.txt)|*.txt|Batch   Files   (*.bat)|*.bat"  
    指定缺省的过滤器  
  CommonDialog1.FilterIndex   =   2  
    显示“打开”对话框  
  CommonDialog1.ShowOpen  
    显示选定文件的名字  
  MsgBox   CommonDialog1.filename  
  Exit   Sub  
   
  ErrHandler：  
    用户按了“取消”按钮  
  Exit   Sub  
  End   Sub  
 

打印文件代码如下:  
  Private   Sub   Command1_Click()  
  Dim   BeginPage,   EndPage,   NumCopies,   i  
    设置“取消”为   True  
  CommonDialog1.CancelError   =   True  
  On   Error   GoTo   ErrHandler  
    显示“打印”对话框  
  CommonDialog1.ShowPrinter  
    从该对话框取得选定的值  
  BeginPage   =   CommonDialog1.FromPage  
  EndPage   =   CommonDialog1.ToPage  
  NumCopies   =   CommonDialog1.Copies  
  For   i   =   1   To   NumCopies  
    此处放置将数据发送到打印机的代码  
  Next   i  
  Exit   Sub  
  ErrHandler：  
    用户按了“取消”按钮  
  Exit   Sub  
  End   Sub  
   
  也是要保证你的FORM1中有以上的控件.

保存文件的代码:  
  Private   Sub   Command1_Click()  
  CommonDialog1.Filter   =   "All   Files   (*.*)|*.*|Text   Files"   &   _  
  "(*.txt)|*.txt|Batch   Files   (*.bat)|*.bat"  
  CommonDialog1.ShowSave  
   
  End   Sub  
   
  Private   Sub   Command2_Click()  
  Unload   Me  
  End   Sub  
  也要保证有控件哦.

通用对话框使用方法全解-   -  
                                                                                 
   
   
  　　CommonDialog控件是常用的一个控件，它为我们提供了打开、另存为、字体、颜色、打印、帮助等几种类型的标准对话框，本例演示了所有这些类型的对话框的使用方法。  
   
  　　为了学习方便，提供的源码已经作了详细的中文注释，看看源码框中的代码：  
   
  -------------------------------------------  
                        通用对话框使用方法全解  
  -------------------------------------------  
                            洪恩在线   求知无限  
  -------------------------------------------  
  ------名称-----------------作用-------------  
                CdlTest                           通用对话框  
                CmdOpen                           “打开”对话框按钮  
                CmdSave                           “另存为”对话框按钮  
                CmdFont                           “字体”对话框按钮  
                CmdColor                         “颜色”对话框按钮  
                CmdPrint                         “打印”对话框按钮  
                CmdHelp                           “帮助”对话框按钮  
  -------------------------------------------  
   
  当“颜色”对话框按钮被按下时  
  Private   Sub   CmdColor_Click()  
  On   Error   Resume   Next  
  CdlTest.CancelError   =   True  
  CdlTest.Flags   =   cdlCCRGBInit  
  CdlTest.ShowColor  
  If   Err   =   cdlCancel   Then   Exit   Sub  
  TextBoxColor.ForeColor   =   CdlTest.Color  
  End   Sub  
   
  当“字体”对话框按钮被按下时  
  Private   Sub   CmdFont_Click()  
  On   Error   Resume   Next  
  当用户按下“取消”按钮，返回一个错误信息，这样使我们可以对其进行控制  
  CdlTest.CancelError   =   True  
  此句必须要  
  CdlTest.Flags   =   cdlCFBoth   +   cdlCFEffects  
  显示“字体”对话框  
  CdlTest.ShowFont  
  出现“取消”错误时，跳出  
  If   Err   =   cdlCancel   Then  
  Exit   Sub  
  Else  
  将TextBox的字体属性根据“字体”对话框的变化作相应设置  
          如果用户选择了字体才将字体改变，避免字体为空的错误  
          If   CdlTest.FontName   <>   ""   Then  
          TextBoxFont.FontName   =   CdlTest.FontName  
          End   If  
          TextBoxFont.FontSize   =   CdlTest.FontSize  
          TextBoxFont.FontBold   =   CdlTest.FontBold  
          TextBoxFont.FontItalic   =   CdlTest.FontItalic  
          TextBoxFont.FontStrikethru   =   CdlTest.FontStrikethru  
          TextBoxFont.FontUnderline   =   CdlTest.FontUnderline  
  End   If  
  End   Sub  
   
  当“帮助”对话框按钮被按下时  
  Private   Sub   CmdHelp_Click()  
  On   Error   Resume   Next  
  设置   HelpCommand   属性，显示   Visual   Basic   帮助目录主题  
  CdlTest.HelpCommand   =   cdlHelpForceFile  
   
  指定帮助文件  
  Dim   fullpath   As   String  
  If   Right(App.Path,   1)   =   "\"   Then     若   App.Path   为根目录  
        fullpath   =   App.Path   +   "test.hlp"  
  Else  
        fullpath   =   App.Path   +   "\"   +   "test.hlp"  
  End   If  
  上面是得到应用程序所在路径的小技巧  
   
  CdlTest.HelpFile   =   fullpath  
  显示“帮助”对话框  
  CdlTest.ShowHelp  
  End   Sub  
   
  当“打开”对话框按钮被按下时  
  Private   Sub   CmdOpen_Click()  
  出现错误时跳到下一语句  
  On   Error   Resume   Next  
  CdlTest.CancelError   =   True  
  属性DialogTitle是要弹出的对话框的标题  
  CdlTest.DialogTitle   =   "打开文件"  
  缺省的文件名为空  
  CdlTest.FileName   =   ""  
  属性Filter是文件滤器，返回或设置在对话框的类型列表框中所显示的过滤器。  
  语法object.Filter   [=   文件类型描述1   |filter1   |文件类型描述2   |filter2...]  
  CdlTest.Filter   =   "文本文件(.txt)|*.txt"  
  Flags属性的用法依据不同的对话框而变，详细使用需要查找联机帮助手册  
  CdlTest.Flags   =   cdlOFNCreatePrompt   +   cdlOFNHideReadOnly  
  CdlTest.ShowOpen  
  If   Err   =   cdlCancel   Then   Exit   Sub  
  TextBoxOPen.Text   =   CdlTest.FileName  
  End   Sub  
   
  当“打印”对话框按钮被按下时  
  Private   Sub   CmdPrint_Click()  
  On   Error   Resume   Next  
  CdlTest.CancelError   =   True  
  显示“打印”对话框  
  CdlTest.ShowPrinter  
  If   Err   =   cdlCancel   Then   Exit   Sub  
  End   Sub  
   
  当“保存”对话框按钮被按下时  
  Private   Sub   CmdSave_Click()  
  On   Error   Resume   Next  
  CdlTest.CancelError   =   True  
  CdlTest.DialogTitle   =   "保存文件"  
  CdlTest.FileName   =   ""  
  解释见上面  
  CdlTest.Filter   =   "文本文件(*.txt)|*.txt"  
  CdlTest.Flags   =   cdlOFNCreatePrompt   +   cdlOFNHideReadOnly  
  CdlTest.ShowSave  
  If   Err   =   cdlCancel   Then   Exit   Sub  
  TextBoxSave.Text   =   CdlTest.FileName  
  End   Sub  
   
   
  源程序下载　　  
   
  http://www.hongen.com/pc/program/tutors/vb/zip/vb0102.zip  
   
              如果控件面板中没有CommonDialog控件的小图标，必须先从“添加控件对话框”中添加，下面我们来看看怎样调用不同类型的对话框。  
   
  　　CommonDialog控件有一系列的Show方法，例如：ShowOpen、ShowSave、ShowFont、ShowColor、ShowPrinter、ShowHelp等，这些方法的使用语法是类似的，如下所示：  
   
  　　object.ShowOpen，我们只须在程序中写入这个语句，就能调出“打开”对话框，同样也能调用其它类型的对话框。  
   
  　　而CommonDialog控件的属性是和不同的对话框类型紧密相关的，有些属性只适用于某一类对话框，有些属性在不同的对话框中的属性是有差别的，所以下面分类列出了和不同对话框相关联的属性的用法。  
   
  　　与ShowOpen、ShowSave方法相关的属性：  
  　　●FileName属性：返回或设置所选文件的路径和文件名，如果在使用Show方法以前使用FileName属性，则设定了对话框的默认文件名；如果是在以后使用则返回选择的文件名。  
  　　使用语法是：   CommonDialog.Filename[=pathname]    
  　　●Filter属性：返回或设置在对话框的类型列表框中所显示的过滤器(也就是限定打开或保存为的文件类型)，它的使用语法是：  
  　　object.Filter   [=   描述文字1   |过滤标示1   |描述文字2   |过滤标示2]  
  　　其中描述文字为任意文字，而   过滤标示则采用*.文件后缀(例如：*.bmp)的格式，描述文字和过滤标示之间用“|”隔开。  
  　　●DefaultExt属性：为该对话框返回或设置缺省的文件扩展名，也就是当我们没有指定打开或保存的文件类型时，按DefaultExt属性所设置的扩展名为默认值。  
   
  　　与ShowFont方法相关的属性：  
  　　●Color选定的颜色。为使用此属性，必须先将Flags属性设置为cdlCFEffects。    
  　　●FontBold   是否选定“粗体”。    
  　　●FontItalic   是否选定“斜体”。    
  　　●FontStrikethru   是否选定删除线。    
  　　●FontUnderline   是否选定下划线。    
  　　●FontName   选定的字体名称。    
  　　●FontSize   选定的字体大小。  
  　　使用的语法是直接引用，比如我们要根据“字体对话框”返回的值设置文本框的字体，则直接采用语句：Text.Font=CommonDialog.FontnName    
   
  　　与ShowColor方法相关的属性：  
  　　●Color选定的颜色。为使用此属性，必须先将Flags属性设置为cdlCFEffects。  
   
  　　与ShowHelp方法相关的属性：  
  　　●HelpCommand属性   返回或设置需要的联机帮助的类型    
  　　●HelpFile属性　确定帮助文件的路径和文件名  
  　　语法是：   object.HelpFile[   =   filename]    
   
  　　下面看看CancelError属性，它设置当选取“取消”按钮时是否认为出错，使用的语法是：CommonDialog.CancelError[=   boolean]   (boolean指布尔型变量)  
  　　如果我们把它设为True，则当使用者选取了“取消”按钮时程序会返回一个cdlCancel错误，通过捕捉这个错误并加以处理，我们就能避免程序的出错。具体的使用可在源码中看到实例。  
 

各种对话框(总结)-   -  
                                                                                 
   
   
   
  标准对话框(SmDialog)  
   
  Option   Explicit  
  定义一个全局变量,用于保存字体的各种属性  
  Public   Type   SmFontAttr  
      FontName   As   String               字体名  
      FontSize   As   Integer             字体大小  
      FontBod   As   Boolean               是否黑体  
      FontItalic   As   Boolean         是否斜体  
      FontUnderLine   As   Boolean   是否下划线  
      FontStrikeou   As   Boolean  
      FontColor   As   Long  
      WinHwnd   As   Long  
  End   Type  
  Dim   M_GetFont   As   SmFontAttr  
  **系统常量------------------------------------------  
  Private   Const   SWP_NOOWNERZORDER   =   &H200  
  Private   Const   SWP_HIDEWINDOW   =   &H80  
  Private   Const   SWP_NOACTIVATE   =   &H10  
  Private   Const   SWP_NOMOVE   =   &H2  
  Private   Const   SWP_NOREDRAW   =   &H8  
  Private   Const   SWP_NOREPOSITION   =   SWP_NOOWNERZORDER  
  Private   Const   SWP_NOSIZE   =   &H1  
  Private   Const   SWP_NOZORDER   =   &H4  
  Private   Const   SWP_SHOWWINDOW   =   &H40  
  Private   Const   RESOURCETYPE_DISK   =   &H1     网络驱动器  
  Private   Const   RESOURCETYPE_PRINT   =   &H2   网络打印机  
  /------------------------------------------------------------  
  Private   Const   NoError   =   0  
  Private   Const   CSIDL_DESKTOP   =   &H0  
  Private   Const   CSIDL_PROGRAMS   =   &H2  
  Private   Const   CSIDL_CONTROLS   =   &H3  
  Private   Const   CSIDL_PRINTERS   =   &H4  
  Private   Const   CSIDL_PERSONAL   =   &H5  
  Private   Const   CSIDL_FAVORITES   =   &H6  
  Private   Const   CSIDL_STARTUP   =   &H7  
  Private   Const   CSIDL_RECENT   =   &H8  
  Private   Const   CSIDL_SENDTO   =   &H9  
  Private   Const   CSIDL_BITBUCKET   =   &HA  
  Private   Const   CSIDL_STARTMENU   =   &HB  
  Private   Const   CSIDL_DESKTOPDIRECTORY   =   &H10  
  Private   Const   CSIDL_DRIVES   =   &H11  
  Private   Const   CSIDL_NETWORK   =   &H12  
  Private   Const   CSIDL_NETHOOD   =   &H13  
  Private   Const   CSIDL_FONTS   =   &H14  
  Private   Const   CSIDL_TEMPLATES   =   &H15  
  Private   Const   LF_FACESIZE   =   32  
  Private   Const   MAX_PATH   =   260  
  Private   Const   CF_INITTOLOGFONTSTRUCT   =   &H40&  
  Private   Const   CF_FIXEDPITCHONLY   =   &H4000&  
  Private   Const   CF_EFFECTS   =   &H100&  
  Private   Const   ITALIC_FONTTYPE   =   &H200  
  Private   Const   BOLD_FONTTYPE   =   &H100  
  Private   Const   CF_NOFACESEL   =   &H80000  
  Private   Const   CF_NOSCRIPTSEL   =   &H800000  
  Private   Const   CF_PRINTERFONTS   =   &H2  
  Private   Const   CF_SCALABLEONLY   =   &H20000  
  Private   Const   CF_SCREENFONTS   =   &H1  
  Private   Const   CF_SHOWHELP   =   &H4&  
  Private   Const   CF_BOTH   =   (CF_SCREENFONTS   Or   CF_PRINTERFONTS)  
  /------------------------------------------  
  Private   Type   CHOOSECOLOR  
                  lStructSize   As   Long  
                  hwndOwner   As   Long  
                  hInstance   As   Long  
                  rgbResult   As   Long  
                  lpCustColors   As   String  
                  flags   As   Long  
                  lCustData   As   Long  
                  lpfnHook   As   Long  
                  lpTemplateName   As   String  
  End   Type  
  Private   Type   OPENFILENAME  
                  lStructSize   As   Long  
                  hwndOwner   As   Long  
                  hInstance   As   Long  
                  lpstrFilter   As   String  
                  lpstrCustomFilter   As   String  
                  nMaxCustFilter   As   Long  
                  nFilterIndex   As   Long  
                  lpstrFile   As   String  
                  nMaxFile   As   Long  
                  lpstrFileTitle   As   String  
                  nMaxFileTitle   As   Long  
                  lpstrInitialDir   As   String  
                  lpstrTitle   As   String  
                  flags   As   Long  
                  nFileOffset   As   Integer  
                  nFileExtension   As   Integer  
                  lpstrDefExt   As   String  
                  lCustData   As   Long  
                  lpfnHook   As   Long  
                  lpTemplateName   As   String  
  End   Type  
  /-----------------------------------------------------------  
  Private   Type   LOGFONT  
                  lfHeight   As   Long  
                  lfWidth   As   Long  
                  lfEscapement   As   Long  
                  lfOrientation   As   Long  
                  lfWeight   As   Long  
                  lfItalic   As   Byte  
                  lfUnderline   As   Byte  
                  lfStrikeOut   As   Byte  
                  lfCharSet   As   Byte  
                  lfOutPrecision   As   Byte  
                  lfClipPrecision   As   Byte  
                  lfQuality   As   Byte  
                  lfPitchAndFamily   As   Byte  
                  lfFaceName   As   String   *   LF_FACESIZE  
  End   Type  
  Private   Type   CHOOSEFONT  
                  lStructSize   As   Long  
                  hwndOwner   As   Long  
                  hdc   As   Long  
                  lpLogFont   As   Long  
                  iPointSize   As   Long  
                  flags   As   Long  
                  rgbColors   As   Long  
                  lCustData   As   Long  
                  lpfnHook   As   Long  
                  lpTemplateName   As   String  
                  hInstance   As   Long  
                  lpszStyle   As   String  
                  nFontType   As   Integer  
                  MISSING_ALIGNMENT   As   Integer  
                  nSizeMin   As   Long  
                  nSizeMax   As   Long  
    End   Type  
  /--------------  
  Private   Type   SHITEMID  
          cb   As   Long  
          abID()   As   Byte  
  End   Type  
  Private   Type   ITEMIDLIST  
            mkid   As   SHITEMID  
  End   Type  
  /------------------------------------------  
  Private   Declare   Function   SHGetPathFromIDList   Lib   "shell32.dll"   Alias   "SHGetPathFromIDListA"   _  
                                                              (ByVal   Pidl   As   Long,   ByVal   pszPath   As   String)   As   Long  
  Private   Declare   Function   SHGetSpecialFolderLocation   Lib   "shell32.dll"   _  
                                                              (ByVal   hwndOwner   As   Long,   ByVal   nFolder   As   Long,   _  
                                                                Pidl   As   ITEMIDLIST)   As   Long  
  /------------------------------------------  
  Private   Declare   Function   GetSaveFileName   Lib   "comdlg32.dll"   Alias   "GetSaveFileNameA"   (pOpenfilename   As   OPENFILENAME)   As   Long  
  Private   Declare   Function   GetOpenFileName   Lib   "comdlg32.dll"   Alias   "GetOpenFileNameA"   (pOpenfilename   As   OPENFILENAME)   As   Long  
  Private   Declare   Function   CHOOSECOLOR   Lib   "comdlg32.dll"   Alias   "ChooseColorA"   (pChoosecolor   As   CHOOSECOLOR)   As   Long  
  Private   Declare   Function   WNetConnectionDialog   Lib   "mpr.dll"   (ByVal   hWnd   As   Long,   ByVal   dwType   As   Long)   As   Long  
  Private   Declare   Function   CHOOSEFONT   Lib   "comdlg32.dll"   Alias   "ChooseFontA"   (pChooseFont   As   CHOOSEFONT)   As   Long  
  /=======显示断开网络资源对话框============  
  Private   Declare   Function   WNetDisconnectDialog   Lib   "mpr.dll"   _  
              (ByVal   hWnd   As   Long,   ByVal   dwType   As   Long)   As   Long  
  /================================================================================  
  Private   Declare   Sub   CoTaskMemFree   Lib   "ole32.dll"   (ByVal   pv   As   Long)  
  Private   Declare   Function   SHBrowseForFolder   Lib   "shell32.dll"   Alias   "SHBrowseForFolderA"   _  
                                                                                                (lpBrowseInfo   As   BROWSEINFO)   As   Long  
  Private   Type   BROWSEINFO  
          hOwner   As   Long  
          pidlRoot   As   Long  
          pszDisplayName   As   String  
          lpszTitle   As   String  
          ulFlags   As   Long  
          lpfn   As   Long  
          lParam   As   Long  
          iImage   As   Long  
  End   Type  
  /结构说明:   _  
                      hOwner   调用这个对话框的窗口的句柄   _  
                      pidlRoot   指向你希望浏览的最上面的文件夹的符列表   _  
                      pszDisplayName   用于保存用户所选择的文件夹的显示名的缓冲区   _  
                      lpszTitle   浏览对话框的标题   _  
                      ulFlags     决定浏览什么的标志(见下)   _  
                      lpfn     当事件发生时对话框调用的回调函数的地址.可将它设定为NULL   _  
                      lparam   若定义了回调函数,则为传递给回调函数的值   _  
                      iImage   As   Long     保存所选文件夹映像索引的缓冲区   _  
  ulFlags参数(见下:)  
  Private   Const   BIF_RETURNONLYFSDIRS   =   &H1           仅允许浏览文件系统文件夹  
  Private   Const   BIF_DONTGOBELOWDOMAIN   =   &H2         利用这个值强制用户仪在网上邻居的域级别中  
  Private   Const   BIF_STATUSTEXT   =   &H4                       在选择对话中显示状态栏  
  Private   Const   BIF_RETURNFSANCESTORS   =   &H8         返回文件系统祖先  
  Private   Const   BIF_BROWSEFORCOMPUTER   =   &H1000   允许浏览计算机  
  Private   Const   BIF_BROWSEFORPRINTER   =   &H2000     允许游览打印机文件夹  
  /--------------------------------------------------------------------------------  
  Dim   FontInfo   As   SmFontAttr               字体  
  /--------------------------------------------------------------------------------  
   
  Private   Function   GetFolderValue(wIdx   As   Integer)   As   Long  
          If   wIdx   <   2   Then  
              GetFolderValue   =   0  
          ElseIf   wIdx   <   12   Then  
              GetFolderValue   =   wIdx  
          Else  
              GetFolderValue   =   wIdx   +   4  
          End   If  
  End   Function  
   
  Private   Function   GetReturnType()   As   Long  
      Dim   dwRtn   As   Long  
      dwRtn   =   dwRtn   Or   BIF_RETURNONLYFSDIRS  
      GetReturnType   =   dwRtn  
  End   Function  
   
 

接上  
   
  文件夹选择对话框  
  函数:SaveFile  
  参数:Title         设置对话框的标签.  
            hWnd           调用此函数的HWND  
            FolderID   SmBrowFolder枚举(默认:我的电脑).  
  返回值:String   文件夹路径.  
  例子：  
  Public   Function   GetFolder(Optional   Title   As   String,   _  
                                                      Optional   hWnd   As   Long,   _  
                                                      Optional   FolderID   As   SmBrowFolder   =   MyComputer)   As   String  
      Dim   Bi   As   BROWSEINFO  
      Dim   Pidl   As   Long  
      Dim   Folder   As   String  
      Dim   IDL   As   ITEMIDLIST  
      Dim   nFolder   As   Long  
      Dim   ReturnFol   As   String  
      Dim   Fid   As   Integer  
       
      Fid   =   FolderID  
      Folder   =   String$(255,   Chr$(0))  
      With   Bi  
                .hOwner   =   hWnd  
                nFolder   =   GetFolderValue(Fid)  
                If   SHGetSpecialFolderLocation(ByVal   hWnd,   ByVal   nFolder,   IDL)   =   NoError   Then  
                      .pidlRoot   =   IDL.mkid.cb  
                End   If  
                .pszDisplayName   =   String$(MAX_PATH,   Fid)  
           
                If   Len(Title)   >   0   Then  
                    .lpszTitle   =   Title   &   Chr$(0)  
                Else  
                    .lpszTitle   =   "请选择文件夹:"   &   Chr$(0)  
                End   If  
         
              .ulFlags   =   GetReturnType()  
      End   With  
       
      Pidl   =   SHBrowseForFolder(Bi)  
      /返回所选的文件夹路径  
      If   SHGetPathFromIDList(ByVal   Pidl,   ByVal   Folder)   Then  
            ReturnFol   =   Left$(Folder,   InStr(Folder,   Chr$(0))   -   1)  
            If   Right$(Trim$(ReturnFol),   1)   <>   "\"   Then   ReturnFol   =   ReturnFol   &   "\"  
            GetFolder   =   ReturnFol  
      Else  
          GetFolder   =   ""  
      End   If  
  End   Function  
   
  文件保存对话框  
  函数:SaveFile  
  参数:WinHwnd       调用此函数的HWND  
            BoxLabel     设置对话框的标签.  
            StartPath   设置初始化路径.  
            FilterStr   文件过滤.  
            Flag             标志.(参考MSDN)  
  返回值:String   文件名.  
  例子：  
  Public   Function   SaveFile(WinHwnd   As   Long,   _  
                                                    Optional   BoxLabel   As   String   =   "",   _  
                                                    Optional   StartPath   As   String   =   "",   _  
                                                    Optional   FilterStr   =   "*.*|*.*",   _  
                                                    Optional   Flag   As   Variant   =   &H4   Or   &H200000)   As   String  
      Dim   Rc   As   Long  
      Dim   pOpenfilename   As   OPENFILENAME  
      Dim   Fstr1()   As   String  
      Dim   Fstr   As   String  
      Dim   I   As   Long  
      Const   MAX_Buffer_LENGTH   =   256  
       
      On   Error   Resume   Next  
       
      If   Len(Trim$(StartPath))   >   0   Then  
            If   Right$(StartPath,   1)   <>   "\"   Then   StartPath   =   StartPath   &   "\"  
            If   Dir$(StartPath,   vbDirectory   +   vbHidden)   =   ""   Then  
                  StartPath   =   App.Path  
            End   If  
      Else  
            StartPath   =   App.Path  
      End   If  
      If   Len(Trim$(FilterStr))   =   0   Then  
            Fstr   =   "*.*|*.*"  
      End   If  
      Fstr1   =   Split(FilterStr,   "|")  
      For   I   =   0   To   UBound(Fstr1)  
              Fstr   =   Fstr   &   Fstr1(I)   &   vbNullChar  
      Next  
      /--------------------------------------------------  
      With   pOpenfilename  
                .hwndOwner   =   WinHwnd  
                .hInstance   =   App.hInstance  
                .lpstrTitle   =   BoxLabel  
                .lpstrInitialDir   =   StartPath  
                .lpstrFilter   =   Fstr  
                .nFilterIndex   =   1  
                .lpstrDefExt   =   vbNullChar   &   vbNullChar  
                .lpstrFile   =   String(MAX_Buffer_LENGTH,   0)  
                .nMaxFile   =   MAX_Buffer_LENGTH   -   1  
                .lpstrFileTitle   =   .lpstrFile  
                .nMaxFileTitle   =   MAX_Buffer_LENGTH  
                .lStructSize   =   Len(pOpenfilename)  
                .flags   =   Flag  
      End   With  
      Rc   =   GetSaveFileName(pOpenfilename)  
      If   Rc   Then  
            SaveFile   =   Left$(pOpenfilename.lpstrFile,   pOpenfilename.nMaxFile)  
      Else  
          SaveFile   =   ""  
      End   If  
  End   Function  
   
   
  文件打开对话框  
  函数:OpenFile  
  参数:WinHwnd       调用此函数的HWND  
            BoxLabel     设置对话框的标签.  
            StartPath   设置初始化路径.  
            FilterStr   文件过滤.  
            Flag             标志.(参考MSDN)  
  返回值:String   文件名.  
  例子：  
  Public   Function   OpenFile(WinHwnd   As   Long,   _  
                                                    Optional   BoxLabel   As   String   =   "",   _  
                                                    Optional   StartPath   As   String   =   "",   _  
                                                    Optional   FilterStr   =   "*.*|*.*",   _  
                                                    Optional   Flag   As   Variant   =   &H8   Or   &H200000)   As   String  
      Dim   Rc   As   Long  
      Dim   pOpenfilename   As   OPENFILENAME  
      Dim   Fstr1()   As   String  
      Dim   Fstr   As   String  
      Dim   I   As   Long  
      Const   MAX_Buffer_LENGTH   =   256  
       
      On   Error   Resume   Next  
       
      If   Len(Trim$(StartPath))   >   0   Then  
            If   Right$(StartPath,   1)   <>   "\"   Then   StartPath   =   StartPath   &   "\"  
            If   Dir$(StartPath,   vbDirectory   +   vbHidden)   =   ""   Then  
                  StartPath   =   App.Path  
            End   If  
      Else  
            StartPath   =   App.Path  
      End   If  
      If   Len(Trim$(FilterStr))   =   0   Then  
            Fstr   =   "*.*|*.*"  
      End   If  
      Fstr   =   ""  
      Fstr1   =   Split(FilterStr,   "|")  
      For   I   =   0   To   UBound(Fstr1)  
              Fstr   =   Fstr   &   Fstr1(I)   &   vbNullChar  
      Next  
      With   pOpenfilename  
                .hwndOwner   =   WinHwnd  
                .hInstance   =   App.hInstance  
                .lpstrTitle   =   BoxLabel  
                .lpstrInitialDir   =   StartPath  
                .lpstrFilter   =   Fstr  
                .nFilterIndex   =   1  
                .lpstrDefExt   =   vbNullChar   &   vbNullChar  
                .lpstrFile   =   String(MAX_Buffer_LENGTH,   0)  
                .nMaxFile   =   MAX_Buffer_LENGTH   -   1  
                .lpstrFileTitle   =   .lpstrFile  
                .nMaxFileTitle   =   MAX_Buffer_LENGTH  
                .lStructSize   =   Len(pOpenfilename)  
                .flags   =   Flag  
      End   With  
      Rc   =   GetOpenFileName(pOpenfilename)  
      If   Rc   Then  
            OpenFile   =   Left$(pOpenfilename.lpstrFile,   pOpenfilename.nMaxFile)  
      Else  
            OpenFile   =   ""  
      End   If  
  End   Function  
   
 

颜色对话框  
  函数:GetColor  
  参数:  
  返回值:Long,用户所选择的颜色.  
  例子：  
  Public   Function   GetColor()   As   Long  
      Dim   Rc   As   Long  
      Dim   pChoosecolor   As   CHOOSECOLOR  
      Dim   CustomColor()   As   Byte  
      With   pChoosecolor  
                .hwndOwner   =   0  
                .hInstance   =   App.hInstance  
                .lpCustColors   =   StrConv(CustomColor,   vbUnicode)  
                .flags   =   0  
                .lStructSize   =   Len(pChoosecolor)  
      End   With  
      Rc   =   CHOOSECOLOR(pChoosecolor)  
      If   Rc   Then  
                  GetColor   =   pChoosecolor.rgbResult  
      Else  
                  GetColor   =   -1  
      End   If  
  End   Function  
   
  显示映射网络驱动器对话框  
  函数:ConnectDisk  
  参数:hWnd   调用此函数的窗口HWND.(ME.HWN)  
  返回值:=0,成功,<>0,失败.  
  例子：  
  Public   Function   ConnectDisk(Optional   hWnd   As   Long)   As   Long  
      Dim   Rc   As   Long  
      If   IsNumeric(hWnd)   Then  
            Rc   =   WNetConnectionDialog(hWnd,   RESOURCETYPE_DISK)  
      Else  
            Rc   =   WNetConnectionDialog(0,   RESOURCETYPE_DISK)  
      End   If  
      ConnectDisk   =   Rc  
  End   Function  
   
  显示映射网络打印机对话框  
  函数:ConnectPrint  
  参数:hWnd   调用此函数的窗口HWND.(ME.HWN)  
  返回值:=0,成功,<>0,失败.  
  例子：  
  Public   Function   ConnectPrint(Optional   hWnd   As   Long)   As   Long  
      Dim   Rc   As   Long  
      If   IsNumeric(hWnd)   Then  
            Rc   =   WNetConnectionDialog(hWnd,   RESOURCETYPE_PRINT)  
      Else  
            Rc   =   WNetConnectionDialog(0,   RESOURCETYPE_PRINT)  
      End   If  
  End   Function  
   
  断开映射网络驱动器对话框  
  函数:DisconnectDisk  
  参数:hWnd   调用此函数的窗口HWND.(ME.HWN)  
  返回值:=0,成功,<>0,失败.  
  例子：  
  Public   Function   DisconnectDisk(Optional   hWnd   As   Long)   As   Long  
      Dim   Rc   As   Long  
      If   IsNumeric(hWnd)   Then  
            Rc   =   WNetDisconnectDialog(hWnd,   RESOURCETYPE_DISK)  
      Else  
            Rc   =   WNetDisconnectDialog(0,   RESOURCETYPE_DISK)  
      End   If  
  End   Function  
   
  断开映射网络打印机关话框  
  函数:DisconnectPrint  
  参数:hWnd   调用此函数的窗口HWND.(ME.HWN)  
  返回值:=0,成功,<>0,失败.  
  例子：  
  Public   Function   DisconnectPrint(Optional   hWnd   As   Long)   As   Long  
      Dim   Rc   As   Long  
      If   IsNumeric(hWnd)   Then  
            Rc   =   WNetDisconnectDialog(hWnd,   RESOURCETYPE_PRINT)  
      Else  
            Rc   =   WNetDisconnectDialog(0,   RESOURCETYPE_PRINT)  
      End   If  
  End   Function  
   
  字体选择对话框  
  函数:GetFont  
  参数:WinHwnd   调用此函数的窗口HWND.(ME.HWN)  
  返回值:SmFontAttr   结构变量.  
  例子：  
                Dim   mDialog   As   New   SmDialog  
                Dim   mFontInfo   As   SmFontAttr  
                mFontInfo   =   mDialog.GetFont(Me.hWnd)  
                Set   mDialog   =   Nothing  
  Public   Function   GetFont(WinHwnd   As   Long)   As   SmFontAttr  
                  Dim   Rc   As   Long  
                  Dim   pChooseFont   As   CHOOSEFONT  
                  Dim   pLogFont   As   LOGFONT  
                   
                  With   pLogFont  
                            .lfFaceName   =   StrConv(FontInfo.FontName,   vbFromUnicode)  
                            .lfItalic   =   FontInfo.FontItalic  
                            .lfUnderline   =   FontInfo.FontUnderLine  
                            .lfStrikeOut   =   FontInfo.FontStrikeou  
                  End   With  
                  With   pChooseFont  
                            .hInstance   =   App.hInstance  
                            If   IsNumeric(WinHwnd)   Then   .hwndOwner   =   WinHwnd  
                            .flags   =   CF_BOTH   +   CF_INITTOLOGFONTSTRUCT   +   CF_EFFECTS   +   CF_NOSCRIPTSEL  
                            If   IsNumeric(FontInfo.FontSize)   Then   .iPointSize   =   FontInfo.FontSize   *   10  
                            If   FontInfo.FontBod   Then   .nFontType   =   .nFontType   +   BOLD_FONTTYPE  
                            If   IsNumeric(FontInfo.FontColor)   Then   .rgbColors   =   FontInfo.FontColor  
                            .lStructSize   =   Len(pChooseFont)  
                            .lpLogFont   =   VarPtr(pLogFont)  
                  End   With  
                  Rc   =   CHOOSEFONT(pChooseFont)  
                  If   Rc   Then  
                        FontInfo.FontName   =   StrConv(pLogFont.lfFaceName,   vbUnicode)  
                        FontInfo.FontName   =   Left$(FontInfo.FontName,   InStr(FontInfo.FontName,   vbNullChar)   -   1)  
                        With   pChooseFont  
                                  FontInfo.FontSize   =   .iPointSize   /   10                                         返回字体大小  
                                  FontInfo.FontBod   =   (.nFontType   And   BOLD_FONTTYPE)               返回是/否黑体  
                                  FontInfo.FontItalic   =   (.nFontType   And   ITALIC_FONTTYPE)     是/否斜体  
                                  FontInfo.FontUnderLine   =   (pLogFont.lfUnderline)                   是/否下划线  
                                  FontInfo.FontStrikeou   =   (pLogFont.lfStrikeOut)  
                                  FontInfo.FontColor   =   .rgbColors  
                        End   With  
                  End   If  
                  GetFont   =   FontInfo  
  End   Function  
   
  文件打开.(带预览文件功能)  
  函数:BrowFile  
  参数:Pattern   文件类型字符串,StarPath   开始路径,IsBrow   是否生成预览  
  返回值:[确定]   文件路径.[取消]   空字符串  
  例:Me.Caption   =   FileBrow.BrowFile("图片文件|*.JPG;*.GIF;*.BMP|媒体文件|*.DAT;*.MPG;*.SWF;*.MP3;*.MP2")  
  Public   Function   BrowFile(Optional   Pattern   As   String   =   "*,*|*.*",   _  
                                                    Optional   StarPath   As   String   =   "C:\",   _  
                                                    Optional   IsBrow   As   Boolean   =   True)   As   String  
                 
                On   Error   Resume   Next  
                 
                If   Len(Trim$(Pattern))   =   0   Then   Pattern   =   "*.*|*.*"  
                P_FilePart   =   Pattern  
                P_StarPath   =   StarPath  
                P_IsBrow   =   IsBrow  
                FrmBrowFile.Show   1  
                BrowFile   =   P_FullFileName  
  End   Function  
   
  显示网上邻居  
  函数:ShowNetWork  
  参数:FrmCap   窗口标题,Labction   提示标签名.  
  返回值:[确定]     所选计算机名称.[取消]   空字符串.  
  例:  
  Public   Function   ShowNetWork(Optional   FrmCap   As   String   =   "网上邻居",   _  
                                                          Optional   Labction   As   String   =   "选择计算机名称.")   As   String  
                ShowLan.Hide  
                ShowLan.Caption   =   FrmCap  
                ShowLan.LabNNCaption   =   Labction  
                ShowLan.Show   1  
                ShowNetWork   =   P_NetReturnVal  
  End   Function  
   
 

• 海尔 H22
• 海尔 H120
• 顶星龙尊W
• 新华海风逸
• IBM T60
• IBM R60e
• IBM Z60
• IBM T43
• IBM X40
• IBM R50e
• 惠普 dv2100
• 惠普 Ze2500

• · 如何获得页面所有Session信息
• · ★ 放分，需要多少种理由？？...
• · imagecolorstotal() 和 imagecolorat（）的使用问题，散分。
• · ATL 中如何调用ActiveX... 大哥帮忙看看....
• · 请各位看看这个存储过程是那里出错的？？？并请说明。先谢谢了。。。。
• · 如何得到储存过程的返回值?
• · 如何获得页面所有Session信息
• · 如何判断一个http://localhost/test.htm是否存在呢？
• · 如何获得页面所有Session信息
• · 一个简单的问题
• · 如何获得页面所有Session信息
• · i+++i+++i++=??为什么?马上给分
• · 中国足球队终于为中国的足球改革注入了最后一针强心计
• · msc/C++ 7.0 的Run怎么不能用啊？Debug、compiler也都不行？
• · C#如何实现纵向进度条[属性里面肯定没有]
• · 请教文件读写简单问题
• · 在win98或者win me下,除了pws外,还有什么好的解释asp的软件,请提供下载地址.
• · win98启动后老弹出错误！！如何解决？

• · 笔记本测试软件
• · 笔记本网卡
• · cpu超频
• · cpu占用100
• · cpu如何超频
• · cpu正常温度
• · 什么是双核cpu
• · cpu的发展

• · 关于调用HyperTerminal的问题,急,也不知道该不该在这问(100分)
• · 初学者,IIS的配置?
• · 为什么我学习VC的第一个程序就出现错误？？？？
• · COBOL语言？？？
• · 我创建的按钮怎么被覆盖之后就不能再重新刷新了？高分!
• · 讨论:关于关闭数据库联接问题
• · 回调函数和菜单的问题
• · 为什么我重装了一次ENTERNET300后，我的朋友就无法共享我的宽带了？（WIN98）
• · 我的sql server2k死活连接不上
• · 数据库定时导入代码怎样写
• · 我的sql server2k死活连接不上
• · 关于维持容器中动态控件大小的问题
• · 一个表格中能不能做到鼠标单击其中的单元格时单元格的颜色变成其它不同的底色
• · JSP表单的输入中文问题，100分
• · 同一个数据库，不同的表，为什么写SQL语句格式会不一样。
• · 注册表查询问题。两个问题，一个50分！
• · 怎样获得开关机时间？急！！！！！！！！
• · 我的这个想法如何实现？关于DELPHI＋ASP的
• · 哪个打包工具能把安装程序制作成只有一个文件的样子?
• · 网络高手请进
• · 大家帮我看看代码，到底怎么回事
• · 请教关于微软几个WEB控件中的TreeView的问题，多谢