说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

通用对话框专辑(全) -VB资料

HTML文档下载 WORD文档下载 PDF文档下载
通用对话框专辑(全) -VB资料
使用API调用Winodws各种通用对话框(Common Diaglog)的方法(一)

1.文件属性对话框
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long '可选参数
lpClass As String '可选参数
hkeyClass As Long '可选参数
dwHotKey As Long '可选参数
hIcon As Long '可选参数
hProcess As Long '可选参数
End Type

Const SEE_MASK_INVOKEIDLIST = &HC
Const SEE_MASK_NOCLOSEPROCESS = &H40
Const SEE_MASK_FLAG_NO_UI = &H400

Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" _
(SEI As SHELLEXECUTEINFO) As Long
Public Function ShowProperties(filename As String, OwnerhWnd As Long) As Long
'打开指定文件的属性对话框,如果返回值<=32则出错
Dim SEI As SHELLEXECUTEINFO
Dim r As Long
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With
r = ShellExecuteEX(SEI)
ShowProperties = SEI.hInstApp
End Function

新建一个工程,添加一个按钮和名为Text1的文本框
把以下代码置入CommandbButton_Click 中
Dim r As Long
Dim fname As String
'从Text1 中获取文件名及路径
fname = (Text1)
r = ShowProperties(fname, Me.hwnd)
If r <= 32 Then MsgBox "Error"

2.使用Win95的关于对话框
Private Declare Function ShellAbout Lib "shell32.dll" _
Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, _
ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
示例:
Dim x As Long
x = shellabout (Form1.hwnd, "Visual Basic 6.0", _
"Alp Studio MouseTracker Ver 1.0", Form1.icon)

2.调用"捕获打印机端口"对话框
Private Declare Function WNetConnectionDialog Lib "mpr.dll" _
(ByVal hwnd As Long, ByVal dwType As Long) As Long
示例:
Dim x As Long
x = WNetConnectionDialog(Me.hwnd, 2)

3.调用颜色对话框
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 Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long

将以下代码置入某一事件中:
Dim cc As ChooseColor
Dim CustColor(16) As Long
cc.lStructSize = Len(cc)
cc.hwndOwner = Form1.hWnd
cc.hInstance = App.hInstance
cc.flags = 0
cc.lpCustColors = String$(16 * 4, 0)
Dim a
Dim x
Dim c1
Dim c2
Dim c3
Dim c4
a = ChooseColor(cc)
Cls
If (a) Then
MsgBox "Color chosen:" & Str$(cc.rgbResult)

For x = 1 To Len(cc.lpCustColors) Step 4
c1 = Asc(Mid$(cc.lpCustColors, x, 1))
c2 = Asc(Mid$(cc.lpCustColors, x + 1, 1))
c3 = Asc(Mid$(cc.lpCustColors, x + 2, 1))
c4 = Asc(Mid$(cc.lpCustColors, x + 3, 1))
CustColor(x / 4) = (c1) + (c2 * 256) + (c3 * 65536) + (c4 * 16777216)
MsgBox "Custom Color " & Int(x / 4) & " = " & CustColor(x / 4)
Next x
Else
MsgBox "Cancel was pressed"
End If

4.调用复制磁盘对话框
Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

示例:
向窗体中添加一个名为Drive1的DriveListBox,将以下代码置入某一事件中
Dim DriveLetter$, DriveNumber&, DriveType&
Dim RetVal&, RetFromMsg&
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - 65)
DriveType = GetDriveType(DriveLetter)
If DriveType = 2 Then 'Floppies, etc
RetVal = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll " _
& DriveNumber & "," & DriveNumber, 1) 'Notice space after
Else ' Just in case 'DiskCopyRunDll
RetFromMsg = MsgBox("Only floppies can" & vbCrLf & _
"be diskcopied!", 64, "DiskCopy Example")
End If

5.调用格式化软盘对话框
Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
参数设置:
fmtID-
3.5" 5.25"
-------------------------
0 1.44M 1.2M
1 1.44M 1.2M
2 1.44M 1.2M
3 1.44M 360K
4 1.44M 1.2M
5 720K 1.2M
6 1.44M 1.2M
7 1.44M 1.2M
8 1.44M 1.2M
9 1.44M 1.2M

选项
0 快速
1 完全
2 只复制系统文件
3 只复制系统文件
4 快速
5 完全
6 只复制系统文件
7 只复制系统文件
8 快速
9 完全
示例:要求同上
Dim DriveLetter$, DriveNumber&, DriveType&
Dim RetVal&, RetFromMsg%
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - 65) ' Change letter to Number: A=0
DriveType = GetDriveType(DriveLetter)
If DriveType = 2 Then 'Floppies, etc
RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
Else
RetFromMsg = MsgBox("This drive is NOT a removeable" & vbCrLf & _
"drive! Format this drive?", 276, "SHFormatDrive Example")
Select Case RetFromMsg
Case 6 'Yes
' UnComment to do it...
'RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
Case 7 'No
' Do nothing
End Select
End If
-----------------------------------------------------------------------------
使用API调用Winodws各种通用对话框(Common Diaglog)的方法(二)

1.选择目录/文件夹对话框
将以下代码置于一模块中
Option Explicit
' 调用方式:: string = BrowseForFolders(Hwnd,TitleOfDialog)
' 例如:String1 = BrowseForFolders(Hwnd, "Select target folder...")
Public Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
'初始化变量
With udtBI
.hwndOwner = hwndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With
'调用 API
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then sPath = Left$(sPath, iNull - 1)
End If
'如果选择取消, sPath = ""
BrowseForFolder = sPath
End Function
2.调用"映射网络驱动器"对话框
Private/Public Declare Function WNetConnectionDialog Lib "mpr.dll" _
(ByVal hwnd As Long, ByVal dwType As Long) As Long
x% = WNetConnectionDialog(Me.hwnd, 1)
3.调用"打开文件"对话框
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 Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
将以下代码置于某一事件中
Dim ofn As OPENFILENAME
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = Form1.hWnd
ofn.hInstance = App.hInstance
ofn.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "Rich Text Files (*.rtf)" + Chr$(0) + "*.rtf" + Chr$(0)
ofn.lpstrFile = Space$(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space$(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = curdir
ofn.lpstrTitle = "Our File Open Title"
ofn.flags = 0
Dim a
a = GetOpenFileName(ofn)
If (a) Then
MsgBox "File to Open: " + Trim$(ofn.lpstrFile)
Else
MsgBox "Cancel was pressed"
End If
4.调用"打印"对话框
Private Type PrintDlg
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
hdc As Long
flags As Long
nFromPage As Integer
nToPage As Integer
nMinPage As Integer
nMaxPage As Integer
nCopies As Integer
hInstance As Long
lCustData As Long
lpfnPrintHook As Long
lpfnSetupHook As Long
lpPrintTemplateName As String
lpSetupTemplateName As String
hPrintTemplate As Long
hSetupTemplate As Long
End Type
Private Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PrintDlg) As Long
'将以下代码置于某一事件中
Dim tPrintDlg As PrintDlg
tPrintDlg.lStructSize = Len(tPrintDlg)
tPrintDlg.hwndOwner = Me.hwnd
tPrintDlg.hdc = hdc
tPrintDlg.flags = 0
tPrintDlg.nFromPage = 0
tPrintDlg.nToPage = 0
tPrintDlg.nMinPage = 0
tPrintDlg.nMaxPage = 0
tPrintDlg.nCopies = 1
tPrintDlg.hInstance = App.hInstance
lpPrintTemplateName = "Print Page"
Dim a
a = PrintDlg(tPrintDlg)
If a Then
lFromPage = tPrintDlg.nFromPage
lToPage = tPrintDlg.nToPage
lMin = tPrintDlg.nMinPage
lMax = tPrintDlg.nMaxPage
lCopies = tPrintDlg.nCopies
PrintMyPage 'Custom printing Subroutine
End If
在GotFocus时快速选择文本 -VB资料 在VB中使用文件对象 在VB中使用艺术字 在VB中引用.dbf及索引文件 在Windows操作系统中改变文件打开方式-VB资料 在程序运行时,怎样把多个文本框的内容保存起来-VB资料 在打印字符串时自动换行 -VB资料 在文本框中快速增加一串字符-VB资料 在文本框中实现由加减号输入数据-VB资料 在引用项目找不到Excel、Word等Office软体Lib的解决法-VB资料 VB怎样从文件列表框中取得文件的完整路径和名称 VB制作一个有参数的执行文件(方法之简单难以想像) 资源档(.RES)的应用-VB资料 自定义Text的pop-up菜单-VB资料 自动出现动画、进度和确认的文件操作 -VB资料 自动选择 Text 的内容-VB资料 VB 调用 IMAGE 控件实现图像缩放的一种方法 VB5 实 现 窗 口 图 像 缩 放、 滚 动 技 巧 VB编程之提速攻略(一) VB开发通讯软件 VB实现图形动画的三种方法 VB随机图像的魅力 VB中不规则图形热点的实现 VB中任意旋转位图的实现 VB中实现图像特技 VB中随机图像的魅力 VB中位图旋转的实现 Visual Basic设计图形浏览器示例 捕捉屏幕图象 -VB资料 放置“透明”的图片-VB资料 分割图像的方法-VB资料 关于asp打印的一些设置的请教 dbgrid显示不同小数位数问题 关于用nmudp实现传输!up也有分,:)) 我在WSAD5.0中创建的WAS 5.0Server 为什么总是启动出错???请各位高手指点!!! 关于Apache+mysql 100分求《设计模式-可复用面向对象软件的基础》电子书! 向oracle 中插入纪录,日期格式由问题,见内 在线等候 在企业管理器里附加了一数据库,显示为readonly,为什么!!!! 就要实习了,不知哪些公司比较乐意接受实习生呢 急!!请问如何在WEB自定义控件中响应事件? 本人最近写了一个服务器端文件管理的程序,基本的功能都已经实现,但是下载的功能还是不行,欢迎大家讨论实现。 奇怪的comboBox的数据绑定问题! 为什么不能把记录成批插入到表中? 在VC中操作access:update的where子句中用"and"组织成多个表达式时出错! 在线等候 怎么将数据库中的字段项动态的添加到COMBOX里面去。(我用的是DB2数据库) sql关于多个数据库的问题 散分了! 我也散点分吧 有些话不吐不快!看某不知来历的版主下台后发贴有感 不知道是怎么回事,难道是显示器坏了? 启动windowns2000报错"no language support detected",请问怎么解决? WIN ME下怎么调试 ASP? oracle 存储过程代码格式优化 大家看过《ASP.NET完全手册》这本书吗?为什么书中提供的与书想配的站点http://www.prosetech.com/CompleteReference/不可访问呢? 紧急求救:如何根据数据库中的值以红色字体显示datagrid中的满足条件特定列特定行? 能不能实现用NOTES databse打开一个website(公司内部的),同时这个database自动关闭?? 用pear的进来报个名,以后互相学习~ VB.NET的两个简单问题??? not enough free disk space on /tmp,这个问题如何解决,(100分) 急寻:中缀和后缀表达式互转的源代码。 请问这个页面如何实现的..... 简单问题,在线等待中... 百分求购事务处理!! 用ATL写了一个com组件,在客户端怎么调用它呢? 请问如何取得USB摄像头和普通麦克的数据,怎样将已得到的视频音频数据在终端上播放 如何让WAS和Tomcat一样,运行JSP/SERVLET的时候出现错误进行提示? 用JDBC连接SQL Server 2000数据库问题?在线等待... 弹出式菜单的问题 各位大侠,寻求帮助,急!急! c语言类中的私有和公有变量在汇编中怎么表示? 关于EJB测试的问题 谁能给个错误处理的例子 比如 SQLSERVER 数据库关闭时 返回 “数据库关闭“ 的信息 部分匹配的问题 英文版XP中文显示问题 oracle,用PreparedStatement更新数据库,date型字段精确到分,应该如何操作? 数据导入的问题 有正义感的高手进来帮忙,干掉我设计的网站吧!在此不盛感激,同时也代表天下IT民工谢谢。 开始学PHP的菜鸟说:我现在用一个支持PHP的空间。比如XXX.PHP就可以用。我想用数据库。怎么连接呢?我可以把数据库放到自己的目录下用数 送分 以退为进的名言警句有哪些 俗话说的好:“留得青山在,不怕没柴烧.”你知道历史上有哪些青松似的人以退为进、忍辱负重,最终取得胜利的故事?收集收集,和同学交流一下. 收集“以退为进”,“以屈为伸”相关的名言警句请尽快!谢谢! “;”这个标点符号算一句么 急啊啊啊通计一舟,为五人;为八窗;为蒻蓬,为为楫,为炉,为壶,为手卷,为念珠各一;对联、题名并篆文,为字共三十有四;而计其长曾不盈寸. 就是这句话我们老 藏族民歌的特点藏族民歌都有什么主要特点啊?举例说明... enable的用法怎么用?我在外企,公司里这个词用的很多,但是不能理解怎么用? E人E本的九宫格密码我给忘了.这怎么能解开啊.那九宫格是绘制图形那样的、哪位高手能告诉我. 是不是每一件事都是有规律可循的?那为什么还要有特别的规定? 策论文章是什么 德语的不定冠词都有哪些规律可循呢? 急!策论参考大家好,帮我提供一下有关策论的定义及写作方法,如果有模似最好不过了,谢谢! 朝鲜称将继续发射卫星 金正恩首迎外国布鲁姆米兰达赴舞台剧 疑密谋离婚事宜杰克逊私人医生刑满出狱 欲再获行医执聚焦全球健康服务业 看产业带来的经济中断30年 美国与新西兰恢复联合军演格鲁吉亚新当选总统:将与俄构筑建设性迈克尔杰克逊私人医生刑满出狱 欲再获英国遭近年最大暴风雨袭击 交通受阻数翘臀又嘟嘴 壮汉翻拍“性感照”遭吐槽婚外情网站进军狮城遇阻西飞成波音737MAX供应商中国动漫集团ESCC大赛南京开赛中国文化走出去需要广阔视野第27届中国电视金鹰奖评选结果揭晓迪马利亚独造4球让曼联提档 逆天任意英超-天使处子球鲁尼平亨利纪录 曼联詹俊解说曼联模仿周星驰:今天的心情大袁隆平田间操控遥控飞机 农业航空科技“塞上新丝路”2014全国网络媒体宁第12届中国西部民歌(花儿)歌会闭幕全国网媒记者走进中华回乡文化园小区公共建筑变身餐厅 昆明阳光海岸业
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘