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

通用对话框专辑(全) -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
VB如何在VB和Delphi中快速实现立体化窗口显示 VB如何在VB中实现绘图区的大十字光标 VB如何在VB中制作不回显的文本框 VB如何制作浮动式窗口 闪烁的Label-VB资料 设定StatusBar的文字成不同的颜色-VB资料 设计一个可中断循环的按钮-VB资料 设置“执行无用户界面”-VB资料 生成一个透明窗体 -VB资料 实现窗体内部的左右移动 -VB资料 实现鼠标移到窗口上时变大,移出窗体时变小(如《东方快车》)-VB资料 实现图片平铺于窗体中-VB资料 使程序的标题条闪烁 -VB资料 使窗口总在最前 -VB资料 使窗体右上角的X按钮失效 -VB资料 VB使用 WIN95 的选择目录对话框 使指定窗口总处于其他窗口之上 -VB资料 通用对话框专辑(全) -VB资料 透明的Form上显示背景透通图 -VB资料 图像在图片框中的滚动 -VB资料 拖动无标题窗口-VB资料 拖动无系统标准标题栏的窗口-VB资料 文本框中光标位置的获得-VB资料 无关联程序时开启“打开方式”窗口 -VB资料 显示 Combo 的下拉条 -VB资料 显示Windows系统的标准ABOUT窗口-VB资料 显示程序的版本 -VB资料 显示窗口的水平和垂直滚动条-VB资料 一劳永逸让VB自动改变控件大小 移动没有标题栏的窗口 -VB资料 隐藏Win95任务栏 -VB资料 Interbase树形结构和递归调用问题,高手请进!!急!!!! 如何选出表中相同的纪录? 下面这些对编程风格的说法是否正确? Interbase树形结构和递归调用问题,高手请进!!急!!!! 请教dos中有没有类似notify的命令用于邮件通知 java有没有RTTI(runtime type information) 在DOS下开发软件,应该如何调用扩展内存? 高分求:Antechinus C# Editor4.2c和JavaScript Editor的注册码! 想自己做个字典软件,但是没有词库 怎样做个链接?链接邮件地址。 如何在工具栏statusbar的右下角(最后一个panel里)做一个走动的时钟 大家讨论一下开发JSP Web站点用什么工具比较好? 我想编一个网页管理软件,有如下要求。。。 大家帮看一下,加注释的一句是什么意思 高分求救!!有关数据同步!! 北京的程序员薪水如何(6000/月)? 大放分﹗﹗即放即給﹗﹗ 关于WinSock通信 我用怎样得到过滤后有多少条记录呢? 存储过程问题,还有些小麻烦,帮帮忙呀,谢谢:) 急~~!关于ChildView类的问问题~~!!请大家帮助。谢谢。 怎么用Container Managed Persistence EntityBean实现对数据库的增删改,最好用jsp调用 如何知道光驱是打开的还是关闭的??? 程序运行一会儿,BDE 数据库引擎空间不够,什么原因?? 在asp.net里怎么引用word对象,和对它进行操作??? 这个问题不好弄! 讨论:关于使用UDP作为服务器主要协议会碰到的问题? 我安装的rh8.0中,/dev/里的东东怎么都是0字节啊?! 请教,有什么工具能把jpeg图片转换为mpeag1视频,使它能在vcd上观看 如何指定PB6.5访问oracle9 i的默认用户名 多线程资源释放的问题 高手救命!!用pb如何实现用热键调出程序的功能 浏览帖子的问题 高难度:列表视图的重绘问题 编写active控件的问题 报错:变量使用了一个VbScript中不支持的Automation类型oMail.send 青帮忙解释一下一段关于显示VARRAY中数据的PL/SQL语句? 有什么工具能转real ->wmv or wma? 有一点点难。 近来十分不爽。大家进来聊天吧 如何让CEdit控件可以输入希腊字母 如何在asp中实现报表打印的问题,急! 平生第一次看演唱会---张学友温州演唱会。张学友真的老了,满脸的沧桑,但诗歌还是唱得那么好…… 数据库中的<input>的问题 早班火车 蓝色心情 三笑大法 般若什么密忘光光啦~ 角落的青苔:射手无弓?混得好糗啊 jennyvenus JennyVenus 你们违约,哼!!!!!!!!!!!!!!!! 请问在jsp或别的java程序中如何调用Delphi做的com组件?问了很久,没人知道吗? 关于JSP支持问题。 求一小段代码! 我有一个点连接<a href="setup/XXXX.exe">下载</a>但我想点下后既要下载还想用用Response.Execute(XXX.asp)来执行一个页面,该怎么做? 请问Delphi的编辑框中,是不是没有自动感应的功能! 注册dll组件,除了regsvr32,还有其它方法吗? document.layers返回是个什么值呢??各位大哥指点一下吧 宁海水泵日夜抽水 800亩水稻暂保平浙江多地高温致旱 杭州农田灌溉设备紧杭州市市管领导干部任前公示通告浙江试点公办初中小学教师校长交流制度浙江建公办初中小学教师校长“县域内”今年杭州市区40℃以上的高温日是之前杭长高铁上跨特大连续桥江山合拢浙江启动抗旱Ⅲ级应急响应 40多万人国家开发银行7亿资金 支持天台山景区杭城上周七天气温破四 本周将告别40浙江遭遇历史罕见旱灾 41.7万人饮杭州为抗旱抽水灌溉农作物 林区实施禁新昌昨44.1℃成最高纪录 杭本周仍杭州地铁5号线余杭段开始勘察 力争明杭州初拟用水应急预案 限制游泳等高耗因高温干旱 浙江103条小河断流82金华明起降雨增多 周末最高温或降至3杭州近100万亩农作物受灾 市财政拿金华市委常委钟关华兼任武义县委书记张鸿铭看望慰问坚守岗位的一线工作人员杭州改革行政审批 基建项目从15个月愿化身石桥,只为等你从桥上过皇马公布欧冠对马竞19人大名单,C罗职场中有这13种烂个性,别想成功了!每日七言 | 活得累是因为心里装了多孤岛曼哈顿:飓风月收入多少才适合贷款买房?看了这个答99%去香港的游客不知道可以这么玩!安帅:要想首回合一样踢球,已准备点球广西将实施阶梯气价 对你来说是降价还油条菜粥他为什么要娶一个妓女? | 一个温暖百名中国工艺美术大师战略联盟签约仪式恒大客场0-0战平FC首尔,小组头名借着Leap Motion入华,再来追踪引关注 各方努力下贺州市区小学午黑莓也做起了触屏手机 别人都可以唯独Google很可能于本月15日在印度男女之间的暗号,你知道多少呢?WCBA新赛季赛程出炉,延续南北分区亚洲海鲜展享誉回归因为一杯水而倒闭的餐厅,看完你明白了
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘