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

通用对话框专辑(全) -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
HTML5开发平台Ludei将支持3D游戏开发 《二战风云》发布至今,已为顽石互动狂赚2.7亿 腾讯开源基于HTML5技术的专业级图像处理引擎 AlloyImage Linux容器运行时Docker开源 360上线第三方漏洞收录平台 将现金奖励爆料者 UC推出iOS平台首个支持WebGL的浏览器 魔兽之父专访:今年游戏产业会出现一场革命 Instagram 5位传奇工程师背后的技术(PPT全译) Google云计算专家Jeff Dean与Sanjay Ghemawat获ACM Infosys基金会大奖 谷歌承诺不对开发、发行和使用开源软件的人专利诉讼 Web框架排行榜 Netty、Servlet和Vert.x位列前三 DARPA慷慨解囊的背后:Python与大数据的火花 研发周报:神奇!1KB JavaScript代码编写的3D蜜蜂 移动周报:65岁传奇Android工程师谈开发 “部落战争”开发商Supercell融资1亿美金 投资公司争先恐后 Kiip 90后华裔励志故事:从遭解雇到誉满全球 大数据基因测序的成本逼近1000美元:个性化医疗的时代来临 携程开放平台发力 将实现旗下产品全流程API支持 Puppet labs发布2013自动化运维报告 “国”字号开发者:航旅纵横负责人薄满辉专访 金山云杨钢:核心算法保证安全和低成本 加速软件交付 企业级模拟测试服务CA LISA受追捧 盛大云业务重点转向自服务 转战中小型企业:Prediction API请求一个月内飙升至7亿多次 利用光子 耶鲁大学研究人员让量子计算机离现实更近一步 技术为王的云计算会让IT部门消亡么? 从Discuz到APP:安米移动社区转化工具 覆盖全领域:Google、Facebook、Twitter等大师的最佳推荐 苹果CEO宣布更改保修政策 并向中国用户道歉 拒绝使用现有Web组件的6个愚蠢理由 Github宣布支持SVN方式访问 各位高手,这个复制的存储过程要怎样写啊? 怎么把自己的图片做成asp的底板图? 请问在DELPHI中编程怎样打开WORD,EXCEL,。TXT文件并使他们可见?(谢谢) 小女子问一个很小很小的问题。举手之劳 好不容易才找到ACTIVE SKIN4.27的破解机 JDK文档 1000分都给你!谁能列出最好的几本算法与数据结构书,并提供下载地址? 请教一个问题~~~~~~!在线等~! 1000分都给你!谁能列出最好的几本算法与数据结构书,并提供下载地址? 1000分都给你!谁能列出最好的几本算法与数据结构书,并提供下载地址? 请问sql server 2000数据库 的unicode->big5如何转换? 倒分揭露 vc我自建了一个子窗体类,点击主窗体时显示,怎么做啊? 难道我的word文档全都废了吗?? 帮帮忙!一个小问题!呵呵! "自助建站系统"到底能不能实现真正的二级域名、独立域名? 请看看我的代码有什么问题 如何将一个OLE对象转换为位图(注:不要截屏的方式) 在olecontainer里面调出的excel文档,如何使之不可编辑。 急救啊!这个字体怎么设置? 请问在jcreator下能不能编译成exe啊? small_wei进来领分! 初学这样的,觉得是很简单的思路,但找不出错误,有经验的帮忙看看 if a sql syntan can succeed in sql but asp... GDI+的问题 谁有FLASH的注册码,给个,谢谢 怎样用js写一个终止程序,类似asp的response.end 求教:学习MFC文件系统-针对一段代码的3个初学者问题 如何使98一开机就运行屏保!!!急!!!来者有分!帮忙了!!!!! 怪问题 <了解Struts1.1 > 我刚看到的一篇好文章,贴出来,大家共享 dayday up (: 如何驱动8139网卡(笔记本) interbase能与VC结合吗?另外想问有些软件与interbase一起打包安装,如何实现的呢? Lotus——你在哪里? 网络编程中遇到的几个问题(求助) 在java中调用javac.exe 紧急在线等待,求助!!!!! 我是新来的,很多都不懂!也没有朋友,有谁能和我做朋友么? 分手为什么只要一个人说了就算,为什么不能像离婚一样要双方同意,法院判决??? 关于从TImage继承创建自定义控件的问题? JRUN4怎么运行Servlet? 关于远程创建表,删除表的问题?请帮忙。 启动数据库时报 监听程序无法启动专用服务器进程???ORACLE 9.2.0.1.0 如何將指針作為參數傳遞。 请教vb自带的报表编程 在Sql语言中的取整函数是什么? 怎样将添加的记录到所有的现有记录后面? 如何装双系统?(在线等候) CSS一般要学多久才算掌握? 从事共享软件开发的进来谈谈做共享的辛酸好吗? 请教使用notifyicon遇到的问题 求《孙子兵法》以迂为直的意思最好举个例子. String basePath = request.getScheme()+"://"+request.getServerName()+":"+request.getServerPort()+pat 舟在碧波上,人在画中游中的碧是什么意思 迂是什么意思 迂能组什么词 开展综合实践活动课之前要做哪些方面的准备? 美国农业机械化对环境有什么影响 关于request的解释!‘就要这个解释两句说的通俗点就行了 综合实践活动是一门什么样的课程?(定义、性质与特点) 美国和澳大利亚农业机械化程度高,是因为什么自然因素? 若a^2+b^2+c^2=1 则3ab-3bc+2c^2最大值为 1、与传统的学科课程相比,综合实践活动课程有哪些新的特点?开设综合实践活动课程的意义和价值何在? 为什么农业机械化程度越高,成本会越低 这个字怎么读.(迩) 综合实践活动方法指导课是什么意思 用恰似造句 Pass应用有WP版吗?或者在国内有类似Pass社交的应用吗? 下列细胞的膜结构能合成ATP的是( )A 线粒体的外膜 B 叶绿体的类囊体薄膜 C 内质网的膜 D高尔基体的膜 恰似造句 听说现在都流行网络或者电话学英语,朋友介绍我去CEC,来问一下,CEC咋样? 体积相等的两个正方体,它的表面积也一定相等. pass cec英语的一对一外教,学过的朋友们,给点主意啊 OVM15-2(1)锚具 是什么意思? pass by可以理解为忽视吗? a+b+c=1,求ab^2c+abc^2的最大值 OVM15-22什么意思 背景中"迂"是什么意思 直6棱柱的全面积怎么算?底面积怎么算 锚具OVM15-2P什么意思? pass 与pass by的区别 不若从炉塘道 稍迂而路辟 ∫[-∞,+∞]e^(-t^2)dt等于多少,求详细解答 中"迂"是什么意思 友情是什么,它可以.造句 电工题,为什么du/dt不是等于0 天车某机构电机在工作时产生震动是什么原因 1.2小时等于多少分钟 谁知道这是什么动物,像猫但它脚好像比猫短,而且身体很臃肿啊.如图猫的脚怎么会这么短啊, 长虹饮涧中"立涧之东西望,则为日所铄都无所睹."是什么意思 PASS什么意思 两只脚的动物都有翅膀吗?今天突然想到这样的一个怪问题,我不内行.拿出来请各位朋友或专家指导一下:陆地上好象两只脚的动物都有翅膀一样.不知是不是这样?是不是这样?不过,我还是不满 立涧之东西望,则为日所铄, 英语高考作文提高本人写作文时只能写出普通的主谓宾结构句子和定语从句.有时想用一些短语时,又不知道该放在句子的什么位置,有谁有一些作文句子结构的样式(说明一下哪些词放在哪里? 解释“舟行碧波上,人在画中游.” 矩形AD等于5AB等于7E为动点三角形ADE沿AE折叠当点D的对应点D撇落在角ABC的角平分线上三角形AD撇B面积 判断:体积相等的两个正方体,表面积一定相等( ) 猫猫长翅膀是真的吗 AD A撇D撇分别是三角形ABC和三角形A撇B撇C撇的高 AB=A撇B撇 AD=A撇D撇 BC=B撇C撇 求证AC=A撇C撇今晚作业啊~! 判断2.两个正方体的表面积相等,体积一定相等【 】 elevated permission are required to run 写一篇关于你最喜欢的动物的英语文章.我喜欢狮子 急急急急急急急急急急急急急急!快 三角形ABC全等于三角形A撇B撇C撇 AD,A撇D撇分别是三角形ABC和三角形A撇B撇C撇的角平分线 求证AD=A撇D撇 判断:一个正方体的棱长扩大2倍,表面积扩大2倍,体积也扩大2倍.( ) pass in english这句话对不对in English是不是做了谓语,介词短语是不是不能做谓语的? 关于也买酒的pass,我已经有过消费记录如何获得也买酒pass码? 已知三角形abc和三角形a撇b撇c撇.中ab等于a撇b撇bc等于b撇c撇.设bc边上的高adb撇c撇边上的高a撇d撇,且ad等于a撇的d撇 美国农业机械化程度很高,但在发展的过程中也会对环境造成危害,请列出几例 迂绕是什么词 在△ABC和△A撇B撇C撇中,AB/A撇B撇=BC/B撇C撇=AC/A撇C撇=2/3,且△A撇B撇C撇的周长为80cm,求三角形ABC. 环保部:上半年新疆青海等省区氨氮排放北京5药店今起“自助”卖奶粉 可刷银广州公示积分入户入围者 申请者成功率“局长爆粗口”视频为4年前拍摄朝鲜蘑菇研究所竣工 肩负建设“蘑菇之印巴再起武装冲突 造成10名平民受伤英国伦敦征兵日到来 “小兵”穿军装有巴西世界杯一个在建场馆发生火灾中泰高铁合作将造福泰国和本地区人民70余国驻华使馆设台参加国际义卖摩根大通同意支付51亿美元了结欺诈指英国伦敦征兵日到来 “小兵”穿军装有德国高层代表团将赴美 跟进默克尔被窃德国高层代表团将赴美 跟进默克尔被窃流浪女杭州街头诞下龙凤胎续:执意回到各国领导人都钟爱什么手机?杭州立“塔”打“井” “上天入地”要浙江省政协向社会公开征集提案线索 可马云谈\"来往\":我和马化腾在下棋国家卫计委要求严惩温岭医生被刺事件凶伊朗停丰度20%铀浓缩 伊朗政府尚未美国退休工程师将退役客机改造为舒适住每日收藏指南出国整形只是“看上去很美”关注中段和值回归感受足球之国的狂野与激情总决赛第二战 热火强势反弹?平潭国际自行车公开赛开赛图片新闻世界杯“音乐豪华阵容打造鹏城消费盛宴加拿大再现 直升机越狱505名孕妇同练瑜伽一群好汉群星《我欣中的罗大佑》东莞市民掀开被子见巨蟒 疑因天热来“济南弃婴岛不再接收一岁以上孩子 为省台湾星云大师“一字笔书法” 来山东省山东高考考生谈报考哪类院校:学技术有2014年山东高考语文试图参考答案公星云大师:山东人的性格可以普及到全中中国海军将派舰艇参加“环太平洋 20
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘