Tweet
11/03/07: Added executable demo (compiled EXE, 42 KB) at http://www.talsystems.com/demo/favmenu.exe
Code:
' FILE: Favmenu.bas
' PURPOSE:
' Demo of method to add a "Favorite Files" menu to an application and provide an "organize favorites" dialog
' to add, delete or re-order the files thereon.
' The demo is set up to handle an application where "some file" is "open" to the application... the
' Favorites menu allows for either "add current file to favorites" or a complete "organize favorites"
' activity... add, delete or re-order.
' Typically the list of favorites will be held in some data file or INI file, and loaded on WM_CREATE
' and saved on WM_DESTROY. In this demo the "Current favorites" are loaded from DATA statements
' and not saved anywhere.
' -----------------------------------------------------
' AUTHOR: Michael Mattias Racine WI 10/25/07
' COPYRIGHT: Placed in Public Domain by author 10/25/07
' ==[ COMPILING and EXECUTING ]=======================
' COMPILER USED: PB/WIN 7.03, but should work with any PB/Win compiler
' First compile run the program make_favorg_cur.bas to create the file favorg.cur
' Then compile the resource script favmenu.rc into favmenu.pbr
' Then compile and run this program
' You can skip creation of the favorg.cur file if you want. In this case, delete the CURSOR resource
' from the favorg.rc file and change the "LoadIMage" call where found to one of the commented
' "LoadCursor" statements and a 'stock' cursor will be used on the "organize" screen when
' dragging files.
' ===[ HISTORY]========================================================================================
' 10.22.07 Started
' 10.24.07 Added hot keys = letter of alphabet A-Z, <NO FAVORITES DEFINED> when true. Clean up.
' 10.24.07 1.0.0 Versioned for release (will make it a PB demo). (**** nice of me, ain't it?)
' Cursor file is size 766 bytes. Is there anyway to key that into resource? Sure. But
' it looks like a pain in the ***. Need to use Create Cursor, but I don't know how to
' do that. I'll kust make the cursor file available for download from my web site.
' Or, I suppose I could "binbas" it....
#COMPILE EXE
#DEBUG ERROR ON
#REGISTER NONE
#DIM ALL
#TOOLS OFF
'=====[Windows API Header Files] ============================
' If you don't need all of the functionality supported by these APIs
' (and who does?), you can selectively turn off various modules by putting
' the following constants in your program BEFORE you #include "win32api.inc":
' %NOGDI = 1 ' no GDI (Graphics Device Interface) functions
' %NOMMIDS = 1 ' no Multimedia ID definitions
%NOMMIDS = 1
#INCLUDE "WIN32API.INC" ' 9 May 2002
'==[End Windows API Header Files]============================
#IF NOT %DEF (%INVALID_HANDLE_VALUE_LONG)
%INVALID_HANDLE_VALUE_LONG = -1&
#ENDIF
#RESOURCE "FAVMENU.PBR"
' ---------------------------------------------------------
' THREAD-SAFE STDOUT FOR PB/WIN
' Usage: STDOUT (dynamic string, or BYCOPY szString)
' Was used only for debugging. Commented out for posting
' ---------------------------------------------------------
'#INCLUDE "STDOUT_PBWIN.INC"
' common controls has DragListInfo
' COMMON CONTROLD INCLUDES
' THESE EQUATES MUST BE COMMENTED OUT - NOT SET TO ZERO - TO ACTIVATE THE FUNCTIONS
' AND MACROS IN COMMCTRL.INC FOR THE PARTICULAR CONTROL
%NOANIMATE = 1 ' Animate control.
%NOBUTTON = 1 ' BUtton_xxx macros
%NOCOMBO = 1 ' combobox_xxx macros
%NOCOMBOEX = 1 ' comboboxEX_xx
%NODATETIMEPICK = 1
' %NODRAGLIST = 1 ' APIs to make a listbox source and sink drag&drop actions.
%NOEDIT = 1 ' Edit_xxx macros
%NOFLATSBAPIS = 1 ' flat scrollbar equates and macros
%NOHEADER = 1 ' Header bar control.
%NOHOTKEY = 1 ' HotKey control.
%NOIMAGELIST = 1 ' ImageList apis.
%NOIPADDRESS = 1
%NOLIST = 1 ' listbox_xxx macros
%NOLISTVIEW = 1 ' ListView control.
%NOMENUHELP = 1 ' APIs to help manage menus, especially with a status bar.
%NOMONTHCAL = 1
%NOMUI = 1
%NONATIVEFONTCTL = 1
%NOPAGESCROLLER = 1
%NOPROGRESS = 1 ' Progress gas gauge.
%NOREBAR = 1
%NOSTATUSBAR = 1 ' Status bar control.
%NOTABCONTROL = 1
%NOTOOLBAR = 1 ' Customizable bitmap-button toolbar control.
%NOTOOLTIPS = 1
%NOTRACKBAR = 1 ' Customizable column-width tracking control.
%NOTREEVIEW = 1 ' TreeView control.
%NOUPDOWN = 1 ' Up and Down arrow increment/decrement control.
#INCLUDE "COMMCTRL.INC" ' 8 MAY 2002 from PB
' FOR 8x NOTE TO SELF> COMMCTRL.INC modified to include ...
' FUNCTION LBItemFromPt2, uses pointApi BYVAL instead of separate x, y of point
' requires PB/WIN 8x+ (which allows BYVAL 'udt')
' I will have to go to lbItemFromPt to make this work in 7x. DONE.
' COMDLG32 required for definition of OpenFileName structure used in CallOpenSaveFileName
#IF NOT %DEF(%COMDLG32_INC)
#INCLUDE "COMDLG32.INC"
#ENDIF
%SUB_FAVORITE_FILE = 1
%SUB_GETOPENSAVE_MAX = 1
FUNCTION CallOpenSaveFileName (BYVAL hWnd AS LONG, BYVAL WhichSub AS LONG, OPTIONAL ReadOnly AS LONG) AS STRING
' hWnd is the owner of the dialog
' WhichSub is %SUB_INPUT_FILE or %SUB_OUTPUT_FILE
' SUB_REPORT_FILE gets an output file with prompt for overwrite.
' Returns: Fully qualifed filename if user selects, or null string if he does not.
' Retains: Last directory searched for each file type
STATIC AnyTrip AS LONG
STATIC BeenHere() AS LONG ' have we been here before for this purpose?
STATIC OFN() AS OpenFileName ' save the last choice
STATIC Filter() AS STRING, Title() AS ASCIIZ * 64, SearchDir () AS ASCIIZ * %MAX_PATH
STATIC FileTitle () AS ASCIIZ * %MAX_PATH ' the name of the file
LOCAL Stat AS LONG, wFullName AS ASCIIZ * %MAX_PATH
LOCAL pFullName AS ASCIIZ PTR * %MAX_PATH
LOCAL EC AS LONG
LOCAL W AS STRING
LOCAL AllowReadOnly AS LONG
IF ISFALSE (AnyTrip) THEN
AnyTrip = %TRUE
REDIM OFN(%SUB_GETOPENSAVE_MAX), BeenHere(%SUB_GETOPENSAVE_MAX)
REDIM Title (%SUB_GETOPENSAVE_MAX),_
SearchDir (%SUB_GETOPENSAVE_MAX),_
FileTitle (%SUB_GETOPENSAVE_MAX),_
Filter (%SUB_GETOPENSAVE_MAX)
END IF
IF ISFALSE (BeenHere (WhichSub)) THEN
BeenHere (WhichSub) = %TRUE
OFN(WhichSub).lStructSize = CDWD(SIZEOF(OFN(WhichSub)))
OFN(WhichSub).hInstance = %NULL
OFN(WhichSub).lpstrCustomFilter = %NULL
OFN(WhichSub).nMaxCustFilter = %NULL
OFN(WhichSub).nFilterIndex = 1
OFN(WhichSub).lCustData = 0
OFN(WhichSub).lpfnHook = 0
OFN(WhichSub).lpTemplateName = %NULL
OFN(WhichSub).lpstrDefExt = %NULL
OFN(WhichSub).nFileOffset = 0
OFN(WhichSub).nFileExtension = %NULL
SearchDir (WhichSub) = CURDIR$
SELECT CASE WhichSub
' ---------------------------------------------------------
' Select file to add to favorites list. It need not exist
CASE %SUB_FAVORITE_FILE
Title (WhichSub) = "Select file or enter filename to be added to Favorites"
OFN(WhichSub).LpStrTitle = VARPTR (Title(WhichSub))
Filter(WhichSub) = "All Files (*.*)" & $NUL & "*.*" & $NUL & $NUL
OFN(WhichSub).lpStrFilter = STRPTR (Filter(WhichSub))
' default flags:
OFN(WhichSub).Flags = %OFN_HIDEREADONLY OR %OFN_LONGNAMES OR %OFN_PATHMUSTEXIST OR %OFN_NOCHANGEDIR
OFN(WhichSub).LpStrDefExt = %NULL
OFN(WhichSub).nFilterIndex = 0&
END SELECT
END IF ' if this is the first trip for this %SUB_xxxx
' else ' we've done this browse before; restore the start directory to where we last were...
OFN(WhichSub).LpStrInitialDir = VARPTR(SearchDir(WhichSub))
' set the common stuff which does not vary...
FileTitle(WhichSub) = "" ' no default filenamme
OFN(WhichSub).LpStrFile = VARPTR (FileTitle(WhichSub))
OFN(WhichSub).nMaxFile = SIZEOF (FileTitle(WhichSub))
' since the owner window may vary for the same sub across calls...
OFN(WhichSub).hWndOwner = hWnd
' Show the read-only box if input and AllowReadonly is true
IF WhichSub = %SUB_FAVORITE_FILE THEN ' read only is meaningless for favorite file
IF VARPTR(ReadOnly) THEN
IF ISTRUE (ReadOnly) THEN
AllowReadOnly = %TRUE
END IF
END IF
END IF
' set the read only flag based on the value for this call
IF ISTRUE AllowReadOnly THEN '
ofn(WhichSub).flags = OFN(WhichSub).flags AND NOT (%OFN_HIDEREADONLY)
ELSE
ofn(WhichSub).Flags = ofn(WhichSub).flags OR %OFN_HIDEREADONLY
END IF
' SET HOOK PROCEDURE IF DESIRED
IF WhichSub = %SUB_FAVORITE_FILE THEN
' the read only variable is my "user" value I am going to use for my callback
' NOTE: OFN_ENABLESIZING required when you use a hook proc or the dialog is not resizeable.
OFn(WhichSub).flags = OFN(WhichSub).Flags OR %OFN_EXPLORER ' no hook proc for testing
'OFN(whichSub).lpfnhook = CODEPTR (OFNExplorerHookProc)
'OFN(whichSub).lCustData = 12345&
END IF
' call the API
SELECT CASE WhichSub
CASE %SUB_FAVORITE_FILE
Stat = GetOpenFileName (OFN(WhichSub))
END SELECT
IF ISTRUE (Stat) THEN
W = SPACE$(OFN(WhichSub).NMaxFile)
pFullName = OFN(WhichSUb).LpStrFile
W = @pFullName
W = TRIM$(W, ANY CHR$(0, &h20))
' set the initial search dir for the next time thru to equal this one
SearchDir (WhichSub) = LEFT$(W, INSTR(-1, W, "\"))
' null out the file name for next call to provide consistent search behavior across 9x, NT and 2K:
FileTitle(WhichSub) = ""
'
IF ISTRUE AllowReadOnly THEN ' parameter passed, non-zero, input file
ReadOnly = (Ofn(whichSub).Flags AND %OFN_READONLY) = %OFN_READONLY ' set to whatever was chosen
' MSGBOX "Readonly=" & STR$( (Ofn(whichSub).Flags AND %OFN_READONLY) = %OFN_READONLY)
END IF
FUNCTION = W
ELSE
LOCAL eCD AS DWORD
eCD = CommDlgExtendedError
IF ECD <> 0 THEN
MSGBOX "GetOpen/SaveFileName failed on error#" & STR$(eCD), %MB_APPLMODAL OR %MB_ICONINFORMATION, "Yikes!!!
END IF
FUNCTION = ""
END IF
END FUNCTION
MACRO bva(anything) = BYVAL VARPTR(anything)
MACRO bvaz(asciizString) = BYVAL IIF(lstrlen(asciizString), VARPTR(AsCIIZString), %NULL)
' compare long with DWORD
MACRO EQ32(a,b) = (BITS???(a)=BITS???(b))
' ============================================================================
' POSITIONAL DECLARES
' ============================================================================
' return delimited string of 'favorite files' from the current favorites menu
DECLARE FUNCTION GetFavoritesStringFromFavoritesMenu (BYVAL hWnd AS LONG) AS STRING
' return delimited string of 'favorite files' from the INI file
DECLARE FUNCTION GetFavoritesStringFromIniFile (BYVAL hWnd AS LONG) AS STRING
' add a favorites string to the favorites menu (deletes prior favorites from the menu first)
DECLARE FUNCTION AddFavoritesStringToFavoritesMenu (BYVAL hWnd AS LONG, S AS STRING) AS LONG
' given idCMD, get the filename from the Favorites menu
DECLARE FUNCTION GetFavoritesFileNameByCmd (BYVAL hWnd AS LONG, BYVAL idCMD AS LONG) AS STRING
'
%ID_EXIT =501 ' from File menu
%ID_ADD_THIS_FILE =502 ' from Favorites menu means add current file
%ID_ORGANIZE =505 ' on favorites menu
%ID_MENU = 100& ' menu for the main window
%MENUINDEX_FAVORITES = 1& ' 0-based index of favorites menu on main menu
%FAVORITES_BASE = 1000& ' files are numbered 1001-1051 (in edi pal will almost certainly be different)
%FAVORITES_NOFAVORITES = %FAVORITES_BASE
%FAVORITES_MAX = 50& ' max number of favorites allowed. There really is no limit
' except that code only looks for idcmd in this range.
' FAVORITES_BASE is used for <NO FAVORITES DEFINED> when needed
' ===============================================
' ORGANIZE FAVORITES DIALOG CONSTANTS
' ===============================================
$PROP_OLDWNDPROC = "OldWndProc"
$FAVORG_CURSOR_NAME = "CUR1" ' CURSOR resource name
$FAVORG_DLG_NAME = "FAVORG" ' DIALOG resource name
$FAVORG_PATH_DELIMITER = "|"
' controls on the organize favorites screen.
%ID_FAV_ADD_FILE = 104
%ID_FAV_DELETE_FILE = 105
%ID_FAV_RETURN = 106
%ID_FAV_FILES = 102
%ID_FAV_LB_FILES = 101 ' // one of these is just 1,2,3,4 etc and scrolls in synch
%ID_FAV_LB_ORDER = 103 ' // with the list
%ID_CANCEL = 107 ' FIXME HERE GET RID OF THIS ..easy to confuse w/ IDCANCEL
%ID_FAV_CANCEL = %ID_CANCEL ' ... and use this symbol instead
' ==================================
' PROGRAM ENTRY POINT
' ==================================
FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
BYVAL lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL Msg AS tagMsg
LOCAL wcex AS WndClassEx
LOCAL szAppName AS ASCIIZ * 80, szMenuName AS ASCIIZ * 80
LOCAL hWnd AS LONG, E AS LONG
' register a windowClass
szAppName = "FavMenu"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR( WndProc )
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hIcon = %NULL
wcex.hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW )
'wcex.hCursor = %NULL ' so we can change it without Windows resetting it
wcex.hbrBackground = GetStockObject( %WHITE_BRUSH )
wcex.lpszMenuName = %ID_MENU
wcex.lpszClassName = VARPTR( szAppName )
wcex.hIconSm = %NULL
RegisterClassEx wcex
LOCAL WindowStyle AS LONG, WindowExStyle AS LONG
WindowStyle = %WS_OVERLAPPEDWINDOW OR %WS_VISIBLE OR %WS_THICKFRAME
WindowExStyle = %WS_EX_CLIENTEDGE
' Create the main application window using the registered class
hWnd = CreateWindowEx( WindowExStyle, _ ' any extended style bits
szAppName, _ ' window class name
szAppName, _ ' window caption
WindowStyle , _ ' window style
%CW_USEDEFAULT, _ ' initial x position
%CW_USEDEFAULT, _ ' initial y position
%CW_USEDEFAULT, _ ' initial x size
%CW_USEDEFAULT, _ ' initial y size
%NULL, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
' Display the window on the screen
IF ISFALSE hWnd THEN
MSGBOX "COuld not create Main Window"
EXIT FUNCTION
END IF
ShowWindow hWnd, iCmdShow
UpdateWindow hWnd
' Main message loop:
' Messages sent to HELLOWIN while it has the focus are received by
' GetMessage(). This loop translates each message and dispatches it
' to the appropriate handler. When PostQuitMessage() is called, the
' loop terminates which ends the application.
WHILE GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
WEND
FUNCTION = msg.wParam
END FUNCTION ' WinMain
'------------------------------------------------------------------------------
' MAIN WINDOW PROCESSOR
'------------------------------------------------------------------------------
' WndProc is the message handler for the main application window.
FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
LOCAL hDC AS LONG
LOCAL LpPaint AS PaintStruct
LOCAL tRect AS Rect
STATIC szMsg AS ASCIIZ * 40
LOCAL W AS STRING, wString AS STRING, S AS STRING, szCurDir AS ASCIIZ * %MAX_PATH
LOCAL I AS LONG, Z AS LONG
LOCAL nMEnuItem AS LONG, MenuFlags AS LONG
LOCAL szText AS ASCIIZ * %MAX_PATH
LOCAL szFIleName AS ASCIIZ * %MAX_PATH, _
szCreateDate AS ASCIIZ * 36, _
szCreateTime AS ASCIIZ * 36, _
szModifyDate AS ASCIIZ * 36, _
szModifyTime AS ASCIIZ * 36, _
szFileSize AS ASCIIZ * 20
' The SELECT CASE is used to catch only those messages which the message
' handler needs to process. All other messages are passed through the
' tests to the default handler.
SELECT CASE AS LONG wMsg
CASE %WM_CREATE
' ---------------------------------------------------
' LOAD FILES FROM INI AND ADD TO THE FAVORITES MENU
' ---------------------------------------------------
S = GetFavoritesStringFromIniFile (hWnd)
'MSGBOX "Size of Favorites String is " & FORMAT$(LEN(S))
CALL AddFavoritesStringToFavoritesMenu (hWnd, S)
' DefWindowProc will return NULL (continues window creation)
CASE %WM_PAINT
hDC = BeginPaint(hWnd, LpPaint)
EndPaint hWnd, LpPaint
FUNCTION = 0
EXIT FUNCTION
CASE %WM_DESTROY ' when window is destroyed, we want program to end
PostQuitMessage 0
FUNCTION = 0
EXIT FUNCTION
CASE %WM_INITMENUPOPUP
' Enable or disable the menu items depending if the file CURRENTLY exists or not!!!
' we use a separate function for that.
IF LOWRD(lParam) = %MENUINDEX_FAVORITES THEN
CALL EnableFavoritesMenu (hWnd)
END IF
CASE %WM_COMMAND ' from the menu on main window
SELECT CASE AS LONG LOWRD(wPAram)
CASE %FAVORITES_BASE + 1 TO %FAVORITES_BASE + %FAVORITES_MAX
' Show the selected file name.
s = GetFavoritesFileNameByCmd (hWnd, LOWRD(wParam))
MSGBOX USING$( "No ## '&' ", LOWRD(wParam) - %FAVORITES_BASE, s),,"SELECTED FILE # and NAME"
CASE %ID_EXIT
PostMessage hWnd, %WM_CLOSE, %NULL, %NULL
CASE %ID_ADD_THIS_FILE
' currently on the favorites menu.
' For demo, INPUTBOX a text string to test/demo. In Real Life this would come
' from the application which would know which file is the current file.
szText = INPUTBOX$ ("Enter a file name to add (need not exist or even be a valid name) ")
CALL AddFIleToFavoritesMenu (hWnd, szText)
CASE %ID_ORGANIZE
' Call the "Organize Favorites" dialog
' pass a STRING PTR of delimited string of all items on the menu
wString = GetFavoritesStringFromFavoritesMEnu (hWnd)
I = DialogBoxParam (GetModuleHandle (BYVAL %NULL), "FAVORG", hWnd, CODEPTR(FavOrgDialogProc), BYVAL VARPTR (wString))
' true = user hit OK and wString contains delimited list of all files left
' in the favorites list
' false = user hit cancel
' if true, rebuild the Favorites menu with the new contents in order
IF ISTRUE I THEN
CALL AddFavoritesStringToFavoritesMenu (hWnd, wString)
END IF
END SELECT
END SELECT ' of message
FUNCTION = DefWindowProc (Hwnd, wMsg, wparam, lparam)
END FUNCTION 'WndProc
' ---------------------------------------------------------------
' ADD A DELIMITED FAVORITES STRING TO THE FAVORITES MENU
' ---------------------------------------------------------------
FUNCTION AddFavoritesStringToFavoritesMenu (BYVAL hWnd AS LONG, S AS STRING) AS LONG
LOCAL hMenu AS LONG, menuFlags AS LONG
LOCAL i AS LONG, iret AS LONG
LOCAL nMenuItem AS LONG
LOCAL sMenuString() AS STRING
LOCAL szText AS ASCIIZ * %MAX_PATH, LE AS LONG
LOCAL idCMD AS LONG
' get Handle to the favorites menu
hMenu = GetMenu (hWnd)
hMenu = GetSubMenu (hMenu, %MENUINDEX_FAVORITES)
IF ISFALSE hMenu THEN
MSGBOX "Could not get menu handle!!
EXIT FUNCTION
END IF
nMenuItem = GetMenuItemCount (hMenu) ' all items on favorites menu
' -----------------------------------------------------------------------------
' DELETE THE 'NOFAVORITES' AND ALL CURRENT FAVORITES ENTRIES FROM FAVORITES MENU
' This is somewhat inefficient, we could stop as soon as menu item for a given
' IDCmd is not found since they are assigned sequentially anyway.
' ---------------------------------------------------------------------------
MenuFlags = %MF_BYCOMMAND
FOR i = %FAVORITES_BASE TO %FAVORITES_BASE + %FAVORITES_MAX + 1&
DeleteMenu hMenu, I,MenuFlags
NEXT
' If no favorites in string put up a "<No favorites defined> item and exit.
IF LEN (S) = 0 THEN
szText = "<No Favorites Defined>"
idcmd = %FAVORITES_NOFAVORITES
MenuFlags = %MF_STRING OR %MF_GRAYED
AppendMenu hMenu, MenuFlags, IdCmd, bvaz(szText)
EXIT FUNCTION
END IF
' Still her? Parse the string into an array:
nMenuItem = PARSECOUNT(s, $FAVORG_PATH_DELIMITER)
'MSGBOX USING$("found # files in favorites string", nMenuItem),,"Add favoritesStringToFavoritesMenu"
REDIM sMenuString (nMenuItem-1)
PARSE S, sMenuString(), $FAVORG_PATH_DELIMITER
idCmd = %FAVORITES_BASE
FOR I = LBOUND (sMenuString,1) TO UBOUND (sMenuString,1)
INCR idCmd
' we always add enabled. On WM_INITMENUPOPUP we will test for
' CURRENT existence and reset all file names at that time
MenuFlags = %MF_ENABLED
' add an alpha hot key if this is file 1 thru 26
IF I <= 25 THEN ' the 26 letters of the alphabet
szText = "&" & CHR$ (65+I) & $SPC & sMenuString(I)
ELSE
szText = sMenuString(I)
END IF
MenuFlags = MenuFlags OR %MF_BYCOMMAND OR %MF_STRING
iret = AppendMenu (hMenu, MenuFlags, idCmd, szText)
LE = GetLastError
'STDOUT USING$("appendmenu for index # & returns #", I, sMenuString(I), iRet)
NEXT
END FUNCTION ' add favoritesStringToFavoritesMenu
' return delimited string of 'favorite files' from the current favorites menu
FUNCTION GetFavoritesStringFromFavoritesMenu (BYVAL hWnd AS LONG) AS STRING
LOCAL hMenu AS LONG, menuFlags AS LONG
LOCAL i AS LONG
LOCAL nChar AS LONG, nMenuItem AS LONG
LOCAL szText AS ASCIIZ * %MAX_PATH
LOCAL idCMD AS LONG, S AS STRING, w AS STRING
' find all items on the menu (by index). if the ID is in the range of favorites, add to string and delimit.
' if in first 26 files, strip the leading alpha hotkey
' get Handle to the favorites menu
hMenu = GetMenu (hWnd)
hMenu = GetSubMenu (hMenu, %MENUINDEX_FAVORITES)
IF ISFALSE hMenu THEN
MSGBOX "Could not get menu handle!!
EXIT FUNCTION
END IF
nMenuItem = GetMenuItemCount (hMenu) ' all items on favorites menu. Not used here, but it's cheap.
' (was used for debugging).
S = ""
FOR iDCmd = %FAVORITES_BASE + 1 TO %FAVORITES_BASE + %FAVORITES_MAX + 1
nChar = GetMenuString(hMenu, idCMD, szText, SIZEOF(szText), %MF_BYCOMMAND)
IF nChar THEN
' remove hotkey text if string is one of the first 26 entries (start at favorites_base + 1)
IF idCmd < (%FAVORITES_BASE + 27) THEN
w = REMAIN$ (szText, $SPC) ' all characters following first space
ELSE
w = szText
END IF
s = S & w & $FAVORG_PATH_DELIMITER
END IF
NEXT
s = RTRIM$(s, $FAVORG_PATH_DELIMITER)
FUNCTION = S
END FUNCTION
' return delimited string of 'favorite files' from the INI file
FUNCTION GetFavoritesStringFromIniFile (BYVAL hWnd AS LONG) AS STRING
' just for testing I am going to load up some stuff here from DATA statements
LOCAL s AS STRING, n AS LONG, I AS LONG
' To test when no favorites found in INI file. Tests OK.
' FUNCTION = ""
' EXIT FUNCTION
n = DATACOUNT
FOR I = 1 TO n
s = s & READ$(i) & "|"
NEXT
S = RTRIM$(s, "|")
FUNCTION = S
EXIT FUNCTION
DATA "D:\TestData\EDI_Data\2-835.W12"
DATA "D:\TestData\EDI_Data\HIPAA Compliant\DeIdentified\20040726_scrambled.dat"
DATA "D:\TestData\EDI_Data\HIPAA Compliant\DeIdentified\20040726_scrambled_futute_date#2.dAT"
DATA "D:\TestData\EDI_Data\HIPAA Compliant\DeIdentified\835_bell_plb_medb_20061101.txt"
DATA "D:\TestData\EDI_Data\HIPAA Compliant\DeIdentified\bell_050315COM_7287.ansi"
DATA "D:\TestData\EDI_Data\HIPAA Compliant\DeIdentified\Bell_remit_Scambled_late_filing_fee.txt"
DATA "D:\TestData\EDI_Data\HIPAA Compliant\DeIdentified\ciena_did_RA 020705.txt"
DATA "D:\TestData\EDI_Data\HIPAA Compliant\DeIdentified\Does_not_exist_#1.edi"
DATA "D:\TestData\EDI_Data\HIPAA Compliant\DeIdentified\Does_not_exist_#2.edi"
DATA "D:\TestData\EDI_Data\HIPAA Compliant\DeIdentified\Does_not_Exist_#3.edi"
DATA "File 10"
DATA "File 11"
DATA "File 12"
DATA "File 13"
DATA "File 14"
DATA "File 15"
DATA "File 16"
DATA "File 17"
DATA "File 18"
DATA "File 19"
DATA "File 20"
DATA "File 21"
DATA "File 22"
DATA "File 23"
DATA "File 24"
END FUNCTION
' ---------------------------------------------------------------------------
' Given the idcmd (LOWRD(wparam) in WM_COMMAND) ("CBCTL" in DDT-speak),
' get the name of the file for that entry from Favorites Menu.
' ---------------------------------------------------------------------------
FUNCTION GetFavoritesFileNameByCmd (BYVAL hWnd AS LONG, BYVAL idCMD AS LONG) AS STRING
LOCAL hMenu AS LONG, menuFlags AS LONG
LOCAL i AS LONG
LOCAL nChar AS LONG, nMenuItem AS LONG
LOCAL szText AS ASCIIZ * %MAX_PATH
LOCAL S AS STRING
' get Handle to the favorites menu
hMenu = GetMenu (hWnd)
hMenu = GetSubMenu (hMenu, %MENUINDEX_FAVORITES)
IF ISFALSE hMenu THEN
MSGBOX "Could not get menu handle!!
EXIT FUNCTION
END IF
' Get the text of this menu item
nChar = GetMenuString(hMenu, idCMD, szText, SIZEOF(szText), %MF_BYCOMMAND)
' if this is one of the first 26 files, remove the leading hotkey characters
IF nChar THEN
IF idCmd < %FAVORITES_BASE + 27 THEN
szText = REMAIN$(szText, $SPC) ' all characters after the first space.
END IF
ELSE
szText = ""
MSGBOX "No Text! Should not Happen! Programmer ERROR!"
END IF
FUNCTION = szText
END FUNCTION
' -----------------------------------------------------
' ADD A SINGLE FILE TO THE END OF THE FAVORITES MENU
' -----------------------------------------------------
FUNCTION AddFileToFavoritesMenu (BYVAL hWnd AS LONG, szFile AS ASCIIZ) AS LONG
LOCAL hMenu AS LONG, menuFlags AS LONG
LOCAL i AS LONG
LOCAL nChar AS LONG, nMenuItem AS LONG
LOCAL szText AS ASCIIZ * %MAX_PATH
LOCAL idCMD AS LONG, S AS STRING
' get Handle to the favorites menu
hMenu = GetMenu (hWnd)
hMenu = GetSubMenu (hMenu, %MENUINDEX_FAVORITES)
IF ISFALSE hMenu THEN
MSGBOX "Could not get menu handle!!
EXIT FUNCTION
END IF
' find the last item on the menu... it will be the current 'last favorite' **IF THERE ARE ANY FAVORITES ***
nMenuItem = GetMenuItemCount (hMenu) ' all items on favorites menu
' I need the idCMD for this item: is it in the FAVORITES range?
idCMD = GetMenuItemId (hMenu, nMenuItem-1) ' subtract one to get 0-based index
IF (idCMD > %FAVORITES_BASE) AND (idcmd <= (%fAVORITES_BASE + %FAVORITES_MAX + 1)) THEN
' the last item on the menu is a filename
INCR idCMD ' use next value
ELSE
' there are no favorites yet, but there is a "<No Favorites> entry which must be deleted..
DeleteMenu hMenu, %FAVORITES_NOFAVORITES, %MF_BYCOMMAND
' and this will be the first favorite
idcmd = %FAVORITES_BASE + 1 ' make it the FIRST favorite
END IF
'is this file currently available?
IF DIR$(szFile) > "" THEN
MenuFlags = %MF_ENABLED OR %MF_STRING
ELSE
MenuFlags = %MF_GRAYED OR %MF_STRING
END IF
' if this is one of the first 26 entries in Favorites, add a Hotkey = letter of alphabet
IF idCmd < %FAVORITES_BASE + 27 THEN
szFile = "&" & CHR$(idCmd - %FAVORITES_BASE + 64) & $SPC & szFile
END IF
AppendMenu hMenu, Menuflags, IdCmd, bvaz(szFile)
' refresh the menu
DrawMenuBar hWnd
END FUNCTION ' add file to favorites menu
' for all Favorites Menu items representing a file, enable the menu item
' if the file is found and disable if it isn't.
FUNCTION EnableFavoritesMenu (BYVAL hWnd AS LONG) AS LONG
LOCAL hMenu AS LONG, menuFlags AS LONG
LOCAL i AS LONG
LOCAL nChar AS LONG, nMenuItem AS LONG
LOCAL szText AS ASCIIZ * %MAX_PATH
LOCAL idCMD AS LONG, S AS STRING
' get Handle to the favorites menu
hMenu = GetMenu (hWnd)
hMenu = GetSubMenu (hMenu, %MENUINDEX_FAVORITES)
IF ISFALSE hMenu THEN
MSGBOX "Could not get menu handle!!
EXIT FUNCTION
END IF
nMenuItem = GetMenuItemCount (hMenu) ' all items on favorites menu
' Get the text of each menu item representing a file (idcmd in valid range)
FOR iDCmd = %FAVORITES_BASE + 1 TO %FAVORITES_BASE + %FAVORITES_MAX + 1
nChar = GetMenuString(hMenu, idCMD, szText, SIZEOF(szText), %MF_BYCOMMAND)
IF nChar THEN
'STDOUT USING$ ("Checking availabilty of flle '&' ===> '&'", szText, DIR$(szText))
' remove the hotkey text from front of string if one of first 26 entries
IF iDCMD < %FAVORITES_BASE + 27 THEN
szText = REMAIN$ (szText, $SPC) ' all chars after first space
END IF
IF DIR$(szText) > "" THEN ' the file exists
MenuFlags = %MF_ENABLED OR %MF_BYCOMMAND
ELSE
MenuFlags = %MF_GRAYED OR %MF_BYCOMMAND
END IF
EnableMenuItem hMenu, idCmd, MenuFlags
END IF
NEXT
END FUNCTION
' ===========================================================================
' DIALOG PROCEDURE FOR EDIT PATHS
'
' lparam = STRING PTR to string containing delimited list of file names.
' This is updated and returned to the caller
' it is stored in the GWL_USER of the Dialog while this dialog lived
' String contains the files in the list delimited by $PATH_DELIMITER
' DOES NOT: Enable/Disable the 'delete' if there is nothing left in the
' list. I'll fix that up for production. For this demo I will leave that
' as a 'user exercise.'
' ===========================================================================
FUNCTION FavOrgDialogProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
' These three are preserved across messages (during dragging operations)
STATIC DragListMsg AS LONG
STATIC iDragRow AS LONG
STATIC hCursor AS LONG
LOCAL pAZ AS ASCIIZ PTR , s AS STRING, ps AS STRING PTR
LOCAL szTExt AS ASCIIZ * %MAX_PATH
LOCAL pDLI AS DRAGLISTINFO PTR
LOCAL hCtrl AS LONG, hL2 AS LONG
LOCAL nFolder AS LONG, nRow AS LONG,iRow AS LONG, iSel AS LONG, iSelRow AS LONG
LOCAL szProp AS ASCIIZ * 32, dwOldProc AS DWORD
SELECT CASE wMSG
CASE %WM_INITDIALOG
' save the passed STRING PTR in window long. Note that this might come in null
' meaning there was no text in the box at the time
SetWindowLong hWnd, %DWL_USER, lparam
' make the files listbox a drag list box
hCtrl = GetDlgItem (hWnd, %ID_FAV_LB_FILES)
MakeDragList hCtrl
' register the DRAGLISTMSG so we know what the hell it is doing
szText = $DRAGLISTMSGSTRING
DragListMsg = RegisterWindowMessage (szText)
' load the Listbox with the filenames, in order
' hctrl is handle to the drag list box for folders
hL2 = getDlgItem(hWnd,%ID_FAV_LB_ORDER)
pS = lparam
IF ISTRUE LEN(@ps) THEN
s = @ps
nFolder = PARSECOUNT (s, $FAVORG_PATH_DELIMITER)
FOR iRow = 1 TO nFolder
szText = PARSE$(s,$FAVORG_PATH_DELIMITER, iRow)
SendMessage hCtrl , %LB_ADDSTRING, %NULL, Bvaz(szText)
szText = FORMAT$(iRow)
SendMessage hL2, %LB_ADDSTRING,%NULL, bvaz(szText)
NEXT
END IF
iDragRow = -1& ' meaning "none"
' i need to subclass the listbox so I can get WM_VSCROLL and scroll
' the 'order' listbox along with the 'files' listbox.
hCtrl = GetDlgItem (hWnd, %ID_FAV_LB_FILES)
dwOldProc = SetWindowLong (hCtrl, %GWL_WNDPROC, CODEPTR (SubClassProc_LbFiles))
SzProp = $PROP_OLDWNDPROC
SetProp hCtrl, szProp, dwOldProc
FUNCTION = %TRUE ' accept default focus
CASE %WM_DESTROY
' remove subclassing on the drag list box before exiting
hCtrl = GetDlgITem(hwnd, %ID_FAV_LB_FILES)
szProp = $PROP_OLDWNDPROC
dwOldProc = GetProp (hCtrl, szProp)
SetwindowLong hCtrl, %GWL_WNDPROC, dwOldProc
IF ISTRUE hCursor THEN
DestroyCursor hCursor
hCursor = %NULL
END IF
CASE DragListMsg ' wparam = Ctrl ID lparam = DraglistInfo PTR
pDLI = lparam
'MSGBOX "Got DragList message"
' members: uNotification, hWnd long, ptCursor POINTAPIs
' Note, everytime we click on here we get a dl_dropped on the mouse release
SELECT CASE AS LONG @pDLI.uNotification
CASE %DL_BEGINDRAG
' if the cursor is on an item, save the index and
' allow the system to drag it by returingin TRUE
' I need to set the cursor, too.
' 10.24.07 need to draw the insert here or it does not appear until you drag
' looks much better this way.
iDragRow = LbItemfromPt (getDlgItem(hWnd,wParam), @pDLI.ptCursor.x, @pDLI.ptCursor.y, %TRUE)
IF iDragRow >-1& THEN
SetWindowLong hWnd, %DWL_MSGRESULT, %TRUE
IF ISFALSE hCursor THEN
' GET CURSOR TO USE FROM RESOURCE OR BY USING A STOCK CURSOR
'hCursor = LoadCursor (%NULL, BYVAL %IDC_SIZEWE) ' not too bad
'hCursor = LoadCursor (%NULL, BYVAL %IDC_CROSS) ' too hard to see
'hCursor = LoadCursor (%NULL, BYVAL %IDC_SIZEALL) ' not too bad at all << GOOD FOR DEMO
hCursor = LoadImage (GetModuleHandle(BYVAL %NULL),$FAVORG_CURSOR_NAME,_
%IMAGE_CURSOR,32,8, %LR_LOADTRANSPARENT)
' 32, 8 are the dimensions I want for the cursor.
END IF
SetCursor hCursor
DrawInsert hWnd, GetDlgItem(hWnd, wParam), iDragRow
FUNCTION = %TRUE
EXIT FUNCTION
END IF
CASE %DL_DRAGGING
' Force the control to scroll if out of item list range.
iRow = lbItemfromPt (GetDlgItem(hWnd, wparam), @pDLI.ptCursor.x,@pDLI.ptCursor.y, %TRUE)
' I'm not sure if I am supposed to put this on irow or on iDragRow
IF iRow <> -1& THEN
DrawInsert hWnd, GetDlgItem(hWnd, wParam), iRow
'above appears to be one row too high. Let's try iRow -1
'DrawInsert hWnd, GetDlgItem(hWnd, wParam), iRow-1
' no, that puts the insert thingee off the screen when you get to the top.
' I'll just leave it.
END IF
CASE %DL_DROPPED
'MSGBOX "DL_Dropped iDragRow" & FORMAT$ (iDragRow)
IF iDragRow <> -1& THEN
iRow = lbItemfromPt (GetDlgItem(hWnd, wparam), @pDLI.ptCursor.x,@pDLI.ptCursor.y, %TRUE)
'MSGBOX USING$("Dropped on row # with dragindex #", iRow, iDragRow)
IF iRow > -1& THEN
IF iRow <> iDragRow THEN
' insert row "iDragRow" to here and remove it from where it was
' hmm, if the new index is less than the old index
hCtrl = GetDlgItem (hWnd, wparam) ' handle to control
SendMessage hCtrl, %LB_GETTEXT, iDragRow, VARPTR(szText) ' source item
SendMessage hCtrl, %LB_DELETESTRING, iDragRow, %NULL ' delete original
IF iRow < iDragRow THEN ' target point is above prior item so it hasn't moved
iSel = iRow
ELSE ' target was below, so has been 'moved up' by the delete
iSel = iRow -1
END IF
SendMessage hCtrl, %LB_INSERTSTRING, iSel, bvaz(szText)
' reset
iDragRow = -1&
SetCursor LoadCursor(BYVAL %NULL, BYVAL %IDC_ARROW)
END IF
END IF
END IF
CASE %DL_CANCELDRAG
'reset
iDragRow = -1&
SetCursor LoadCursor(BYVAL %NULL, BYVAL %IDC_ARROW)
END SELECT
CASE %WM_COMMAND
SELECT CASE LOWRD(wParam)
CASE %ID_FAV_RETURN
' collect all the strings,in order and return in passed memory handle
'MSGBOX "Collect remaining strings from list box and return TRUE "
hCtrl = getDlgItem(hWnd, %ID_FAV_LB_FILES)
pS = getWindowLong (hwnd, %DWL_USER) ' remember, this might be null
nRow = SendMessage (hCtrl, %LB_GETCOUNT, %NULL, %NULL)
IF ps THEN
@ps = ""
END IF ' ELSE something is REALLY screwed up.
FOR iRow = 0 TO nRow -1
SendMessage hCtrl, %LB_GETTEXT, iRow, VARPTR(szText)
@ps = @ps & szText & $FAVORG_PATH_DELIMITER
NEXT
@pS = RTRIM$(@ps,$FAVORG_PATH_DELIMITER)
' 10/23/07 I might want to change this to return true only if OK and a change was made.
EndDialog hWnd, %TRUE ' tell caller user hit "OK"
CASE %ID_CANCEL
EndDialog Hwnd, %FALSE ' false ==> user exited with cancel (make no changes).
CASE %ID_FAV_ADD_FILE
CALL CallOpenSaveFileName (hWnd, %SUB_FAVORITE_FILE) TO S ' get a file name
IF LEN(S) THEN
' if this file already in the list don't allow it
iSel = SendDlgITemMessage (hwnd, %ID_FAV_LB_FILES, %LB_FINDSTRINGEXACT, -1&,BYVAL STRPTR(s))
' above: -1& means 'search entire listbox'
IF iSel = -1& THEN ' not found %LB_ERR might be DWORD so use literal with LONG casting
' add the new file to the Listbox and add an order entry
sztext = s
iRow = SendDlgItemMessage(hWnd, %ID_FAV_LB_FILES, %LB_ADDSTRING, %NULL, bvAZ(szText))
szText = FORMAT$(iRow +1)
SendDlgItemMessage hWnd, %ID_FAV_LB_ORDER, %LB_ADDSTRING, %NULL, bvaz(szText)
ELSE ' file already in the list
MSGBOX USING$( "File '&'", S) & $CRLF & " is already in favorites list" , _
%MB_TASKMODAL OR %MB_ICONHAND, "Duplicate Error"
END IF
END IF
CASE %ID_FAV_DELETE_FILE
iSelRow = SendDlgItemMessage (hWnd, %ID_FAV_LB_FILES, %LB_GETCURSEL, %NULL, %NULL)
IF IselRow > -1& THEN ' something IS selected...
' MSGBOX USING$ ("Delete row #" , iSel+1)
' 10.23.07 I never did the the delete! (I did now!)
SendDlgItemMessage hWnd, %ID_FAV_LB_FILES, %LB_DELETESTRING, iSelRow, %NULL
' and delete row lAST from ID_LB_ORDER
nRow = SendDlgItemMessage hWnd, %ID_FAV_LB_ORDER, %LB_GETCOUNT, %NULL, %NULL
iSel = nRow -1
SendDlgItemMessage hWnd, %ID_FAV_LB_ORDER, %LB_DELETESTRING, iSel, %NULL
' and reselect something so controls still work
' if it was the last row which was deleted, select current last row,
' otherwise select the new "iSelRow"
nRow = SendDlgItemMessage(hWnd, %ID_FAV_LB_FILES, %LB_GETCOUNT, %NULL, %NULL) ' new count
IF nRow THEN ' if any rows are left in files box
IF iSelRow +1 > nRow THEN
' we deleted the last row, so make the current last row the select
iSel = nRow-1 ' create zero-based
ELSE
iSel = iSelRow
END IF
SendDlgItemMessage hWnd, %ID_FAV_LB_FILES, %LB_SETCURSEL, iSel, %NULL
END IF
END IF ' if anything was selected in the first place
END SELECT ' of control under WM_COMMAND
END SELECT ' msg
FUNCTION = %FALSE
END FUNCTION
' -------------------------------------------------------
' SUBCLASS PROCEDURE USED TO SCROLL THE "ORDER"
' LISTBOX IN SYNCH WITH THE "FILES" LISTBOX
' -------------------------------------------------------
FUNCTION SubClassProc_lbFiles (BYVAL hWnd AS LONG, BYVAL uMSG AS LONG, BYVAL wParam AS LONG, BYVAL lPARam AS LONG) AS LONG
' on WM_VSCROLL, get the top index of the box and set the "order" list box to that index, too
LOCAL hParent AS LONG, iTopIndex AS LONG, szProp AS ASCIIZ * 16
IF uMSG = %WM_VSCROLL THEN
iTopIndex = SendMessage(hWnd, %LB_GETTOPINDEX, %NULL, %NULL)
IF iTopIndex <> -1& THEN
SendDlgItemMessage GetParent(Hwnd), %ID_FAV_LB_ORDER, %LB_SETTOPINDEX, iTopIndex, %NULL
END IF
END IF
' and always call the default proc
szProp = $PROP_OLDWNDPROC
FUNCTION = CallWindowProc (GetProp(Hwnd,szProp), hWnd, uMSG, wParam, lparam)
END FUNCTION
'// END OF FILE
Comment