is there somehing wrong with this code?
ok on internet i found replacement for CommonDialog (save and open only)
Ok open works perfect but save don't freaking work at all.
Ok here is the CommonDialog.bas:
option Explicit
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 Const OFN_READONLY = &H1
public Const OFN_OVERWRITEPROMPT = &H2
public Const OFN_HIDEREADONLY = &H4
public Const OFN_NOCHANGEDIR = &H8
public Const OFN_SHOWHELP = &H10
public Const OFN_ENABLEHOOK = &H20
public Const OFN_ENABLETEMPLATE = &H40
public Const OFN_ENABLETEMPLATEHANDLE = &H80
public Const OFN_NOVALIDATE = &H100
public Const OFN_ALLOWMULTISELECT = &H200
public Const OFN_EXTENSIONDIFFERENT = &H400
public Const OFN_PATHMUSTEXIST = &H800
public Const OFN_FILEMUSTEXIST = &H1000
public Const OFN_CREATEPROMPT = &H2000
public Const OFN_SHAREAWARE = &H4000
public Const OFN_NOREADONLYRETURN = &H8000
public Const OFN_NOTESTFILECREATE = &H10000
public Const OFN_NONETWORKBUTTON = &H20000
public Const OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modules
public Const OFN_EXPLORER = &H80000 ' new look commdlg
public Const OFN_NODEREFERENCELINKS = &H100000
public Const OFN_LONGNAMES = &H200000 ' force long names for 3.x modules
public Const OFN_SHAREFALLTHROUGH = 2
public Const OFN_SHARENOWARN = 1
public Const OFN_SHAREWARN = 0
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
Function SaveDialog(Form1 as Form, Filter as string, Title as string, InitDir as string) as string
Dim ofn as OPENFILENAME
Dim A as Long
ofn.lStructSize = len(ofn)
ofn.hwndOwner = Form1.hWnd
ofn.hInstance = App.hInstance
If Right$(Filter, 1) <> "|" then Filter = Filter + "|"
for A = 1 to len(Filter)
If mid$(Filter, A, 1) = "|" then mid$(Filter, A, 1) = Chr$(0)
next
ofn.lpstrFilter = Filter
ofn.lpstrFile = Space$(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space$(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = InitDir
ofn.lpstrTitle = Title
ofn.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_CREATEPROMPT
A = GetSaveFileName(ofn)
If (A) then
SaveDialog = Trim$(ofn.lpstrFile)
else
SaveDialog = ""
End If
End Function
Function OpenDialog(Form1 as Form, Filter as string, Title as string, InitDir as string) as string
Dim ofn as OPENFILENAME
Dim A as Long
ofn.lStructSize = len(ofn)
ofn.hwndOwner = Form1.hWnd
ofn.hInstance = App.hInstance
If Right$(Filter, 1) <> "|" then Filter = Filter + "|"
for A = 1 to len(Filter)
If mid$(Filter, A, 1) = "|" then mid$(Filter, A, 1) = Chr$(0)
next
ofn.lpstrFilter = Filter
ofn.lpstrFile = Space$(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space$(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = InitDir
ofn.lpstrTitle = Title
ofn.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
A = GetOpenFileName(ofn)
If (A) then
OpenDialog = Trim$(ofn.lpstrFile)
else
OpenDialog = ""
End If
End Function
OK now i need to save picture from my program.
Ok i use this lines to save a picture into a file from picture1.picture
Dim mm as string
on error GoTo a:
mm = SaveDialog(me, "Gif (*.gif)|*.gif|Bitmap (*.bmp)|*.bmp|All Files (*.*)|*.*", "Save File as...", "C:\windows\desktop")
SavePicture Picture1.Picture, mm
a:
well i don't know why it don't work, it does saves the file, but it don't make any extenction (like ff.gif or ff.bmp), unless i rename the file itself to ff.bmp when saving....bmp works but if i rename to ff.gif....file saves as ff.gif but when i open it it says that error occured while trying to open gif...PLEASE HELP.....I don't want COMDLG32.OCX back.........!!!!
Re: is there somehing wrong with this code?
1) after call to Function SaveDialog in:
Dim mm as string
on error GoTo a:
mm = SaveDialog(me, "Gif (*.gif)|*.gif|Bitmap (*.bmp)|*.bmp|All Files (*.*)|*.*", "Save File as...", "C:\windows\desktop")
SavePicture Picture1.Picture, mm
a:
What is 'mm' set to ?
Does it include any/proprer extension ?
2) Check the documentation for LoadPicture/SavePicture/.Picture-property. They support .bmp and others, but looks like.gif is NOT supported.
Kevin.
Re: is there somehing wrong with this code?
1) after call to Function SaveDialog in:
Dim mm as string
on error GoTo a:
mm = SaveDialog(me, "Gif (*.gif)|*.gif|Bitmap (*.bmp)|*.bmp|All Files (*.*)|*.*", "Save File as...", "C:\windows\desktop")
SavePicture Picture1.Picture, mm
a:
What is 'mm' set to ?
Does it include any/proprer extension ?
2) Check the documentation for LoadPicture/SavePicture/.Picture-property. They support .bmp and others, but looks like.gif is NOT supported.
Kevin.
Re: is there somehing wrong with this code?
You can't save pictures as gif or jpg with VB, at least not with the build in functions.
Crazy D @ Work :-)