Подскажите, кто знает, как написать на апи CommonDialog окно Save В СТИЛЕ XP? Через манифесты не получается т.к. моя программа использует посторонние ocx и вылетает ошибка. У меня есть код окна Открыть в хр-стиле, а как из него переделать в Сохранить не знаю. Подскажите что нужно переделать в этом коде чтобы сделать окно Сохранить:
'в форме
Private Sub Form_Load()
Dim strFilename As String
On Error Resume Next
strFilename = (ShowOpenDlg(Me, , "All Files|*.*", , "Open File"))
End Sub
'в модуле
Public Const VER_PLATFORM_WIN32_NT As Integer = 2
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Declare Function GetFileNameFromBrowseW Lib "Shell32" Alias "#63" (ByVal hwndOwner As Long, _
ByVal lpstrFile As Long, _
ByVal nMaxFile As Long, _
ByVal lpstrInitialDir As Long, _
ByVal lpstrDefExt As Long, _
ByVal lpstrFilter As Long, _
ByVal lpstrTitle As Long) As Long
Public Declare Function GetFileNameFromBrowseA Lib "Shell32" Alias "#63" (ByVal hwndOwner As Long, _
ByVal lpstrFile As String, _
ByVal nMaxFile As Long, _
ByVal lpstrInitialDir As String, _
ByVal lpstrDefExt As String, _
ByVal lpstrFilter As String, _
ByVal lpstrTitle As String) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Public Function ShowOpenDlg(ByVal Owner As Form, _
Optional ByVal InitialDir As String, _
Optional ByVal strFilter As String, _
Optional ByVal DefaultExtension As String, _
Optional ByVal DlgTitle As String) As String
Dim sBuf As String
InitialDir = IIf(IsMissing(InitialDir), vbNullString, InitialDir)
strFilter = IIf(IsMissing(strFilter), "Все файлы|*.*", Replace(strFilter, "|", vbNullChar)) & vbNullChar
DefaultExtension = IIf(IsMissing(DefaultExtension), vbNullString, DefaultExtension)
DlgTitle = IIf(IsMissing(DlgTitle), "Заголовок", DlgTitle)
sBuf = Space$(256)
If IsWinNT Then
Call GetFileNameFromBrowseW(Owner.hWnd, StrPtr(sBuf), Len(sBuf), StrPtr(InitialDir), StrPtr(DefaultExtension), StrPtr(strFilter), StrPtr(DlgTitle))
Else
Call GetFileNameFromBrowseA(Owner.hWnd, sBuf, Len(sBuf), InitialDir, DefaultExtension, strFilter, DlgTitle)
End If
ShowOpenDlg = Trim$(sBuf)
End Function
Private Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
End Function
Private Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetFileNameFromBrowseW Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As Long, ByVal nMaxFile As Long, ByVal lpstrInitialDir As Long, ByVal lpstrDefExt As Long, ByVal lpstrFilter As Long, ByVal lpstrTitle As Long) As Long
Private Declare Function GetFileNameFromBrowseA Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As String, ByVal nMaxFile As Long, ByVal lpstrInitialDir As String, ByVal lpstrDefExt As String, ByVal lpstrFilter As String, ByVal lpstrTitle As String) As Long
Private Sub Form_Load()
Dim sSave As String
sSave = Space(255)
If IsWinNT Then
GetFileNameFromBrowseW Me.hWnd, StrPtr(sSave), 255, StrPtr("c:\", StrPtr("txt", StrPtr("Текстовые файлы (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "Все типы файлов (*.*)" + Chr$(0) + "*.*" + Chr$(0)), StrPtr("Сохранение файла"
Else
GetFileNameFromBrowseA Me.hWnd, sSave, 255, "c:\", "txt", "Текстовые файлы (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "Все типы файлов (*.*)" + Chr$(0) + "*.*" + Chr$(0), "Сохранение файла"
End If
MsgBox sSave
End Sub
Public Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function