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

通用对话框专辑(全) -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
120万操作/秒Redis Cloud 集群单一服务器非基准测试程序 2014微信开发者大会顺利结束 TOP10优秀微信开发商名单公布 【最佳实践】通过DevOps确保可靠和有效的信息安全 2048 Hello World:跨平台快速应用开发Python框架Kivy Forrester:关于私有云的10个事实 2014年8月操作系统份额:Win 8.x大涨,Linux继续下跌 0代码、不编程—交互式网页设计工具VXPLO 揭秘Instagram Hyperlapse背后的技术 【CTO俱乐部在线教育研讨会】用互联网技术深入创新教育产品 降低门槛!Hybrid应用开发框架LigerMobile 下一代IT革命:微服务器和雾计算 使用Mongo Connector和Elasticsearch实现模糊匹配 时隔8个月,物联网联盟AllSeen如今怎样? 《近匠》简网:开发零门槛 快速建原生App MDCC免费展位申请超预期 大会内容初曝光 在服务器与交换机定制之后,谷歌着手量子计算机CPU设计 电信天翼开放平台鲍占斌:优质能力 分成比例高 艾格拉斯副总裁王晓波:手游定价如何设计 Xcode 6 Beta 7发布:语法定、内库改,Swift何时完善? 干货来袭:由22个联邦机构分享的6482个数据集 Phablet出货量今年将超移动PC,明年再超平板 如何提高Web服务端并发效率的异步编程技术? 改改改!让应用通过审核出人头地的10个方法 正益无线CEO王国春:AppCan如何获得50万开发者青睐 在收购Xtreme Labs之后,Pivotal推出PaaS移动服务 .NET开发者必备的11款免费工具 .NET开发不可错过的25款高效工具 Docker最佳实践!尽在2014 Container技术大会 pflua:用Lua编写的高性能网络包过滤工具箱 掌上明珠张磊:如何设计手游付费体系 云游科技何千军:游戏开发和后端逻辑经验 为什么我在JSP中能得到TEXT文本中的数据,却得不到在SELECT中的数据呢? 求救!为什么我的ACESS数据库文件会莫名其妙的达到25M,我还没输任何数据呢?而生成MDE后只有500K? 我要一个功能强大的弹出日历 Viva La Costa Rica! 我再也不看Chinese Team的比赛了! 如何做jar包呢?还有如何做bak呢?大家救救我吧。 《inside the c++ object model》问题 这句是什么意思??? 问一个Win2000Server域用户客户端登陆问题。 小问题:在线等待:) 如何删除一个ini文件中的关键项目?急 求救!为什么我的ACESS数据库文件会莫名其妙的达到25M,我还没输任何数据呢?而生成MDE后只有500K? 求教关于c++builder的图象预处理的源代码。50分!!还有金钱相送! access的问题 郁闷!!关于数据窗口一个奇怪的问题!! 如何实现断点续传 寻求《软驱监控程序》!!!!!!!!!!!!!!价格面议 用imp恢复数据库,要做什么准备呀? 刚才给分失败,重新散分! 关于SQLserver数据库和MDB数据库的句语问题!!! IE数据保密大全,如何禁止以下功能?菜单,工具栏,收藏夹,鼠标右键,PRINTSCREEN键,键盘快捷键 帮忙:DCOM 无法使用任何配置的协议与计算机 慨n 通信? 查询问题 请教bean中填写方法问题,高手帮忙啊!!!!! 昨天回家遇到打劫,被暴打一顿 本人有一个数据窗口对象中的一个字段,其为DDDW型的,可是在它的选项页中却怎么也不能显示出我想设置的名字显示出来,却总是显示保存在表中 在线求助,当场送分。 用MASM编译DOS程序经常有问题啊!? asp.net问题 有关DateDiff的问题。。。SOS 请问用什么软件制作chm帮助文档? 数据库中记录条数在增加,但字段却是空的呀??? 高分求:如何确定TreeView的SelectedItem为空? ******* 怎样调试硬中断程序? 存储过程中的一个语法问题 servlet中forward到jsp页面的显示问题 SOS:请问一个页面在不同分辨率下适应性的问题! 我在做数据库链接时,出现了编译错误,实在看不错在哪里(在线等待) rpm的升级过程中的问题,请大家关注 有关gethostbyname的问题 关于数据库系统信息的ini文件 请问一个简单语法问题 股票界面的画法问题 自从和男友去看了《我的野蛮女友》后,我又变野蛮了~~ 一个小问题 在aspx文件中取出aspx.vb文件中的数据怎么做到? 救命!! 为什么我的数据窗口中的编辑框不能写入数据(问题解决,立即给分) 如何立即更新水晶报表中的数据库?关于水晶报表高分(100) 关于makefile问题(在线等) ASP编程中的问题,很急…… 如何写手机短信程序? “聚乙二醇--药物溶解后……形成核晶非常困难,……故溶质可形成微晶”当聚乙二醇--药物溶解后迅速冷却药物形成核晶非常困难,由于低温时介质粘 度很大形成固化时间很短,故溶质可形成 利用二氧化碳的气体就能区分氢氧化钠,氢氧化钙,和稀盐酸三种溶液吗 酸性氧化物的性质rt分条列出来 纳米晶软化水的效果怎么样? 利用二氧化碳如何区别NaOH、氢氧化钙和稀盐酸 酸性氧化物的性质怎样体现. 说的是宗法制宗法制! 一氧化碳是否为酸性氧化物 大家帮一下忙啊,初中酸性氧化物性质的概念,谢拉,要是初中的啊! 关于酸性氧化物的疑问酸性氧化物的定义为酸性氧化物是一类能与水作用生成酸或与碱作用生成盐和水或与碱性氧化物反应生成盐的氧化物(且生成物只能有一种盐和水,不可以有任何其它物 在运动场上常见到的一些现象中,不能用惯性知识解释的是短跑运动员跑到终点后不能立即停下来跳远运动员要助跑一段距离后才起跳投掷铅球是,铅球离开人的手以后继续向前运动跳高运动 一氧化碳是不是酸性氧化物 酸性氧化物和碱性氧化物酸性氧化物或者碱性氧化物与其它物质反应通式 食盐食醋纯碱能否检验鸡蛋壳溶于酸 一氧化碳是酸性氧化物吗,为什么? 解释惯性的步骤(4个) 宗法制为什么有如下优点历史书上写:::宗法制有利于凝聚宗族,防止内部纷争,强化王权,把“国”和“家”密切的结合在一起.为什么? 一氧化碳为什么不是酸性氧化物?我知道它不是酸性氧化物.想知道深层的原因. 食盐晶体这类的物质属不属于电解质? 误食水银死亡是什么症状?多少水银能致人 一氧化碳为什么不是酸性氧化物?若它不是那它是属于什么性质的物质我们那个二逼化学老师撒都讲不好,就说了一氧化碳不是酸性氧化物,也没说为什么不是.而且像CO2、No都符合酸性氧化物的 惯性解释系列的习题应该有一个固定的解答模式吧.例如:用力击打一摞棋子的最下面一个,情况会怎么样?为什么?如以上问题,怎样解答能得全分?其实我主要是想问对于这类问题的完美答案,请 加热a克氯酸钾和b克氧化铁的混合物,反应完全后,得到c克氯化钾,则生成氧气的质量为?A.(a+b-c)克. B.(a-c)克. C.(a+c)克. D(b-c)克. 酸性氧化物的特征 一些不溶盐是电解质吗 还有 氢氧化钾固体是电解质吗?如碳酸钙固体等 银子遇水银变黑怎样清洗 酸性氧化物的特点是什么?还有碱性的有什么特点请告诉我常见的酸性氧化物和碱性氧化物 什么是干扰素?干扰素的作用是什么? 银手镯遇汞变黑怎么办?我在甩温度计时不小心将温度计磕到了银手镯上,现在手镯遇汞变黑(乌)了,请问怎样才能使它恢复光泽? 酸性氧化物的特征和组成部分是什么? 求氢氧化钠和二氧化碳反应方程式(有过量么?) 铝和氧化铁反应的实验探究:为什么要在混合物上面加少量氯化钾 秦朝灭亡了之后秦始皇的女儿姬妾都到哪里去了? 干扰素的作用 请问彩金戒指遇水银变黑了怎么办?戒指3600元买的,温度计打坏了,水银沾到了戒指上,戒指黑了,以前买戒指的地方也搬家找不到了,别的珠宝店都不敢收,我该怎么办?结婚时买的,扔了太可惜了, 西周宗法制的主要内容和实质简略一点概括重点 过量的氢氧化钠和二氧化碳反应方程 关于电热水袋换水后无法加热的问题我是新买的热水袋,用了两个星期,今天换水,然后就不加热了,水里加了些盐就又能加热了.我是想问,是为什么才会爆?是因为热水袋在加热的时候会有气体产 秦始皇后的秦朝多久灭亡的? 请问:干扰素a-2a和干扰素a-2b的作用?干扰素a-2a,干扰素a-2b各自的药理作用和各自的适应症. 固体水银有毒吗?误食后会死吗? 西周宗法制的实质是什么呢?(内容简要的) NaOH和少量,过量CO2的反应方程式分别是… 烷烃的所有性质都与甲烷相同注是相同不是相似 秦始皇自即位以后到秦朝灭亡,秦朝出了几个上将军. 下列现象中不能用惯性解释的是1、骑自行车上坡前往往要加紧蹬几下加大速度2、人从形式的车上跳下来容易摔倒两个从中选一下 需要一些理由说明 水银遇空气发生什么反应 西周实行宗法制,根本上是要?A、保证嫡长子一系的特权B、巩固父系家长在本宗族中的地位C、封邦建国,拱卫王室D、保证王权的稳定 下列现象不能用惯性解释的是》A.骑自行车上坡前,加紧蹬几下B.跑步的人绊到石头容易摔倒 13 2010年3月召开的第十一届全国人大三次会议,表决通过了关于修改《中华人民共和国选举法》的决定.这表明全国人民代表大会具有 A监督权 B任免权 C立法权 D决定权 各位高手,选哪一 请你们帮我选选,并说明原因可以吗?..西周实行宗法制的根本目的是( )选项1:广建诸侯藩国选项2:区分血缘亲疏选项3:保证法律执行选项4:巩固分封秩序 下列现象中,能用惯性知识解释的是()多选A.拍打衣服,灰尘脱离衣服B.人从行驶的车上跳下来,容易摔倒C.短跑运动员到达终点后不能立即停下来D.用力将物体跑出去,物体最终要落到地面上我 少量二氧化碳通入氢氧化钠溶液中和 过量二氧化碳通入氢氧化钠溶液中的离子反应方程式? 西周宗法制的实质.宗法制对中国封建社会有什么影响 魔兽体内的“晶核”是干什么用的?有什么作用?写玄幻小说用. 十一届全国人民代表大会第一次会议十一届全国人大三次会议是什么意思?有什么区别? 酸性氧化物有哪些性质?酸性氧化物能与哪些物质反应,表现什么性质? 纳米的作用是什么我想知道的是作用 桥烷烃有什么特殊的性质吗? 酸性氧化物 性质
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘