'=========================================================================== ' Subject: Menu and Status Bar Date: 06-14-02 ( : ) ' Author: Fred Buffington Code: PBDLL ' Origin: oasys@sbcglobal.net Packet: PBDLL.ABC '=========================================================================== '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ ' Example DDT with menu AND Status bar ' fred c buffington ' Most has been gleaned from searches of the PBForum so most of this ' is thanks to others. The only code that is purely mine is to modify ' the menu text to change and remove ampersands for display purposes. ' PBdll/pbwin code. '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ #Compile Exe '#compile dll #Include "WIN32API.INC" #Include "COMMCTRL.INC" '#RESOURCE "jpostddt.pbr" 'use your own pbr for icon %ID_LISTB1 = 24 %ID_CHART = 401 %ID_EMPLO = 402 %ID_PAYEE = 403 %ID_SYNON = 404 %ID_CUSTO = 405 %ID_CALC = 406 %ID_NOTES = 407 %ID_INSERT = 409 %ID_INSERTH = 410 %ID_RTOGGLE = 411 %ID_STOGGLE = 412 %ID_EXIT = 429 %ID_OPTION1 = 433 %ID_OPTION2 = 434 %ID_HELP = 455 %ID_ABOUT = 456 %ID_DELETE = 457 %ID_PYRLCODE = 459 %ID_AUTOCOMPLETE = 460 %IDC_LISTBOX = 24 %ID_ListBox2 = 601 Global hWnd As Long Global hStatus As Long Global wParam As Long Global pin% Global hDlg As Long Global LLines$() Global ghInst As Long Global hFont& Global hFont2& Global hFont3& Global AutoComplete& Global coid$ Global Rev% Global PRDT$ Global keep_ap$ Global Found% Global xfld& Global new_id& Global old_tamt As Cux 'Declare Statements Declare CallBack Function DlgCallback() '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ ' PBMAIN - load and show a dialog '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ Function PbMain() As Long Local I As Long Local nScreenWidth As Long Local nScreenHeight As Long Dim pth$ Dim LLines$(1) 'set this on initially AutoComplete&=1 '------------------------------------------------------- test$=COMMAND$ If test$<>"" Then pin%=VAL(MID$(test$,1,2)):coid$=MID$(test$,3) Local result As Long xfld&=103 Local hMenu As Long Local hPopup1 As Long Local hPopup2 As Long Local hPopup3 As Long Menu New Bar To hMenu Menu New PopUp To hPopup1 Menu Add String, hPopup1, "&Chart of Accounts", %ID_Chart, %MF_ENABLED Menu Add String, hPopup1, "&Employee File", %ID_Emplo, %MF_ENABLED Menu Add String, hPopup1, "&Payee File", %ID_Payee, %MF_ENABLED Menu Add String, hPopup1, "&Synonym File", %ID_Synon, %MF_ENABLED Menu Add String, hPopup1, "C&ustomer File", %ID_Custo, %MF_ENABLED Menu Add String, hPopup1, "-", 0, 0 Menu Add String, hPopup1, "&Journal Notes", %ID_NOTES, %MF_ENABLED Menu Add String, hPopup1, "-", 0, 0 Menu Add String, hPopup1, "E&xit", %ID_EXIT, %MF_ENABLED Menu Add PopUp, hMenu, "&File", hPopup1, %MF_ENABLED Menu New PopUp To hPopup2 Menu Add String, hPopup2, "&Insert Record", %ID_Insert, %MF_ENABLED Menu Add String, hPopup2, "-", 0, 0 Menu Add String, hPopup2, "Increment Reference On/Off", %ID_RTOGGLE,%MF_ENABLED Menu Add String, hPopup2, "&Reverse Sign of Amount On/Off", %ID_STOGGLE,%MF_ENABLED Menu Add String, hPopup2, "&Auto Complete Description Field Off/On",%ID_AUTOCOMPLETE,%MF_ENABLED Menu Add String, hPopup2, "-", 0, 0 Menu Add String, hPopup2, "&Popup Calculator", %ID_CALC, %MF_ENABLED Menu Add PopUp, hMenu, "&Edit", hPopup2, %MF_ENABLED Menu New PopUp To hPopup3 Menu Add String, hPopup3, "&Contents - Processing", %ID_HELP, %MF_ENABLED Menu Add String, hPopup3, "&How to Delete a Record",%ID_Delete, %MF_ENABLED Menu Add String, hPopup3, "&How to Insert a Record",%ID_InsertH, %MF_ENABLED Menu Add String, hPopup3, "&Payroll Codes", %ID_PYRLCODE,%MF_ENABLED Menu Add String, hPopup3, "-", 0, 0 Menu Add String, hPopup3, "&About", %ID_ABOUT, %MF_ENABLED Menu Add PopUp, hMenu, "&Help", hPopup3, %MF_ENABLED nScreenWidth = GetSystemMetrics(%SM_CXSCREEN ) nScreenHeight = GetSystemMetrics(%SM_CYSCREEN ) '----------------------- 'setup dialog controls '----------------------- Dialog New %NULL, "DDT example with menu and Status bar",,, 431, 300, %WS_SYSMENU To hDlg '%WS_SYSMENU TO hDlg '----------------------------------------------------- 'lines to make a sunken frame rather than using frame '----------------------------------------------------- Control Add Line,hDlg,25,"", 2, 0,420, 1,%SS_BLACKFRAME And %SS_GRAYRECT Control Add Line,hDlg,26,"", 2, 0, 1,259,%SS_BLACKFRAME And %SS_GRAYRECT Control Add Line,hDlg,27,"", 3,258,420, 1,%SS_WHITERECT 'AND %SS_BLACKFRAME 'GRAYFRAME 'WHITERECT 'AND %SS_GRAYFRAME'WHITEFRAME 'BLACKFRAME Control Add Line,hDlg,28,"",423, 1, 1,258,%SS_WHITERECT 'AND %SS_GRAYFRAME'BLACKFRAME '---------------------------------------------------- Control Add Line,hDlg,23,"",10,15,410,1,,%WS_EX_WINDOWEDGE Control Add ListBox,hDlg,%ID_LISTB1,LLines$(),10,27,408,140,%LBS_SORT Or %LBS_USETABSTOPS Or %WS_VSCROLL,%WS_EX_CLIENTEDGE 'STATICEDGE 'WINDOWEDGE '------------------------------------------- 'Get the fixed font values for possible use '------------------------------------------- hFont& = GetStockObject(%SYSTEM_FIXED_FONT) hFont2& = GetStockObject(%ANSI_FIXED_FONT) hFont3& = GetStockObject(%OEM_FIXED_FONT) Control Send hDlg, %ID_LISTB1, %WM_SETFONT, hFont3&, %TRUE 'control # is 24 %ID_LISTB1 Control Add Frame,hDlg,209,"", 10,177,396, 23,,%WS_EX_WINDOWEDGE Menu Attach hMenu, hDlg '------------------------------------------- 'create the status window '------------------------------------------- hStatus = CreateStatusWindow(%WS_CHILD Or %WS_CLIPSIBLINGS Or %WS_DLGFRAME Or %WS_VISIBLE _ Or %SBS_SIZEGRIP,"", hDlg, 200) ' ghInst = GetModuleHandle("whatever.exe") 'put icon info program ' SendMessage hDlg, %WM_SETICON, %ICON_SMALL, LoadIcon(ghInst, "PROGRAM") '--------------------------------------------------------- 'start the dialog diaplaying and call the callback routine '--------------------------------------------------------- Dialog Show Modal hDlg Call DlgCallback To Result 'close all files when exiting Close End Function '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ ' Callback for main dialog '€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ CallBack Function DlgCallback() Local Hinst As Long ', Wparam AS LONG ', ztext AS ASCIIZ * 255 Select Case CbMsg Case %WM_MENUSELECT Local zText As Asciiz * 300, mii As MENUITEMINFO Local zztext As Asciiz * 300 mii.cbSize = SizeOf(mii) mii.fMask = %MIIM_STRING mii.cch = SizeOf(zText) mii.dwTypeData = VarPtr(zText) mii.wID = LoWrd(CBWPARAM) GetMenuItemInfo CbLParam, LoWrd(CBWPARAM), 0&, ByVal VarPtr(mii) xx$=ztext zztext=ztext '-------------------------------------------------------------- 'modify status bar text display for ampersand and special text '-------------------------------------------------------------- If Mid$(xx$,2,2)="Ch" Or Mid$(xx$,2,2)="Em" Or Mid$(xx$,2,2)="Pa" Or Mid$(xx$,2,2)="Sy" Then xxx$="Display "+xx$:xx$=xxx$ End If If InStr(xx$,"ustomer")>0 Then xxx$="Display "+xx$:xx$=xxx$ If Mid$(xx$,2,6)="About" Then xx$="Information about the prohgram here" If Mid$(xx$,1,5)="E&xit" Then xx$="Exit the program - Return to Menu" zztext=xx$ '------------------------------- ' remove ampersands from text '------------------------------- LL&=INSTR(xx$,"&") If LL&>0 Then If LL&=1 Then xxx$=MID$(xx$,2) Else xxx$=MID$(xx$,1,LL&-1)+MID$(xx$,LL&+1) End If zztext=xxx$ End If '------------------------------- ' put the text on the status bar '------------------------------- SendMessage hStatus, %SB_SETTEXT, 0, VarPtr(zzText) Function = 0 Exit Function Case %WM_HELP '&H53 MsgBox "Help selected" Case %WM_SYSCOMMAND If (CbWParam And &hFFF0) = %SC_SCREENSAVE Then Function = 1 Case %WM_COMMAND Select Case CbCtl Case %IDOK 'trap enter key Case %ID_CHART '401 MsgBox "Chart of accounts clicked" Case %ID_EMPLO '402 MsgBox "Employee file clicked" Case %ID_PAYEE '403 MsgBox "payee file clicked" Case %ID_SYNON '404 MsgBox "synonym file clicked" Case %ID_CUSTO '405 MsgBox "customer file clicked" Case %ID_NOTES '407 MsgBox "Notes clicked" Case %ID_EXIT '429 Dialog End CbHndl, 0 Case %ID_INSERT MsgBox "insert record selected" Case %ID_RTOGGLE MsgBox "rtoggle selected" Case %ID_STOGGLE MsgBox "s toggle selected" Case %ID_AUTOCOMPLETE MsgBox "autocomples selected" Case %ID_CALC MsgBox "calculator selected" Case %ID_INSERTH MsgBox "inser selected" Case %ID_PYRLCODE MsgBox "payroll codes selected" Case 455 'help MsgBox "Help selected" Case 456 'about MsgBox "about selected" Case %ID_PYRLCODE '459 payroll codes MsgBox "Payroll Codes listing selected" End Select Case %WM_USER + 999& Control Set Focus hDlg, CbLParam End Select End Function