' File Dialog with BMP Preview
' By Brent D. Thorn, 4/2005
' PUBLIC DOMAIN
Call BmpDialog "Select a Bitmap", "", file$
Print file$
End
Sub BmpDialog Title$, InitialDir$, ByRef File$
Global BmpDialog.lpfnHookProc
If BmpDialog.lpfnHookProc = 0 Then
Callback BmpDialog.lpfnHookProc, _
BmpDialog.OFNHookProc( ULong, ULong, ULong, ULong ), ULong
End If
Struct NMHDR, _
hwndFrom As ULong, _
idFrom As ULong, _
code As Long
Struct OPENFILENAME, _
lStructSize As ULong, _
hwndOwner As ULong, _
hInstance As Long, _
lpstrFilter As Ptr, _
lpstrCustomFilter As Ptr, _
nMaxCustFilter As ULong, _
nFilterIndex As ULong, _
lpstrFile As Ptr, _
nMaxFile As ULong, _
lpstrFileTitle As Ptr, _
nMaxFileTitle As ULong, _
lpstrInitialDir As Ptr, _
lpstrTitle As Ptr, _
Flags As ULong, _
nFileOffset As Word, _
nFileExtension As Word, _
lpstrDefExt As Ptr, _
lCustData As Long, _
lpfnHook As ULong, _
lpTemplateName As Ptr, _
pvReserved As ULong, _
dwReserved As ULong, _
FlagsEx As ULong
OPENFILENAME.lStructSize.struct = Len(OPENFILENAME.struct)
OPENFILENAME.hwndOwner.struct = GetActiveWindow()
OPENFILENAME.lpstrFilter.struct = _
"Bitmaps" + Chr$(0) + "*.bmp" + Chr$(0) + _
"All Files" + Chr$(0) + "*.*" + Chr$(0) + _
Chr$(0)
OPENFILENAME.nFilterIndex.struct = 1
OPENFILENAME.lpstrFile.struct = Chr$(0) + Space$(259) + Chr$(0)
OPENFILENAME.nMaxFile.struct = 260
OPENFILENAME.lpstrInitialDir.struct = InitialDir$
OPENFILENAME.lpstrTitle.struct = Title$
OPENFILENAME.Flags.struct = _
_OFN_PATHMUSTEXIST Or _OFN_FILEMUSTEXIST Or _OFN_HIDEREADONLY Or _
_OFN_ENABLEHOOK Or HexDec("80000")'OFN_EXPLORER
OPENFILENAME.lpfnHook.struct = BmpDialog.lpfnHookProc
CallDLL #comdlg32, "GetOpenFileNameA", _
OPENFILENAME As Struct, _
res As Long
If res Then
File$ = Trim$(WinString(OPENFILENAME.lpstrFile.struct))
End If
End Sub
Function BmpDialog.OFNHookProc( hDlg, uMsg, wParam, lParam )
Global BmpDialog.hStatus, BmpDialog.hPreview
PreviewNA$ = "Preview not available"
Select Case uMsg
Case _WM_NOTIFY
NMHDR.struct = lParam
Select Case NMHDR.code.struct
Case -602 'CDN_SELCHANGE
' Send CDM_GETFILEPATH
path$ = SendMessage$(NMHDR.hwndFrom.struct, _WM_USER + 101, 260)
Select Case Lower$(Right$(path$, 4))
Case ".bmp"
On Error GoTo [LoadBmpErrHandler]
LoadBmp "temp", path$
hBmp = HBmp("temp")
res = SendMessageString(BmpDialog.hStatus, _WM_SETTEXT, 0, "Preview")
res = SendMessageLong(BmpDialog.hPreview, _STM_SETIMAGE, _IMAGE_BITMAP, hBmp)
UnloadBmp "temp"
Case Else
[LoadBmpErrHandler]
res = SendMessageString(BmpDialog.hStatus, _WM_SETTEXT, 0, PreviewNA$)
res = SendMessageLong(BmpDialog.hPreview, _STM_SETIMAGE, _IMAGE_BITMAP, _NULL)
End Select
Case -603 'CDN_FOLDERCHANGE
' Send CDM_SETCONTROLTEXT to edt1: Clear filename box.
res = SendMessageString(NMHDR.hwndFrom.struct, _WM_USER + 104, HexDec("0480"), "")
End Select
Case _WM_INITDIALOG
CallDLL #user32, "GetParent", hDlg As ULong, hParent As ULong
Struct localRect, left As Long, top As Long, right As Long, bottom As Long
CallDLL #user32, "GetWindowRect", hParent As ULong, localRect As Struct, r As Long
width = localRect.right.struct - localRect.left.struct + 200
height = localRect.bottom.struct - localRect.top.struct
res = MoveWindow(hParent, Int((DisplayWidth - width) / 2), Int((DisplayHeight - height) / 2), width, height, 1)
CallDLL #user32, "GetWindowLongA", hParent As ULong, _GWL_HINSTANCE As Long, hInstance As Long
CallDLL #gdi32, "GetStockObject", _DEFAULT_GUI_FONT As Long, hFont As Long
hCon = CreateContainer(0, _WS_VISIBLE, _
localRect.right.struct - localRect.left.struct, 0, _
190, localRect.bottom.struct - localRect.top.struct, _
hParent, hInstance, 0)
BmpDialog.hStatus = CreateWindowEx(0, "STATIC", PreviewNA$, _
_WS_CHILD Or _WS_VISIBLE Or _SS_LEFT, _
0, 16, 180, 16, _
hCon, 0, hInstance, 0)
res = SendMessageLong(BmpDialog.hStatus, _WM_SETFONT, hFont, 1)
BmpDialog.hPreview = CreateWindowEx(0, "STATIC", "", _
_WS_CHILD Or _WS_VISIBLE Or _SS_BITMAP, _
0, 32, 200, height - 32, _
hCon, 0, hInstance, 0)
End Select
End Function
Function CreateContainer( ExStyle, Style, X, Y, Width, Height, hParent, hInstance, lParam )
'-- Purpose: Creates a child dialog box for use as a container object
' for controls. Controls must be "adopted" using SetParent.
'-- Returns: Window handle (HWND) of the newly-created container.
'-- Depends: ContainerProc(), HIWORD(), LOWORD(), MulDiv()
Global glpfnContainerProc
' Get dialog base units.
' They're used to convert pixels to dialog units.
CallDLL #user32, "GetDialogBaseUnits", r As ULong
baseX = LOWORD(r)
baseY = HIWORD(r)
' Initialize dialog template struct.
Struct DLGTEMPLATE, _
style As ULong, _
dwExtendedStyle As ULong, _
cdit As Word, _
x As Short, _
y As Short, _
cx As Short, _
cy As Short, _
menus As Word, _ 'pseudo element
class As Word, _ 'pseudo element
title As Word 'pseudo element
DLGTEMPLATE.style.struct = Style Or _WS_CHILDWINDOW Or _DS_CONTROL
DLGTEMPLATE.dwExtendedStyle.struct = ExStyle Or _WS_EX_CONTROLPARENT
DLGTEMPLATE.cdit.struct = 0
DLGTEMPLATE.x.struct = MulDiv(X, 4, baseX)
DLGTEMPLATE.y.struct = MulDiv(Y, 8, baseY)
DLGTEMPLATE.cx.struct = MulDiv(Width, 4, baseX)
DLGTEMPLATE.cy.struct = MulDiv(Height, 8, baseY)
DLGTEMPLATE.menus.struct = 0
DLGTEMPLATE.class.struct = 0
DLGTEMPLATE.title.struct = 0
' Template must be in global memory space.
cbDT = Len(DLGTEMPLATE.struct)
CallDLL #kernel32, "GlobalAlloc", _GMEM_MOVEABLE As ULong, cbDT As ULong, hDT As ULong
CallDLL #kernel32, "GlobalLock", hDT As ULong, pDT As ULong
' Copy struct to global memory.
CallDLL #kernel32, "RtlMoveMemory", pDT As ULong, DLGTEMPLATE As Struct, cbDT As Long, r As void
' Get pointer to ContainerProc().
If glpfnContainerProc = 0 Then
Callback glpfnContainerProc, ContainerProc( ULong, ULong, ULong, ULong ), ULong
End If
' Create the modeless, child dialog box.
CallDLL #user32, "CreateDialogIndirectParamA", _
hInstance As Long, _
pDT As ULong, _
hParent As ULong, _
glpfnContainerProc As ULong, _
lParam As Long, _
hDlg As ULong
' Memory is no longer needed. Let's clean up.
CallDLL #kernel32, "GlobalUnlock", hDT As ULong, r As Long
CallDLL #kernel32, "GlobalFree", hDT As ULong, r As ULong
' Return dialog's window handle.
CreateContainer = hDlg
End Function
Function ContainerProc( hDlg, uMsg, wParam, lParam )
'-- Purpose: Acts as container dialog box's dialog procedure (DLGPROC).
' Forwards messages (e.g. WM_COMMAND and WM_NOTIFY) to the
' container's parent window.
'print "ContainerProc(";hDlg;", ";uMsg;", ";wParam;", ";lParam;")"
Select Case uMsg
Case _WM_COMMAND, _WM_NOTIFY, _WM_DRAWITEM, _WM_MEASUREITEM
CallDLL #user32, "GetParent", hDlg As ULong, hParent As Ulong
CallDLL #user32, "SendMessageA", hParent As ULong, uMsg As ULong, wParam As ULong, lParam As ULong, r As Long
End Select
End Function
Function CreateWindowEx( ExStyle, ClassName$, WindowName$, Style, X, Y, Width, Height, hParent, hMenu, hInstance, lpParam )
CallDLL #user32, "CreateWindowExA", ExStyle As ULong, ClassName$ As Ptr, WindowName$ As Ptr, Style As ULong, X As Long, Y As Long, Width As Long, Height As Long, hParent As ULong, hMenu As Long, hInstance As Long, lpParam As ULong, CreateWindowEx As ULong
End Function
Function GetActiveWindow()
CallDLL #user32, "GetActiveWindow", GetActiveWindow As ULong
End Function
Function HIWORD( dw )
HIWORD = (dw And 4294901760) / 65536
End Function
Function LOWORD( dw )
LOWORD = (dw And 65535)
End Function
Function MoveWindow( hWnd, X, Y, Width, Height, Refresh )
CallDLL #user32, "MoveWindow", hWnd As ULong, X As ULong, Y As ULong, Width As ULong, Height As ULong, Refresh As ULong, MoveWindow As ULong
End Function
Function MulDiv( Number, Numerator, Denominator )
CallDLL #kernel32, "MulDiv", Number As Long, Numerator As Long, Denominator As Long, MulDiv As Long
End Function
Function SendMessage$( hWnd, uMsg, cchLen )
SendMessage$ = Space$(cchLen) + Chr$(0)
CallDLL #user32, "SendMessageA", hWnd As ULong, uMsg As ULong, cchLen As Long, SendMessage$ As Ptr, res As Long
SendMessage$ = Left$(SendMessage$, res - 1)
End Function
Function SendMessageLong( hWnd, uMsg, wParam, lParam )
CallDLL #user32, "SendMessageA", hWnd As ULong, uMsg As ULong, wParam As Long, lParam As Long, SendMessageLong As Long
End Function
Function SendMessageString( hWnd, uMsg, wParam, lParam$ )
CallDLL #user32, "SendMessageA", hWnd As ULong, uMsg As ULong, wParam As ULong, lParam$ As Ptr, SendMessageString As Long
End Function |