Use Windows.pkg Use dfLine.pkg Use dfBitmap.pkg Use cCmdLineSelector.pkg Use THDialog.pkg Struct tCustomMenuItems Integer iOrder String sType String sName String sCommand End_Struct Object oCustMenuView is a ModalPanel Property String psMenuType "" Property tCustomMenuItems[] ptCustomMenuItems Property Integer piSelectedItem -1 Set Size to 195 445 Set Label to "The Hammer Custom Menu" Set piMinSize to 195 445 Set Location to 2 2 Set Locate_Mode to CENTER_ON_SCREEN Set Icon to "Configure16.ico" Set piMaxSize to 195 445 Set Border_Style to Border_WindowEdge Object oOpenDialog is a OpenDialog Set Location to 170 379 Set Dialog_Caption to "Select a file" Set Filter_String to "Executables|*.exe|All Files|*.*" Set NoChangeDir_State to True End_Object // oOpenDialog Object oMenuItemsGroup is a Group Set Size to 168 435 Set Location to 2 5 Object oPanelIcon is a BitmapContainer Set Size to 17 18 Set Location to 9 412 Set Border_Style to Border_Normal Set Bitmap to "THCustMenu32.bmp" End_Object Object oMenuItems is a Grid Set Location to 11 7 Set Size to 130 155 Set GridLine_Mode to Grid_Visible_None Set Select_Mode to No_Select Set Line_Width to 1 0 Set Form_Width 0 to 150 Set Header_Label 0 to "Menu Item" Set form_height item 0 to 16 Procedure Mouse_Down Integer iWindowNumber Integer iPosition tCustomMenuItems[] ltCustomMenuItems Integer iItem iData Forward Send Mouse_Down iWindowNumber iPosition If (Item_Count(Self)) Begin Get Current_Item to iItem Get ptCustomMenuItems to ltCustomMenuItems Set Value of oMenuLabel item 0 to ltCustomMenuItems[iItem].sName Set Value of oMenuCommand item 0 to ltCustomMenuItems[iItem].sCommand Set piSelectedItem to iItem End End_Procedure Procedure Move_Item Integer iItemFrom Integer iItemTo tCustomMenuItems[] ltCustomMenuItems tCustomMenuItems ltCustomMenuItem Integer iData iNextData String sLabel sNextLabel Get Value item iItemFrom to sLabel Get Aux_Value item iItemFrom to iData Get Value item iItemTo to sNextLabel Get Aux_Value item iItemTo to iNextData Set Value item iItemFrom to sNextLabel Set Aux_Value item iItemFrom to iNextData Set Value item iItemTo to sLabel Set Aux_Value item iItemTo to iData Set Current_Item to iItemTo Get ptCustomMenuItems to ltCustomMenuItems Move ltCustomMenuItems[iItemFrom] to ltCustomMenuItem Move ltCustomMenuItems[iItemTo] to ltCustomMenuItems[iItemFrom] Move ltCustomMenuItem to ltCustomMenuItems[iItemTo] Move (iItemTo+1) to ltCustomMenuItems[iItemTo].iOrder Move (iItemFrom+1) to ltCustomMenuItems[iItemFrom].iOrder Set ptCustomMenuItems to ltCustomMenuItems End_Procedure Procedure Move_Up Integer iItem iItems Get Item_Count to iItems If iItems Begin Get Current_Item to iItem If (iItem=0) Procedure_Return // First Item, can not move Send Move_Item iItem (iItem-1) End End_Procedure Procedure Move_Down Integer iItem iItems Get Item_Count to iItems If iItems Begin Get Current_Item to iItem If (iItem=(iItems-1)) Procedure_Return // Last Item, can not move Send Move_Item iItem (iItem+1) End End_Procedure Procedure Collect_INI_Data tCustomMenuItems[] ByRef ltCustomMenuItems Integer iC iCount iItem String sType sMenuItemType Get psMenuType to sType Move 0 to iItem Move (Uppercase(Trim(sType))) to sType Get psCustomMenuUtilities.Count of ghoEditorProperties to iCount For iC from 0 to (iCount-1) Get psCustomMenuUtilities.psUtilityType of ghoEditorProperties item iC to sMenuItemType Move (Uppercase(Trim(sMenuItemType))) to sMenuItemType If (sMenuItemType=sType) Begin Get psCustomMenuUtilities.psUtilityOrder of ghoEditorProperties item iC to ltCustomMenuItems[iItem].iOrder Move sMenuItemType to ltCustomMenuItems[iItem].sType Get psCustomMenuUtilities of ghoEditorProperties item iC to ltCustomMenuItems[iItem].sName Get psCustomMenuUtilities.psUtilityCommand of ghoEditorProperties item iC to ltCustomMenuItems[iItem].sCommand Increment iItem End End // Finally, sort by Order If (SizeOfArray(ltCustomMenuItems)) ; Move (SortArray(ltCustomMenuItems)) to ltCustomMenuItems // Set ptCustomMenuItems to ltCustomMenuItems End_Procedure Procedure Update_Items tCustomMenuItems[] ByRef ltCustomMenuItems Integer iItem iItems Send Delete_Data Move (SizeOfArray(ltCustomMenuItems)-1) to iItems For iItem from 0 to iItems Send Add_Item Msg_None ltCustomMenuItems[iItem].sName Get Item_Count to iItem Decrement iItem Set Entry_State item iItem to False Loop End_Procedure // Sample method of how to fill a grid Procedure DoFillGrid tCustomMenuItems[] ltCustomMenuItems Integer iItem iItems // Send Collect_INI_Data (<CustomMenuItems) // Send Update_Items (<CustomMenuItems) // End_Procedure End_Object Object oNewItem is a Button Set Size to 14 75 Set Location to 145 7 Set Label to "New" Procedure OnClick Send Clear_Forms Send Activate to oMenuLabel End_Procedure End_Object Object oDeleteItem is a Button Set Size to 14 75 Set Location to 145 88 Set Label to "Delete" Procedure OnClick Integer iItem iItems iSelected iOK String sConfirmation tCustomMenuItems[] ltCustomMenuItems Get piSelectedItem to iSelected If (iSelected<0) Begin Send Stop_Box (_T("Please select menu item first", 902)) (_T("Problem", 903)) Procedure_Return End Get Item_Count of oMenuItems to iItems If (iItems) Begin Get ptCustomMenuItems to ltCustomMenuItems Get Current_Item of oMenuItems to iItem #IFDEF TH_TRANSLATION Move (Replace("%1", gILanguage[904], ltCustomMenuItems[iItem].sName)) to sConfirmation Get YesNo_Box sConfirmation gILanguage[905] MBR_NO to iOK #ELSE Get YesNo_Box ('Confirm You wish to delete "' + ltCustomMenuItems[iItem].sName + '" menu item?') "Confirmation" MBR_NO to iOK #ENDIF If (iOK=MBR_Yes) Begin Move (RemoveFromArray(ltCustomMenuItems, iItem)) to ltCustomMenuItems Send Update_Items to oMenuItems (<CustomMenuItems) Send Clear_Forms // Re-order items Move (SizeOfArray(ltCustomMenuItems)-1) to iItems For iItem from 0 to iItems Move (iItem+1) to ltCustomMenuItems[iItem].iOrder Loop // Set ptCustomMenuItems to ltCustomMenuItems End End End_Procedure End_Object Object oInfoTip is a Container3d Set Size to 70 238 Set Location to 71 192 Set Color to clInfoBk Set Border_Style to Border_Normal Object oInfoTextVDFRUN is a Textbox Set Label to "@DFRUN@" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 4 4 Set Size to 10 40 Set FontWeight to 800 Set TypeFace to "MS Sans Serif" End_Object // oInfoTextVDFRUN Object oInfoTextVDFROOT is a Textbox Set Label to "@VDFROOT@" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 15 4 Set Size to 10 49 Set FontWeight to 800 Set TypeFace to "MS Sans Serif" End_Object // oInfoTextVDFROOT Object oInfoTextCURDIR is a Textbox Set Label to "@CURDIR@" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 26 4 Set Size to 10 43 Set FontWeight to 800 Set TypeFace to "MS Sans Serif" End_Object // oInfoTextCURDIR Object oInfoTextOnDfRun is a Textbox Set Auto_Size_State to False Set Label to "Expanded into the dfrun.exe full qualified path (obsolete)" Set Color to clInfoBk Set TextColor to clMenuText Set Location to 4 75 Set Size to 10 232 Set TypeFace to "MS Sans Serif" End_Object // oInfoTextOnDfRun Object oInfoTextOnVdfRoot is a Textbox Set Auto_Size_State to False Set Label to "Expanded into the DataFlex root directory (C:\VDF)" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 15 75 Set Size to 10 231 Set TypeFace to "MS Sans Serif" End_Object // oInfoTextOnVdfRoot Object oInfoTextOnStartup is a Textbox Set Label to "Expanded into the start up directory" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 26 75 Set Size to 10 113 Set TypeFace to "MS Sans Serif" End_Object // oInfoTextOnCurDir Object oInfoTextCURDIR is a Textbox Set Label to "%1" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 37 4 Set Size to 10 11 Set FontWeight to 800 Set TypeFace to "MS Sans Serif" End_Object // oInfoTextCURDIR Object oInfoTextOnCurDir is a Textbox Set Label to "Current opened file in editor (Path included)" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 37 75 Set Size to 10 137 Set TypeFace to "MS Sans Serif" End_Object // oInfoTextOnCurDir Object oInfoTextTransfer is a Textbox Set Label to "@TRANSFERFILE@" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 47 4 Set Size to 10 68 Set FontWeight to 800 Set TypeFace to "MS Sans Serif" End_Object Object oInfoTextOnTransfer is a Textbox Set Label to "Expanded into the Wizard Transfer File" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 47 75 Set Size to 10 123 Set TypeFace to "MS Sans Serif" End_Object Object oInfoTextProgram is a Textbox Set Label to "@PROGRAM@" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 58 4 Set Size to 10 68 Set FontWeight to 800 Set TypeFace to "MS Sans Serif" End_Object Object oInfoTextOnProgram is a Textbox Set Label to "Expanded into the Current program (SRC) file" Set Color to clInfoBk Set TextColor to clInfoText Set Location to 58 75 Set Size to 10 142 Set TypeFace to "MS Sans Serif" End_Object End_Object // oInfoTip Object oMenuLabel is a Form Set Size to 13 205 Set Location to 19 193 Set Label_Col_Offset to 0 Set Label to "Menu Label:" Set Label_Justification_Mode to JMode_Top Procedure OnChange Set Enabled_State of oApply_Btn to True End_Procedure End_Object Object oMenuCommand is a Form Set Size to 13 182 Set Location to 55 193 Set Label_Col_Offset to 0 Set Label to "Command Line:" Set Label_Justification_Mode to JMode_Top Procedure OnChange Set Enabled_State of oApply_Btn to True End_Procedure End_Object Object oBrowse is a cCmdLineSelector Set Location to 55 380 Set psFileDialogCaption to "Select the Utility" Set phoPathForm to (oMenuCommand(Self)) End_Object Object oMoveUpBtn is a Button Set Size to 14 16 Set Location to 58 167 Set psImage to "ABUP.BMP" Procedure OnClick Send Move_Up to oMenuItems Send Activate to oMenuItems End_Procedure End_Object Object oMoveDownBtn is a Button Set Size to 14 16 Set Location to 76 167 Set psImage to "ABDOWN.BMP" Procedure OnClick Send Move_Down to oMenuItems Send Activate to oMenuItems End_Procedure End_Object Object oApply_Btn is a Button Set Label to "Apply" Set Location to 145 380 Set Enabled_State to False Procedure OnClick Integer iItem String sType tCustomMenuItems[] ltCustomMenuItems Get ptCustomMenuItems to ltCustomMenuItems Get piSelectedItem to iItem Get psMenuType to sType If (iItem=-1) Move (SizeOfArray(ltCustomMenuItems)) to iItem // Move sType to ltCustomMenuItems[iItem].sType Move (iItem+1) to ltCustomMenuItems[iItem].iOrder Get Value of oMenuLabel to ltCustomMenuItems[iItem].sName Get Value of oMenuCommand to ltCustomMenuItems[iItem].sCommand // If ((ltCustomMenuItems[iItem].sName="")or(ltCustomMenuItems[iItem].sCommand="")) Begin Send Stop_Box (_T("Item name and command must be specified", 917)) (_T("Warning", 918)) Procedure_Return End // Set ptCustomMenuItems to ltCustomMenuItems Send Update_Items to oMenuItems (<CustomMenuItems) End_Procedure End_Object Procedure Clear_Forms Set Enabled_State of oApply_Btn to False Set Value of oMenuLabel to "" Set Value of oMenuCommand to "" Set piSelectedItem to -1 End_Procedure End_Object // oMenuItemsGroup Procedure Save_Custom_Menu tCustomMenuItems[] ltCustomMenuItems String sMenuType Integer iItem iItems iUtility iC iCount // Get psMenuType to sMenuType Get ptCustomMenuItems to ltCustomMenuItems Get psCustomMenuUtilities.Count of ghoEditorProperties to iCount // 1. Collect all known utilities For iC from 0 to (iCount-1) If (Uppercase(psCustomMenuUtilities.psUtilityType(ghoEditorProperties,iC))<>sMenuType) Begin Move (SizeOfArray(ltCustomMenuItems)) to iItem Get psCustomMenuUtilities of ghoEditorProperties item iC to ltCustomMenuItems[iItem].sName Get psCustomMenuUtilities.psUtilityOrder of ghoEditorProperties item iC to ltCustomMenuItems[iItem].iOrder Get psCustomMenuUtilities.psUtilityType of ghoEditorProperties item iC to ltCustomMenuItems[iItem].sType Get psCustomMenuUtilities.psUtilityCommand of ghoEditorProperties item iC to ltCustomMenuItems[iItem].sCommand End Loop // 2. Delete all utilities Send psCustomMenuUtilities.DeleteAllItems to ghoEditorProperties // 3. Re-generate INI Repository Move (SizeOfArray(ltCustomMenuItems)-1) to iItems For iItem from 0 to iItems Set psCustomMenuUtilities of ghoEditorProperties ; iItem to ltCustomMenuItems[iItem].sName Set psCustomMenuUtilities.psUtilityCommand of ghoEditorProperties ; iItem to ltCustomMenuItems[iItem].sCommand Set psCustomMenuUtilities.psUtilityType of ghoEditorProperties ; iItem to ltCustomMenuItems[iItem].sType Set psCustomMenuUtilities.psUtilityOrder of ghoEditorProperties ; iItem to ltCustomMenuItems[iItem].iOrder Loop // End_Procedure Object oOK_Btn is a Button Set Label to "Save" Set Location to 174 335 Procedure OnClick Send Save_Custom_Menu Send Close_Panel End_Procedure End_Object Object oClose_Btn is a Button Set Label to "&Close" Set Location to 174 390 Procedure OnClick Send Close_Panel End_Procedure End_Object On_Key Key_Alt+Key_O Send KeyAction of oOK_Btn On_Key Key_Alt+Key_C Send KeyAction of oClose_Btn #IFDEF TH_TRANSLATION Procedure Translate Handle hParent Set Label to gILanguage[896] Set Dialog_Caption of oOpenDialog to gILanguage[897] Set Filter_String of oOpenDialog to gILanguage[898] Move (oMenuItemsGroup(Self)) to hParent Set Header_Label of (oMenuItems(hParent)) 0 to gILanguage[899] Set Label of (oNewItem(hParent)) to gILanguage[900] Set Label of (oDeleteItem(hParent)) to gILanguage[901] Set Label of (oInfoTextOnDfRun(oInfoTip(hParent))) to gILanguage[906] Set Label of (oInfoTextOnVdfRoot(oInfoTip(hParent))) to gILanguage[907] Set Label of (oInfoTextOnStartup(oInfoTip(hParent))) to gILanguage[908] Set Label of (oInfoTextOnCurDir(oInfoTip(hParent))) to gILanguage[909] Set Label of (oInfoTextOnTransfer(oInfoTip(hParent))) to gILanguage[910] Set Label of (oInfoTextOnProgram(oInfoTip(hParent))) to gILanguage[911] Set Label of (oMenuLabel(hParent)) to gILanguage[912] Set Label of (oMenuCommand(hParent)) to gILanguage[913] Set Label of (oBrowse(hParent)) to gILanguage[914] Set psFileDialogCaption of (oBrowse(hParent)) to gILanguage[915] Set Label of (oApply_Btn(hParent)) to gILanguage[916] Set Label of oOK_Btn to gILanguage[919] Set Label of oClose_Btn to gILanguage[920] End_Procedure #ENDIF Procedure Popup String sMenu If (sMenu="") Procedure_Return Set psMenuType to (Uppercase(sMenu)) #IFDEF TH_TRANSLATION If (sMenu="Tools") Move gILanguage[142] to sMenu Else If (sMenu="Source") Move gILanguage[256] to sMenu Else If (sMenu="Database") Move gILanguage[291] to sMenu Move (Replace('&', sMenu, "")) to sMenu Move (Replace("%1", gILanguage[895], sMenu)) to sMenu Send Translate #ELSE Move (sMenu * "Custom Menu") to sMenu #ENDIF Set Label to sMenu Send Clear_Forms to oMenuItemsGroup Send DoFillGrid to oMenuItems Forward Send Popup End_Procedure End_Object Procedure Activate_oToolsMenuView Send Popup to oCustmenuView "Tools" End_Procedure // Activate_oCustmenuView Procedure Activate_oSourceMenuView Send Popup to oCustMenuView "Source" End_Procedure // Activate_oCustmenuView Procedure Activate_oDatabaseMenuView Send Popup to oCustMenuView "Database" End_Procedure // Activate_oCustmenuView