怎么样让文件保存的时候可以保存多种类型?

jiangqiaohua 2008-03-31 10:44:30
Dim tSave As cOpenSaveDlg
Set tSave = New cOpenSaveDlg
tSave.Filter = "*.bmp|*.bmp|*.jpg|*.jpg|*.gif|*.gif|*.png|*.png"
tSave.Flags = OFN_OVERWRITEPROMPT


'MsgBox tSave.Filter
tStr = m_Web.Document.Title
Call FormatFileName(tStr)
tSave.FileName = tStr & ".bmp"

tHWin = m_info.GetMainWindowObj.hwnd
If tSave.ShowSave(tHWin) Then
vFile = tSave.FileName
'If LCase$(Right$(vFile, 4)) <> ".bmp" Then
' vFile = vFile & ".bmp"
'End If
Else
Exit Sub
End If
'MsgBox tSave.FileTitle
vFile = tSave.FileName
End If

现在问题是

选择了
bmp类型就保存bmp类型 只能写死
tStr & ".bmp"


怎么样根据用户保存的类型来保存相应的类型?
...全文
240 10 打赏 收藏 举报
写回复
10 条回复
切换为时间正序
请发表友善的回复…
发表回复
jiangqiaohua 2008-04-10
  • 打赏
  • 举报
回复
FilterIndex 只能设置 初始的 Filter


并不选择用户 选择 扩展名
后返回的 Filter


这个问题还未解决 但思路也是向 VBAHZ 这样


谁可以帮我解决?

(注意 我不要真实的保存多种格式 只要能获取扩展名就可以了)
VBAHZ 2008-04-09
  • 打赏
  • 举报
回复
FilterIndex 属性返回 你选择的是第几个Filter

然后,你根据相应索引号,自己加上扩展名
jiangqiaohua 2008-04-07
  • 打赏
  • 举报
回复
还没解决
ZOU_SEAFARER 2008-03-31
  • 打赏
  • 举报
回复
没有搞明白你的意思!
Filter = "图片格式(*.bmp;*.jpg;*.gif;*.pcx;*.ico) ¦*.bmp;*.jpg;*.gif;*.png;*.ico ¦位图格式(*.bmp) ¦*.bmp ¦GIF格式(*.gif) ¦*.gif ¦JPEG格式(*.jpg) ¦*.jpg ¦PNG格式(*.png) ¦*.png"
是支持能在对话筐中看到多种类型的文件
如果你选择的图片格式(*.bmp;*.jpg;*.gif;*.pcx;*.ico) ,程序是不知道你到底选了哪个
因为里面列举的类型都包括,不存在唯一性
东方之珠 2008-03-31
  • 打赏
  • 举报
回复
VB6.0用GDI+保存图片为JPG、TIFF、PNG、GIF、BMP等格式 http://blog.csdn.net/laviewpbt/archive/2006/05/26/756547.aspx
jiangqiaohua 2008-03-31
  • 打赏
  • 举报
回复
我试了把

tSave.FileName = tStr & ".bmp"
改成
tSave.FileName = tStr & ".jpg"

是可以的
不管他保存后图片的格式是否是 JPG 至少他的扩展名已经是JPG 了

现在关键是怎么样捕捉
tSave.Filter = "*.bmp ¦*.bmp ¦*.jpg ¦*.jpg ¦*.gif ¦*.gif ¦*.png ¦*.png"
选文件类型的事件

然后把 扩展名赋值给


tSave.FileName = tStr & ".jpg"
我这个 cOpenSaveDlg 是字定义的类


CommonDialog1

差不多
cbm6666 2008-03-31
  • 打赏
  • 举报
回复
上面你要保存则把 .ShowOpen 改为 .ShowSave即可, Filter格式open与save两者是一样的.

VB保存图片就只能使用 .bmp, 除了你用Imgedit控件或其它API来处理图片,上面的一堆Filter才有意义.

cbm6666 2008-03-31
  • 打赏
  • 举报
回复
'添加 Command1 CommonDialog1

Dim fname$
Private Sub Command1_Click()
On Error GoTo errhandler
With CommonDialog1
.CancelError = True
.InitDir = App.Path '予设存档路径
.Filter = "图片格式(*.bmp;*.jpg;*.gif;*.pcx;*.ico)|*.bmp;*.jpg;*.gif;*.png;*.ico|位图格式(*.bmp)|*.bmp|GIF格式(*.gif)|*.gif|JPEG格式(*.jpg)|*.jpg|PNG格式(*.png)|*.png"
.ShowOpen
End With
fname = CommonDialog1.FileName
MsgBox fname
errhandler:
If Err > 0 Then Exit Sub '32755
End Sub

Sandrer 2008-03-31
  • 打赏
  • 举报
回复
本来就是这样滴~
jiangqiaohua 2008-03-31
  • 打赏
  • 举报
回复
If Len(vFile) = 0 Then
Dim tSave As cOpenSaveDlg
Set tSave = New cOpenSaveDlg
tSave.Filter = "*.bmp|*.bmp"
tSave.Flags = OFN_OVERWRITEPROMPT

tStr = m_Web.Document.Title
Call FormatFileName(tStr)
tSave.FileName = tStr & ".bmp"

tHWin = m_info.GetMainWindowObj.hwnd
If tSave.ShowSave(tHWin) Then
vFile = tSave.FileName
If LCase$(Right$(vFile, 4)) <> ".bmp" Then
vFile = vFile & ".bmp"
End If
Else
Exit Sub
End If
End If

控件原码
'========= 打开保存文件对话框 =============
'2004-7-8 修正了无法用中文初始化文件名的问题

Option Explicit

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

Public Enum enuDlgFlgs
OFN_ALLOWMULTISELECT = &H200&
OFN_CREATEPROMPT = &H2000&
OFN_DONTADDTORECENT = &H2000000
OFN_ENABLEHOOK = &H20&
OFN_ENABLEINCLUDENOTIFY = &H400000
OFN_ENABLESIZING = &H800000
OFN_ENABLETEMPLATE = &H40&
OFN_ENABLETEMPLATEHANDLE = &H80&
OFN_EX_NOPLACESBAR = &H1&
OFN_EXPLORER = &H80000
OFN_EXTENSIONDIFFERENT = &H400&
OFN_FILEMUSTEXIST = &H1000&
OFN_FORCESHOWHIDDEN = &H10000000
OFN_HIDEREADONLY = &H4&
OFN_LONGNAMES = &H200000
OFN_NOCHANGEDIR = &H8&
OFN_NODEREFERENCELINKS = &H100000
OFN_NOLONGNAMES = &H40000
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NOVALIDATE = &H100&
OFN_OVERWRITEPROMPT = &H2&
OFN_PATHMUSTEXIST = &H800&
OFN_READONLY = &H1&
OFN_SHAREAWARE = &H4000&
OFN_SHAREFALLTHROUGH = 2&
OFN_SHARENOWARN = 1&
OFN_SHAREWARN = 0&
OFN_SHOWHELP = &H10&
OFN_USEMONIKERS = &H1000000
End Enum




Public Filter As String
Public Flags As enuDlgFlgs
Public InitDir As String
Public DialogTitle As String
Public FileTitle As String
Public FileName As String



Public Function ShowSave(hOwner As Long) As Boolean
Dim ofn As OPENFILENAME
Dim rtn As Long
With ofn
.lStructSize = Len(ofn)
.hwndOwner = hOwner
.hInstance = App.hInstance
.lpstrFilter = Replace(Filter, "|", Chr(0))

.lpstrFile = Left(FileName & Chr(0) & Space(254), 254)

.nMaxFile = 255

.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255

.lpstrInitialDir = InitDir
'If InitDir <> "" Then .lpstrInitialDir = InitDir Else .lpstrInitialDir = "" 'vbNullString ' App.Path

If DialogTitle <> "" Then
.lpstrTitle = DialogTitle
Else
.lpstrTitle = "保存"
End If

.Flags = Flags
End With

rtn = GetSaveFileName(ofn)
If rtn >= 1 Then
ShowSave = True
FileName = Trim$(ofn.lpstrFile)
FileName = Left$(FileName, Len(FileName) - 1)
FileTitle = Trim$(ofn.lpstrFileTitle)
If FileTitle <> "" Then FileTitle = Left$(FileTitle, Len(FileTitle) - 1)
InitDir = ofn.lpstrInitialDir
Else
ShowSave = False
End If

DialogTitle = ""

End Function

Public Function ShowOpen(hOwner As Long) As Boolean

Dim ofn As OPENFILENAME
Dim rtn As Long
With ofn
.lStructSize = Len(ofn)
.hwndOwner = hOwner
.hInstance = App.hInstance
.lpstrFilter = Replace(Filter, "|", Chr(0))

.lpstrFile = Left(FileName & Chr(0) & Space(254), 254)

.nMaxFile = 255

.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255

.lpstrInitialDir = InitDir
'If InitDir <> "" Then .lpstrInitialDir = InitDir Else .lpstrInitialDir = "" 'vbNullString ' App.Path
If DialogTitle <> "" Then
.lpstrTitle = DialogTitle
Else
.lpstrTitle = "打开"
End If

.Flags = Flags
End With

rtn = GetOpenFileName(ofn)
If rtn >= 1 Then
ShowOpen = True
FileName = Trim$(ofn.lpstrFile)
FileName = Left$(FileName, Len(FileName) - 1)
FileTitle = Trim$(ofn.lpstrFileTitle)
If FileTitle <> "" Then FileTitle = Left$(FileTitle, Len(FileTitle) - 1)
InitDir = ofn.lpstrInitialDir
Else
ShowOpen = False
End If
'Debug.Print ofn.nFileOffset
DialogTitle = ""

End Function

'Private Sub Class_Initialize()
'Flags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER
'End Sub
'
相关推荐
发帖
API

1482

社区成员

VB API
社区管理员
  • API
加入社区
帖子事件
创建了帖子
2008-03-31 10:44
社区公告
暂无公告