|FORWARDTYPE|(CallTip param1 as type, ...) as long
+ '' ...etc
+ '' ENDTYPE
+ ''
+
+ dim arrBase( any ) as CWSTR
+
+ dim pStream as CTextStream
+ if pStream.Open(wszFilename) <> S_OK then return true ' error
+
+ dim as boolean bReadingType = false
+ dim as boolean bIsBase = false
+
+ do until pStream.EOS
+ wst = pStream.ReadLine
+
+ wst = trim(wst)
+ if len(wst) = 0 then continue do
+
+ parser.objectStartLine = 0
+ parser.objectEndLine = 0
+
+ if left(wst, 5) = "TYPE:" then
+ bReadingType = true
+ parser.typeName = mid(wst, 6)
+ parser.typeAlias = parser.typeName
+ parser.typeExtends = ""
+ if parser.typeName = "BASE" then
+ bIsBase = true
+ else
+ bIsBase = false
+ gdb2.dbAdd( @parser, DB2_TYPE )
+ end if
+ continue do
+ end if
+
+ if left(wst, 7) = "ENDTYPE" then
+ bReadingType = false
+ bIsBase = false
+ end if
+
+ if bReadingType then
+ ' Each element of the TYPE structure is added to the database.
+ parser.functionName = parser.typeName
+ parser.varName = ""
+ parser.varType = ""
+ parser.functionParams = ""
+ parser.varScope = DIMSCOPE.SCOPEGLOBAL
+ if bIsBase then
+ dim as long ub = ubound(arrBase) + 1
+ redim preserve arrBase(ub)
+ arrBase(ub) = wst
+ elseif wst = "+BASE" then
+ ' add all of the BASE properties to this type
+ for i as long = lbound(arrBase) to ubound(arrBase)
+ ' If functionParams exist then this is a function within a TYPE
+ dim as CWSTR functionParams = trim(AfxStrParse(arrBase(i), 3, "|"))
+ if len(functionParams) then
+ parser.functionName = parser.typeName & "." & trim(AfxStrParse(arrBase(i), 1, "|"))
+ parser.functionParams = functionParams
+ gdb2.dbAdd( @parser, DB2_FUNCTION )
+ else
+ parser.varName = trim(AfxStrParse(arrBase(i), 1, "|"))
+ parser.varType = trim(AfxStrParse(arrBase(i), 2, "|"))
+ gdb2.dbAdd( @parser, DB2_VARIABLE )
+ end if
+ next
+ else
+ ' If functionParams exist then this is a function within a TYPE
+ dim as CWSTR functionParams = trim(AfxStrParse(wst, 3, "|"))
+ if len(functionParams) then
+ parser.functionName = parser.typeName & "." & trim(AfxStrParse(wst, 1, "|"))
+ parser.functionParams = functionParams
+ gdb2.dbAdd( @parser, DB2_FUNCTION )
+ else
+ parser.varName = trim(AfxStrParse(wst, 1, "|"))
+ parser.varType = trim(AfxStrParse(wst, 2, "|"))
+ gdb2.dbAdd( @parser, DB2_VARIABLE )
+ end if
+ end if
+ end if
+
+ loop
+ pStream.Close
+
+ return false ' no error
+end function
+
+
+''
+''
+function clsConfig.LoadCodetipsWinFormsX() as boolean
+ gdb2.dbDeleteByFileType( DB2_FILETYPE_WINFORMSX )
+ function = this.LoadCodetipsWinForms(_WinFormsXCodetipsFilename)
+
+ dim parser as ctxParser
+ parser.nFileType = DB2_FILETYPE_WINFORMSX
+
+ parser.varName = "Application"
+ parser.varType = "wfxApplication"
+ parser.varScope = DIMSCOPE.SCOPEGLOBAL
+ parser.functionName = ""
+ gdb2.dbAdd( @parser, DB2_VARIABLE )
+
+ parser.varName = "Colors"
+ parser.varType = "wfxColors"
+ parser.varScope = DIMSCOPE.SCOPEGLOBAL
+ parser.functionName = ""
+ gdb2.dbAdd( @parser, DB2_VARIABLE )
+
+ function = 0
+end function
+
+''
+''
+function clsConfig.LoadCodetipsWinFBX() as boolean
+ gdb2.dbDeleteByFileType( DB2_FILETYPE_WINFBX )
+ function = this.LoadCodetipsGeneric(_WinFBXCodetipsFilename, DB2_FILETYPE_WINFBX)
+end function
+
+''
+''
+function clsConfig.LoadCodetipsWinAPI() as boolean
+ gdb2.dbDeleteByFileType( DB2_FILETYPE_WINAPI )
+ function = this.LoadCodetipsGeneric(_WinAPICodetipsFilename, DB2_FILETYPE_WINAPI)
+end function
+
+
+''
+''
+function clsConfig.LoadCodetips() as long
+ this.LoadCodetipsFB()
+ this.LoadCodetipsWinAPI()
+ this.LoadCodetipsWinFormsX()
+ this.LoadCodetipsWinFBX()
+ function = 0
+end function
+
+
+''
+'' INITIALIZE THE TOOLBOX CONTROLS
+''
+function clsConfig.InitializeToolBox() as long
+
+ redim gToolBox(50) as TOOLBOX_TYPE
+
+ dim as long n = 0
+ gToolBox(n).nToolType = CTRL_POINTER
+ gToolBox(n).wszToolBoxName = "Pointer"
+ gToolBox(n).wszControlName = "Pointer"
+ gToolBox(n).wszImage = "IMAGE_POINTER"
+ gToolBox(n).wszCursor = ""
+ gToolBox(n).wszClassName = ""
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_BUTTON
+ gToolBox(n).wszToolBoxName = "Button"
+ gToolBox(n).wszControlName = "Button"
+ gToolBox(n).wszImage = "IMAGE_BUTTON"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_BUTTON"
+ gToolBox(n).wszClassName = "BUTTON"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_CHECKBOX
+ gToolBox(n).wszToolBoxName = "CheckBox"
+ gToolBox(n).wszControlName = "Check"
+ gToolBox(n).wszImage = "IMAGE_CHECKBOX"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_CHECKBOX"
+ gToolBox(n).wszClassName = "CHECKBOX"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_COMBOBOX
+ gToolBox(n).wszToolBoxName = "ComboBox"
+ gToolBox(n).wszControlName = "Combo"
+ gToolBox(n).wszImage = "IMAGE_COMBOBOX"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_COMBOBOX"
+ gToolBox(n).wszClassName = "COMBOBOX"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_DATETIMEPICKER
+ gToolBox(n).wszToolBoxName = "DateTimePicker"
+ gToolBox(n).wszControlName = "DateTimePicker"
+ gToolBox(n).wszImage = "IMAGE_DATETIMEPICKER"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_DATETIMEPICKER"
+ gToolBox(n).wszClassName = "DATETIMEPICKER"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_FRAME
+ gToolBox(n).wszToolBoxName = "Frame"
+ gToolBox(n).wszControlName = "Frame"
+ gToolBox(n).wszImage = "IMAGE_FRAME"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_FRAME"
+ gToolBox(n).wszClassName = "GROUPBOX"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_LABEL
+ gToolBox(n).wszToolBoxName = "Label"
+ gToolBox(n).wszControlName = "Label"
+ gToolBox(n).wszImage = "IMAGE_LABEL"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_LABEL"
+ gToolBox(n).wszClassName = "LABEL"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_LISTBOX
+ gToolBox(n).wszToolBoxName = "ListBox"
+ gToolBox(n).wszControlName = "List"
+ gToolBox(n).wszImage = "IMAGE_LISTBOX"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_LISTBOX"
+ gToolBox(n).wszClassName = "LISTBOX"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_LISTVIEW
+ gToolBox(n).wszToolBoxName = "ListView"
+ gToolBox(n).wszControlName = "ListView"
+ gToolBox(n).wszImage = "IMAGE_LISTVIEW"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_LISTVIEW"
+ gToolBox(n).wszClassName = "LISTVIEW"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_MASKEDEDIT
+ gToolBox(n).wszToolBoxName = "MaskedEdit"
+ gToolBox(n).wszControlName = "Masked"
+ gToolBox(n).wszImage = "IMAGE_MASKED"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_MASKED"
+ gToolBox(n).wszClassName = "MASKEDEDIT"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_MONTHCALENDAR
+ gToolBox(n).wszToolBoxName = "MonthCalendar"
+ gToolBox(n).wszControlName = "MonthCal"
+ gToolBox(n).wszImage = "IMAGE_MONTHCALENDAR"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_MONTHCALENDAR"
+ gToolBox(n).wszClassName = "MONTHCALENDAR"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_OPTION
+ gToolBox(n).wszToolBoxName = "OptionButton"
+ gToolBox(n).wszControlName = "Option"
+ gToolBox(n).wszImage = "IMAGE_OPTION"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_OPTION"
+ gToolBox(n).wszClassName = "RADIOBUTTON"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_PICTUREBOX
+ gToolBox(n).wszToolBoxName = "PictureBox"
+ gToolBox(n).wszControlName = "Picture"
+ gToolBox(n).wszImage = "IMAGE_PICTUREBOX"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_PICTUREBOX"
+ gToolBox(n).wszClassName = "PICTUREBOX"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_PROGRESSBAR
+ gToolBox(n).wszToolBoxName = "ProgressBar"
+ gToolBox(n).wszControlName = "Progress"
+ gToolBox(n).wszImage = "IMAGE_PROGRESSBAR"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_PROGRESSBAR"
+ gToolBox(n).wszClassName = "PROGRESSBAR"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_RICHEDIT
+ gToolBox(n).wszToolBoxName = "RichEdit"
+ gToolBox(n).wszControlName = "RichEdit"
+ gToolBox(n).wszImage = "IMAGE_RICHEDIT"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_RICHEDIT"
+ gToolBox(n).wszClassName = "RICHEDIT"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_TABCONTROL
+ gToolBox(n).wszToolBoxName = "TabControl"
+ gToolBox(n).wszControlName = "TabControl"
+ gToolBox(n).wszImage = "IMAGE_TABCONTROL"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_TABCONTROL"
+ gToolBox(n).wszClassName = "TABCONTROL"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_TEXTBOX
+ gToolBox(n).wszToolBoxName = "TextBox"
+ gToolBox(n).wszControlName = "Text"
+ gToolBox(n).wszImage = "IMAGE_TEXTBOX"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_TEXTBOX"
+ gToolBox(n).wszClassName = "TEXTBOX"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_TIMER
+ gToolBox(n).wszToolBoxName = "Timer"
+ gToolBox(n).wszControlName = "Timer"
+ gToolBox(n).wszImage = "IMAGE_TIMER"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_TIMER"
+ gToolBox(n).wszClassName = ""
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_TREEVIEW
+ gToolBox(n).wszToolBoxName = "TreeView"
+ gToolBox(n).wszControlName = "TreeView"
+ gToolBox(n).wszImage = "IMAGE_TREEVIEW"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_TREEVIEW"
+ gToolBox(n).wszClassName = "TREEVIEW"
+
+ n = n + 1
+ gToolBox(n).nToolType = CTRL_UPDOWN
+ gToolBox(n).wszToolBoxName = "UpDown"
+ gToolBox(n).wszControlName = "UpDown"
+ gToolBox(n).wszImage = "IMAGE_UPDOWN"
+ gToolBox(n).wszCursor = "IMAGE_CURSOR_UPDOWN"
+ gToolBox(n).wszClassName = "UPDOWN"
+
+ redim preserve gToolBox(n) as TOOLBOX_TYPE
+
+
+ ' System Colors
+ redim gColors(172)
+ gColors(0).SetColor("ActiveBorder", COLOR_SYSTEM, GetSysColor(COLOR_ACTIVEBORDER))
+ gColors(1).SetColor("ActiveCaption", COLOR_SYSTEM, GetSysColor(COLOR_ACTIVECAPTION))
+ gColors(2).SetColor("ActiveCaptionText", COLOR_SYSTEM, GetSysColor(COLOR_CAPTIONTEXT))
+ gColors(3).SetColor("AppWorkspace", COLOR_SYSTEM, GetSysColor(COLOR_APPWORKSPACE))
+ gColors(4).SetColor("ButtonFace", COLOR_SYSTEM, GetSysColor(COLOR_BTNFACE))
+ gColors(5).SetColor("ButtonHighlight", COLOR_SYSTEM, GetSysColor(COLOR_BTNHILIGHT))
+ gColors(5).SetColor("ButtonShadow", COLOR_SYSTEM,GetSysColor(COLOR_BTNSHADOW) )
+ gColors(6).SetColor("Control", COLOR_SYSTEM, GetSysColor(COLOR_3DFACE))
+ gColors(7).SetColor("ControlDark", COLOR_SYSTEM, GetSysColor(COLOR_3DSHADOW))
+ gColors(8).SetColor("ControlDarkDark", COLOR_SYSTEM, GetSysColor(COLOR_3DDKSHADOW))
+ gColors(9).SetColor("ControlLight", COLOR_SYSTEM, GetSysColor(COLOR_3DLIGHT))
+ gColors(10).SetColor("ControlLightLight", COLOR_SYSTEM, GetSysColor(COLOR_3DHILIGHT))
+ gColors(11).SetColor("ControlText", COLOR_SYSTEM, GetSysColor(COLOR_BTNTEXT))
+ gColors(12).SetColor("Desktop", COLOR_SYSTEM, GetSysColor(COLOR_DESKTOP))
+ gColors(13).SetColor("GradientActiveCaption", COLOR_SYSTEM, GetSysColor(COLOR_GRADIENTACTIVECAPTION))
+ gColors(14).SetColor("GradientInactiveCaption", COLOR_SYSTEM, GetSysColor(COLOR_GRADIENTINACTIVECAPTION))
+ gColors(15).SetColor("GrayText", COLOR_SYSTEM, GetSysColor(COLOR_GRAYTEXT))
+ gColors(16).SetColor("Highlight", COLOR_SYSTEM, GetSysColor(COLOR_HIGHLIGHT))
+ gColors(17).SetColor("HighlightText", COLOR_SYSTEM, GetSysColor(COLOR_HIGHLIGHTTEXT))
+ gColors(18).SetColor("HotTrack", COLOR_SYSTEM, GetSysColor(COLOR_HOTLIGHT))
+ gColors(19).SetColor("InactiveBorder", COLOR_SYSTEM, GetSysColor(COLOR_INACTIVEBORDER))
+ gColors(20).SetColor("InactiveCaption", COLOR_SYSTEM, GetSysColor(COLOR_INACTIVECAPTION))
+ gColors(21).SetColor("InactiveCaptionText", COLOR_SYSTEM, GetSysColor(COLOR_INACTIVECAPTIONTEXT))
+ gColors(22).SetColor("Info", COLOR_SYSTEM, GetSysColor(COLOR_INFOBK))
+ gColors(23).SetColor("InfoText", COLOR_SYSTEM, GetSysColor(COLOR_INFOTEXT))
+ gColors(24).SetColor("Menu", COLOR_SYSTEM, GetSysColor(COLOR_MENU))
+ gColors(25).SetColor("MenuBar", COLOR_SYSTEM, GetSysColor(COLOR_MENUBAR))
+ gColors(26).SetColor("MenuHighlight", COLOR_SYSTEM, GetSysColor(COLOR_MENUHILIGHT))
+ gColors(27).SetColor("MenuText", COLOR_SYSTEM, GetSysColor(COLOR_MENUTEXT))
+ gColors(28).SetColor("ScrollBar", COLOR_SYSTEM, GetSysColor(COLOR_SCROLLBAR))
+ gColors(29).SetColor("Window", COLOR_SYSTEM, GetSysColor(COLOR_WINDOW))
+ gColors(30).SetColor("WindowFrame", COLOR_SYSTEM, GetSysColor(COLOR_WINDOWFRAME))
+ gColors(31).SetColor("WindowText", COLOR_SYSTEM, GetSysColor(COLOR_WINDOWTEXT))
+
+ ' QUICK COLORS
+ gColors(32).SetColor("AliceBlue" , COLOR_COLORS, BGR(240,248,255))
+ gColors(33).SetColor("AntiqueWhite" , COLOR_COLORS, BGR(250,235,215))
+ gColors(34).SetColor("Aqua" , COLOR_COLORS, BGR( 0,255,255))
+ gColors(35).SetColor("Aquamarine" , COLOR_COLORS, BGR(127,255,212))
+ gColors(36).SetColor("Azure" , COLOR_COLORS, BGR(240,255,255))
+ gColors(37).SetColor("Beige" , COLOR_COLORS, BGR(245,245,220))
+ gColors(38).SetColor("Bisque" , COLOR_COLORS, BGR(255,228,196))
+ gColors(39).SetColor("Black" , COLOR_COLORS, BGR( 0, 0, 0))
+ gColors(40).SetColor("BlanchedAlmond" , COLOR_COLORS, BGR(255,255,205))
+ gColors(41).SetColor("Blue" , COLOR_COLORS, BGR( 0, 0,255))
+ gColors(42).SetColor("BlueViolet" , COLOR_COLORS, BGR(138, 43,226))
+ gColors(43).SetColor("Brown" , COLOR_COLORS, BGR(165, 42, 42))
+ gColors(44).SetColor("Burlywood" , COLOR_COLORS, BGR(222,184,135))
+ gColors(45).SetColor("CadetBlue" , COLOR_COLORS, BGR( 95,158,160))
+ gColors(46).SetColor("Chartreuse" , COLOR_COLORS, BGR(127,255, 0))
+ gColors(47).SetColor("Chocolate" , COLOR_COLORS, BGR(210,105, 30))
+ gColors(48).SetColor("Coral" , COLOR_COLORS, BGR(255,127, 80))
+ gColors(49).SetColor("CornflowerBlue" , COLOR_COLORS, BGR(100,149,237))
+ gColors(50).SetColor("Cornsilk" , COLOR_COLORS, BGR(255,248,220))
+ gColors(51).SetColor("Crimson" , COLOR_COLORS, BGR(220, 20, 60))
+ gColors(52).SetColor("Cyan" , COLOR_COLORS, BGR( 0,255,255))
+ gColors(53).SetColor("DarkBlue" , COLOR_COLORS, BGR( 0, 0,139))
+ gColors(54).SetColor("DarkCyan" , COLOR_COLORS, BGR( 0,139,139))
+ gColors(55).SetColor("DarkGoldenRod" , COLOR_COLORS, BGR(184,134, 11))
+ gColors(56).SetColor("DarkGray" , COLOR_COLORS, BGR(169,169,169))
+ gColors(57).SetColor("DarkGreen" , COLOR_COLORS, BGR( 0,100, 0))
+ gColors(58).SetColor("DarkKhaki" , COLOR_COLORS, BGR(189,183,107))
+ gColors(59).SetColor("DarkMagenta" , COLOR_COLORS, BGR(139, 0,139))
+ gColors(60).SetColor("DarkOliveGreen" , COLOR_COLORS, BGR( 85,107, 47))
+ gColors(61).SetColor("DarkOrange" , COLOR_COLORS, BGR(255,140, 0))
+ gColors(62).SetColor("DarkOrchid" , COLOR_COLORS, BGR(153, 50,204))
+ gColors(63).SetColor("DarkRed" , COLOR_COLORS, BGR(139, 0, 0))
+ gColors(64).SetColor("DarkSalmon" , COLOR_COLORS, BGR(233,150,122))
+ gColors(65).SetColor("DarkSeaGreen" , COLOR_COLORS, BGR(143,188,143))
+ gColors(66).SetColor("DarkSlateBlue" , COLOR_COLORS, BGR( 72, 61,139))
+ gColors(67).SetColor("DarkSlateGray" , COLOR_COLORS, BGR( 47, 79, 79))
+ gColors(68).SetColor("DarkTurquoise" , COLOR_COLORS, BGR( 0,206,209))
+ gColors(69).SetColor("DarkViolet" , COLOR_COLORS, BGR(148, 0,211))
+ gColors(70).SetColor("DeepPink" , COLOR_COLORS, BGR(255, 20,147))
+ gColors(71).SetColor("DeepSkyBlue" , COLOR_COLORS, BGR( 0,191,255))
+ gColors(72).SetColor("DimGray" , COLOR_COLORS, BGR(105,105,105))
+ gColors(73).SetColor("DodgerBlue" , COLOR_COLORS, BGR( 30,144,255))
+ gColors(74).SetColor("FireBrick" , COLOR_COLORS, BGR(178, 34, 34))
+ gColors(75).SetColor("FloralWhite" , COLOR_COLORS, BGR(255,250,240))
+ gColors(76).SetColor("ForestGreen" , COLOR_COLORS, BGR( 34,139, 34))
+ gColors(77).SetColor("Fuchsia" , COLOR_COLORS, BGR(255, 0,255))
+ gColors(78).SetColor("Gainsboro" , COLOR_COLORS, BGR(220,220,220))
+ gColors(79).SetColor("GhostWhite" , COLOR_COLORS, BGR(248,248,255))
+ gColors(80).SetColor("Gold" , COLOR_COLORS, BGR(255,215, 0))
+ gColors(81).SetColor("GoldenRod" , COLOR_COLORS, BGR(218,165, 32))
+ gColors(82).SetColor("Gray" , COLOR_COLORS, BGR(127,127,127))
+ gColors(83).SetColor("Green" , COLOR_COLORS, BGR( 0,128, 0))
+ gColors(84).SetColor("GreenYellow" , COLOR_COLORS, BGR(173,255, 47))
+ gColors(85).SetColor("HoneyDew" , COLOR_COLORS, BGR(240,255,240))
+ gColors(86).SetColor("HotPink" , COLOR_COLORS, BGR(255,105,180))
+ gColors(87).SetColor("IndianRed" , COLOR_COLORS, BGR(205, 92, 92))
+ gColors(88).SetColor("Indigo" , COLOR_COLORS, BGR( 75, 0,130))
+ gColors(89).SetColor("Ivory" , COLOR_COLORS, BGR(255,255,240))
+ gColors(90).SetColor("Khaki" , COLOR_COLORS, BGR(240,230,140))
+ gColors(91).SetColor("Lavender" , COLOR_COLORS, BGR(230,230,250))
+ gColors(92).SetColor("LavenderBlush" , COLOR_COLORS, BGR(255,240,245))
+ gColors(93).SetColor("Lawngreen" , COLOR_COLORS, BGR(124,252, 0))
+ gColors(94).SetColor("LemonChiffon" , COLOR_COLORS, BGR(255,250,205))
+ gColors(95).SetColor("LightBlue" , COLOR_COLORS, BGR(173,216,230))
+ gColors(96).SetColor("LightCoral" , COLOR_COLORS, BGR(240,128,128))
+ gColors(97).SetColor("LightCyan" , COLOR_COLORS, BGR(224,255,255))
+ gColors(98).SetColor("LightGoldenRodYellow" , COLOR_COLORS, BGR(250,250,210))
+ gColors(99).SetColor("LightGreen" , COLOR_COLORS, BGR(144,238,144))
+ gColors(100).SetColor("LightGrey" , COLOR_COLORS, BGR(211,211,211))
+ gColors(101).SetColor("LightPink" , COLOR_COLORS, BGR(255,182,193))
+ gColors(102).SetColor("LightSalmon" , COLOR_COLORS, BGR(255,160,122))
+ gColors(103).SetColor("LightSeaGreen" , COLOR_COLORS, BGR( 32,178,170))
+ gColors(104).SetColor("LightSkyBlue" , COLOR_COLORS, BGR(135,206,250))
+ gColors(105).SetColor("LightSlateGray" , COLOR_COLORS, BGR(119,136,153))
+ gColors(106).SetColor("LightSteelBlue" , COLOR_COLORS, BGR(176,196,222))
+ gColors(107).SetColor("LightYellow" , COLOR_COLORS, BGR(255,255,224))
+ gColors(108).SetColor("Lime" , COLOR_COLORS, BGR( 0,255, 0))
+ gColors(109).SetColor("LimeGreen" , COLOR_COLORS, BGR( 50,205, 50))
+ gColors(110).SetColor("Linen" , COLOR_COLORS, BGR(250,240,230))
+ gColors(111).SetColor("Magenta" , COLOR_COLORS, BGR(255, 0,255))
+ gColors(112).SetColor("Maroon" , COLOR_COLORS, BGR(128, 0, 0))
+ gColors(113).SetColor("MediumAquamarine" , COLOR_COLORS, BGR(102,205,170))
+ gColors(114).SetColor("MediumBlue" , COLOR_COLORS, BGR( 0, 0,205))
+ gColors(115).SetColor("MediumOrchid" , COLOR_COLORS, BGR(186, 85,211))
+ gColors(116).SetColor("MediumPurple" , COLOR_COLORS, BGR(147,112,219))
+ gColors(117).SetColor("MediumSeaGreen" , COLOR_COLORS, BGR( 60,179,113))
+ gColors(118).SetColor("MediumSlateBlue" , COLOR_COLORS, BGR(123,104,238))
+ gColors(119).SetColor("MediumSpringGreen" , COLOR_COLORS, BGR( 0,250,154))
+ gColors(120).SetColor("MediumTurquoise" , COLOR_COLORS, BGR( 72,209,204))
+ gColors(121).SetColor("MediumVioletRed" , COLOR_COLORS, BGR(199, 21,133))
+ gColors(122).SetColor("MidnightBlue" , COLOR_COLORS, BGR( 25, 25,112))
+ gColors(123).SetColor("MintCream" , COLOR_COLORS, BGR(245,255,250))
+ gColors(124).SetColor("MistyRose" , COLOR_COLORS, BGR(255,228,225))
+ gColors(125).SetColor("Moccasin" , COLOR_COLORS, BGR(255,228,181))
+ gColors(126).SetColor("NavajoWhite" , COLOR_COLORS, BGR(255,222,173))
+ gColors(127).SetColor("Navy" , COLOR_COLORS, BGR( 0, 0,128))
+ gColors(128).SetColor("Navyblue" , COLOR_COLORS, BGR(159,175,223))
+ gColors(129).SetColor("OldLace" , COLOR_COLORS, BGR(253,245,230))
+ gColors(130).SetColor("Olive" , COLOR_COLORS, BGR(128,128, 0))
+ gColors(131).SetColor("OliveDrab" , COLOR_COLORS, BGR(107,142, 35))
+ gColors(132).SetColor("Orange" , COLOR_COLORS, BGR(255,165, 0))
+ gColors(133).SetColor("OrangeRed" , COLOR_COLORS, BGR(255, 69, 0))
+ gColors(134).SetColor("Orchid" , COLOR_COLORS, BGR(218,112,214))
+ gColors(135).SetColor("PaleGoldenRod" , COLOR_COLORS, BGR(238,232,170))
+ gColors(136).SetColor("PaleGreen" , COLOR_COLORS, BGR(152,251,152))
+ gColors(137).SetColor("PaleTurquoise" , COLOR_COLORS, BGR(175,238,238))
+ gColors(138).SetColor("PaleVioletRed" , COLOR_COLORS, BGR(219,112,147))
+ gColors(139).SetColor("PapayaWhip" , COLOR_COLORS, BGR(255,239,213))
+ gColors(140).SetColor("PeachPuff" , COLOR_COLORS, BGR(255,218,185))
+ gColors(141).SetColor("Peru" , COLOR_COLORS, BGR(205,133, 63))
+ gColors(142).SetColor("Pink" , COLOR_COLORS, BGR(255,192,203))
+ gColors(143).SetColor("Plum" , COLOR_COLORS, BGR(221,160,221))
+ gColors(144).SetColor("PowderBlue" , COLOR_COLORS, BGR(176,224,230))
+ gColors(145).SetColor("Purple" , COLOR_COLORS, BGR(128, 0,128))
+ gColors(146).SetColor("Red" , COLOR_COLORS, BGR(255, 0, 0))
+ gColors(147).SetColor("RosyBrown" , COLOR_COLORS, BGR(188,143,143))
+ gColors(148).SetColor("RoyalBlue" , COLOR_COLORS, BGR( 65,105,225))
+ gColors(149).SetColor("SaddleBrown" , COLOR_COLORS, BGR(139, 69, 19))
+ gColors(150).SetColor("Salmon" , COLOR_COLORS, BGR(250,128,114))
+ gColors(151).SetColor("SandyBrown" , COLOR_COLORS, BGR(244,164, 96))
+ gColors(152).SetColor("SeaGreen" , COLOR_COLORS, BGR( 46,139, 87))
+ gColors(153).SetColor("SeaShell" , COLOR_COLORS, BGR(255,245,238))
+ gColors(154).SetColor("Sienna" , COLOR_COLORS, BGR(160, 82, 45))
+ gColors(155).SetColor("Silver" , COLOR_COLORS, BGR(192,192,192))
+ gColors(156).SetColor("SkyBlue" , COLOR_COLORS, BGR(135,206,235))
+ gColors(157).SetColor("SlateBlue" , COLOR_COLORS, BGR(106, 90,205))
+ gColors(158).SetColor("SlateGray" , COLOR_COLORS, BGR(112,128,144))
+ gColors(159).SetColor("Snow" , COLOR_COLORS, BGR(255,250,250))
+ gColors(160).SetColor("SpringGreen" , COLOR_COLORS, BGR( 0,255,127))
+ gColors(161).SetColor("SteelBlue" , COLOR_COLORS, BGR( 70,130,180))
+ gColors(162).SetColor("Tan" , COLOR_COLORS, BGR(210,180,140))
+ gColors(163).SetColor("Teal" , COLOR_COLORS, BGR( 0,128,128))
+ gColors(164).SetColor("Thistle" , COLOR_COLORS, BGR(216,191,216))
+ gColors(165).SetColor("Tomato" , COLOR_COLORS, BGR(255, 99, 71))
+ gColors(166).SetColor("Turquoise" , COLOR_COLORS, BGR( 64,224,208))
+ gColors(167).SetColor("Violet" , COLOR_COLORS, BGR(238,130,238))
+ gColors(168).SetColor("Wheat" , COLOR_COLORS, BGR(245,222,179))
+ gColors(169).SetColor("White" , COLOR_COLORS, BGR(255,255,255))
+ gColors(170).SetColor("WhiteSmoke" , COLOR_COLORS, BGR(245,245,245))
+ gColors(171).SetColor("Yellow" , COLOR_COLORS, BGR(255,255, 0))
+ gColors(172).SetColor("YellowGreen" , COLOR_COLORS, BGR(139,205, 50))
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enumerate the names of all the fonts. Note the difference between how to enumerate them
+' (%TMPF_FIXED_PITCH has the bit cleared).
+' %TMPF_FIXED_PITCH for fixed pitch fonts (like in PB edit)
+' %TMPF_TRUETYPE OR %TMPF_VECTOR for true type and vector fonts
+' %TMPF_DEVICE for device fonts (like printer fonts)
+' Exclude what you don't want to include in list.
+' ========================================================================================
+function fonts_EnumFontName( _
+ byref lf as LOGFONTW, _
+ byref tm as TEXTMETRIC, _
+ ByVal FontType as long, _
+ HWnd as HWnd _
+ ) as long
+ dim as long ub = ubound(gFontNames)
+ redim preserve gFontNames(ub + 1) as CWSTR
+ gFontNames(ub + 1) = lf.lfFaceName
+ function = true
+end function
+
+' ========================================================================================
+' Search the gFontNames() array to see if the font name exists
+' ========================================================================================
+function isFontNameExist( byval wszFontName as CWSTR ) as boolean
+ wszFontName = ucase(wszFontName)
+ for i as long = lbound(gFontnames) to ubound(gFontNames)
+ if wszFontName = ucase(gFontNames(i)) then return true
+ next
+ return false
+end function
+
+' ========================================================================================
+' Get a list of all font names installed on this system. We check this list to ensure
+' that the currently user selected font is actually available on the system that they
+' are using WinFBE under.
+' function returns true of the defined font name was valid on the system so no changes
+' were made to the config file fontname value.
+' ========================================================================================
+function doFontSanityCheck() as long
+ erase gFontNames
+ dim hDC as HDC = GetDC(0)
+ EnumFontFamilies( hDC, ByVal 0, Cast(FONTENUMPROCW, @fonts_EnumFontName), 0 )
+ ReleaseDC( 0, hDC )
+
+ ' Is the font defined in the config file okay?
+ if isFontNameExist( gConfig.EditorFontname ) then return true
+
+ 'print "Defined font not found. Finding an alternative..."
+
+ ' Test if we are running under wine
+ if gApp.isWineActive then
+ 'print "Linux Wine is active"
+ ' Test valid Linux fonts
+ if isFontNameExist( "DejaVu Sans Mono" ) then gConfig.EditorFontname = "DejaVu Sans Mono": return false
+ if isFontNameExist( "Ubuntu Mono" ) then gConfig.EditorFontname = "Ubuntu Mono": return false
+ if isFontNameExist( "Victor Mono" ) then gConfig.EditorFontname = "Victor Mono": return false
+ if isFontNameExist( "Inconsolata" ) then gConfig.EditorFontname = "Inconsolata": return false
+ if isFontNameExist( "Fira Code" ) then gConfig.EditorFontname = "Fira Code": return false
+ else
+ ' Test other valid Windows fonts
+ if isFontNameExist( "Consolas" ) then gConfig.EditorFontname = "Consolas": return false
+ if isFontNameExist( "MonoLisa" ) then gConfig.EditorFontname = "MonoLisa": return false
+ if isFontNameExist( "Apercu Mono" ) then gConfig.EditorFontname = "Apercu Mono": return false
+ if isFontNameExist( "Fira Code" ) then gConfig.EditorFontname = "Fira Code": return false
+ if isFontNameExist( "Dank Mono" ) then gConfig.EditorFontname = "Dank Mono": return false
+ if isFontNameExist( "Hack" ) then gConfig.EditorFontname = "Hack": return false
+ if isFontNameExist( "Courier New" ) then gConfig.EditorFontname = "Courier New": return false
+ end if
+
+ function = false
+end function
+
+
+''
+'' SAVE CONFIGURATION TO DISK FILE
+''
+function clsConfig.SaveConfigFile() as long
+
+ ' Determine the current editor positioning
+ ' Do not save if editor is minimized
+ if isiconic( HWND_FRMMAIN ) = 0 then
+ dim WinPla as WINDOWPLACEMENT
+ WinPla.Length = sizeof(WinPla)
+ GetWindowPlacement( HWND_FRMMAIN, @WinPla )
+ With this
+ .StartupLeft = WinPla.rcNormalPosition.Left
+ .StartupTop = WinPla.rcNormalPosition.Top
+ .StartupRight = WinPla.rcNormalPosition.Right
+ .StartupBottom = WinPla.rcNormalPosition.Bottom
+ .StartupMaximized = iif( WinPla.showCmd = SW_MAXIMIZE, true, false )
+ end With
+
+ dim as RECT rc
+ GetWindowRect( HWND_FRMMAIN, @rc )
+ if this.StartupLeft <> rc.Left then this.StartupLeft = rc.Left
+ if this.StartupTop <> rc.Top then this.StartupTop = rc.Top
+ if this.StartupRight <> rc.Right then this.StartupRight = rc.Right
+ if this.StartupBottom <> rc.Bottom then this.StartupBottom = rc.Bottom
+ end if
+
+ this.CompilerBuild = frmBuildConfig_GetSelectedBuildGUID()
+
+ dim pStream as CTextStream '(utf16)
+ if pStream.Create(_ConfigFilename, true, true) <> S_OK then return true ' error
+
+ pStream.WriteLine "' WINFBE CONFIGURATION"
+ pStream.WriteLine ""
+ pStream.WriteLine "WinFBEversion=" & APPVERSION
+ pStream.WriteLine ""
+ pStream.WriteLine "[Editor]"
+ pStream.WriteLine "AskExit=" & this.AskExit
+ pStream.WriteLine "CheckForUpdates=" & this.CheckForUpdates
+ pStream.WriteLine "EnableProjectCache=" & this.EnableProjectCache
+ pStream.WriteLine "LastUpdateCheck=" & this.LastUpdateCheck
+ pStream.WriteLine "AutoSaveFiles=" & this.AutoSaveFiles
+ pStream.WriteLine "AutoSaveInterval=" & this.AutoSaveInterval
+ pStream.WriteLine "RestoreSession=" & this.RestoreSession
+ pStream.WriteLine "LastActiveSessionFile=" & ProcessToCurdriveApp(this.wszLastActiveSession)
+ pStream.WriteLine "MultipleInstances=" & this.MultipleInstances
+ pStream.WriteLine "CompileAutosave=" & this.CompileAutosave
+ pStream.WriteLine "CloseFuncList=" & this.CloseFuncList
+ pStream.WriteLine "SyntaxHighlighting=" & this.SyntaxHighlighting
+ pStream.WriteLine "Codetips=" & this.Codetips
+ pStream.WriteLine "AutoComplete=" & this.AutoComplete
+ pStream.WriteLine "CharacterAutoComplete=" & this.CharacterAutoComplete
+ pStream.WriteLine "RightEdge=" & this.RightEdge
+ pStream.WriteLine "RightEdgePosition=" & this.RightEdgePosition
+ pStream.WriteLine "LeftMargin=" & this.LeftMargin
+ pStream.WriteLine "FoldMargin=" & this.FoldMargin
+ pStream.WriteLine "AutoIndentation=" & this.AutoIndentation
+ pStream.WriteLine "FornextVariable=" & this.FornextVariable
+ pStream.WriteLine "ConfineCaret=" & this.ConfineCaret
+ pStream.WriteLine "LineNumbering=" & this.LineNumbering
+ pStream.WriteLine "HighlightCurrentLine=" & this.HighlightCurrentLine
+ pStream.WriteLine "IndentGuides=" & this.IndentGuides
+ pStream.WriteLine "TabIndentSpaces=" & this.TabIndentSpaces
+ pStream.WriteLine "UnicodeEncoding=" & this.UnicodeEncoding
+ pStream.WriteLine "KeywordCase=" & this.KeywordCase
+ pStream.WriteLine "LocalizationFile=" & this.LocalizationFile
+ pStream.WriteLine "TabSize=" & this.TabSize
+ pStream.WriteLine "PositionMiddle=" & this.PositionMiddle
+ pStream.WriteLine "BraceHighlight=" & this.BraceHighlight
+ pStream.WriteLine "OccurrenceHighlight=" & this.OccurrenceHighlight
+ pStream.WriteLine "EditorFontname=" & this.EditorFontname
+ pStream.WriteLine "EditorFontsize=" & this.EditorFontsize
+ pStream.WriteLine "EditorFontCharSet=" & this.EditorFontCharSet
+ pStream.WriteLine "FontExtraSpace=" & this.FontExtraSpace
+ pStream.WriteLine "Theme=" & this.ThemeFilename
+ pStream.WriteLine ""
+ pStream.WriteLine "[Startup]"
+ pStream.WriteLine "StartupLeft=" & this.StartupLeft
+ pStream.WriteLine "StartupTop=" & this.StartupTop
+ pStream.WriteLine "StartupRight=" & this.StartupRight
+ pStream.WriteLine "StartupBottom=" & this.StartupBottom
+ pStream.WriteLine "StartupMaximized=" & this.StartupMaximized
+ pStream.WriteLine "ShowPanel=" & this.ShowPanel
+ pStream.WriteLine "ShowPanelWidth=" & this.ShowPanelWidth
+ pStream.WriteLine "ToolBoxLeft=" & this.ToolBoxLeft
+ pStream.WriteLine "ToolBoxTop=" & this.ToolBoxTop
+ pStream.WriteLine "ToolBoxRight=" & this.ToolBoxRight
+ pStream.WriteLine "ToolBoxBottom=" & this.ToolBoxBottom
+ pStream.WriteLine ""
+
+ ' for each folder location determine if it resides on the same drive as
+ ' the WinFBE application. if it does then substitute the replaceable parameter
+ ' {CURDRIVE} for the drive letter. This allows you to easily run the editor
+ ' on different media (eg. thumb drive) that may be assigned a different
+ ' drive letter.
+ this.FBWINCompiler32 = ProcessToCurdriveApp(this.FBWINCompiler32)
+ this.FBWINCompiler64 = ProcessToCurdriveApp(this.FBWINCompiler64)
+ this.CompilerHelpfile = ProcessToCurdriveApp(this.CompilerHelpfile)
+ this.WinFBXHelpfile = ProcessToCurdriveApp(this.WinFBXHelpfile)
+
+ pStream.WriteLine "[Compiler]"
+ pStream.WriteLine "FBWINCompiler32=" & this.FBWINCompiler32
+ pStream.WriteLine "FBWINCompiler64=" & this.FBWINCompiler64
+ pStream.WriteLine "CompilerBuild=" & this.CompilerBuild
+ pStream.WriteLine "CompilerSwitches=" & this.CompilerSwitches
+ pStream.WriteLine "CompilerHelpfile=" & this.CompilerHelpfile
+ pStream.WriteLine "WinFBXHelpfile=" & this.WinFBXHelpfile
+ pStream.WriteLine "RunViaCommandWindow=" & this.RunViaCommandWindow
+ pStream.WriteLine "DisableCompileBeep=" & this.DisableCompileBeep
+ pStream.WriteLine "WinFBXPath=" & this.WinFBXPath
+
+
+ pStream.WriteLine ""
+ pStream.WriteLine "[Categories]"
+ dim as long nNext = 0
+ for i as long = lbound(this.Cat) to ubound(this.Cat)
+ if left(this.Cat(i).wszDescription, 2) <> "%%" then
+ if trim(this.Cat(i).wszDescription) <> "" then
+ pStream.Write "CATEGORY_" & right("00" & str(nNext), 2) & "="
+ pStream.Write this.Cat(i).idFileType & "|-|"
+ pStream.WriteLine this.Cat(i).wszDescription
+ nNext = nNext + 1
+ end if
+ end if
+ next
+ pStream.WriteLine ""
+
+ pStream.WriteLine ""
+ pStream.WriteLine "[UserTools]"
+ for i as long = lbound(this.Tools) to ubound(this.Tools)
+ pStream.Write "USERTOOL_" & right("00" & str(i), 2) & "="
+ pStream.Write this.Tools(i).wszDescription & "|-|"
+ pStream.Write ProcessToCurdriveApp(this.Tools(i).wszCommand) & "|-|"
+ pStream.Write this.Tools(i).wszParameters & "|-|"
+ pStream.Write this.Tools(i).wszKey & "|-|"
+ pStream.Write ProcessToCurdriveApp(this.Tools(i).wszWorkingFolder) & "|-|"
+ pStream.Write this.Tools(i).IsCtrl & "|-|"
+ pStream.Write this.Tools(i).IsAlt & "|-|"
+ pStream.Write this.Tools(i).IsShift & "|-|"
+ pStream.Write this.Tools(i).IsPromptRun & "|-|"
+ pStream.Write this.Tools(i).IsMinimized & "|-|"
+ pStream.Write this.Tools(i).IsWaitFinish & "|-|"
+ pStream.Write this.Tools(i).IsDisplayMenu & "|-|"
+ pStream.WriteLine this.Tools(i).Action
+ next
+
+ pStream.WriteLine ""
+ pStream.WriteLine "[Builds]"
+ for i as long = lbound(this.Builds) to ubound(this.Builds)
+ pStream.Write "BUILD_" & right("00" & str(i), 2) & "="
+ pStream.Write this.Builds(i).id & "|-|"
+ pStream.Write this.Builds(i).wszDescription & "|-|"
+ pStream.Write this.Builds(i).wszOptions & "|-|"
+ pStream.Write this.Builds(i).IsDefault & "|-|"
+ pStream.Write this.Builds(i).Is32bit & "|-|"
+ pStream.WriteLine this.Builds(i).Is64bit
+ next
+
+
+ pStream.WriteLine ""
+ pStream.WriteLine "[MRU]"
+ for i as long = 0 To 9
+ this.MRU(i) = ProcessToCurdriveApp(this.MRU(i))
+ pStream.WriteLine "MRU_" & right("00" & str(i), 2) & "=" & this.MRU(i)
+ next
+
+ pStream.WriteLine ""
+ pStream.WriteLine "[MRUPROJECTS]"
+ for i as long = 0 To 9
+ this.MRUProject(i) = ProcessToCurdriveApp(this.MRUProject(i))
+ pStream.WriteLine "MRUPROJECT_" & right("00" & str(i), 2) & "=" & this.MRUProject(i)
+ next
+
+ dim hCtl as hwnd = GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES)
+ dim wszText as CWSTR = wstr("NOTES-START") + vbcrlf + _
+ gApp.NonProjectNotes + vbcrlf + _
+ wstr("NOTES-END") + vbcrlf
+ pStream.WriteLine ""
+ pStream.WriteLine "[Notes]"
+ pStream.WriteLine wszText
+
+ pStream.Close
+
+ function = 0
+end function
+
+
+' Save the MRU to the configuration file. Only write the MRU items
+' the ini file rather than overwriting the whole file. This enables
+' WinFBE to work better with external tools that manually modify the
+' WinFBE.ini file.
+function clsConfig.WriteMRU() as long
+ dim as CWSTR wszKeyName, wszValue
+
+ ' Delete the section name
+ dim as CWSTR wszSectionName = "MRU"
+ WritePrivateProfileString( wszSectionName, null, null, _ConfigFilename )
+
+ ' Write the new values.
+ for i as long = 0 To 9
+ this.MRU(i) = ProcessToCurdriveApp(this.MRU(i))
+ wszKeyName = "MRU_" & right("00" & str(i), 2)
+ wszValue = this.MRU(i)
+ WritePrivateProfileString(wszSectionName, wszKeyName, wszValue, _ConfigFilename)
+ next
+
+ function = 0
+end function
+
+
+' Save the MRU Projects to the configuration file. Only write the MRU items
+' the ini file rather than overwriting the whole file. This enables
+' WinFBE to work better with external tools that manually modify the
+' WinFBE.ini file.
+function clsConfig.WriteMRUProjects() as long
+ dim as CWSTR wszKeyName, wszValue
+
+ ' Delete the section name
+ dim as CWSTR wszSectionName = "MRUPROJECTS"
+ WritePrivateProfileString( wszSectionName, null, null, _ConfigFilename )
+
+ ' Write the new values.
+ for i as long = 0 To 9
+ this.MRUProject(i) = ProcessToCurdriveApp(this.MRUProject(i))
+ wszKeyName = "MRUPROJECT_" & right("00" & str(i), 2)
+ wszValue = this.MRUProject(i)
+ WritePrivateProfileString( wszSectionName, wszKeyName, wszValue, _ConfigFilename )
+ next
+
+ function = 0
+end function
+
+
+''
+'' LOAD SNIPPETS FROM DISK FILE
+''
+function clsConfig.LoadSnippets() as long
+
+ dim as CWSTR wst
+ dim as long ub
+
+ if AfxFileExists(_SnippetsFilename) = false then
+ ' The snippets file does not exist. Try copying the "default" snippets over
+ ' to the main file that the user will modify.
+ if AfxFileExists(_SnippetsDefaultFilename) then
+ if AfxCopyFile( _SnippetsDefaultFilename.sptr, _SnippetsFilename.sptr, true ) = false then
+ exit function
+ end if
+ end if
+ end if
+ if AfxFileExists(_SnippetsFilename) = false then exit function
+
+
+ dim pStream as CTextStream '(utf16)
+ if pStream.OpenUnicode(_SnippetsFilename) <> S_OK then return true ' error
+
+
+ do until pStream.EOS
+ wst = pStream.ReadLine
+
+ if len(wst) = 0 then continue do
+
+ if left(wst, 15) = "' SNIPPET START" then
+ ub = ubound(this.Snippets)
+ redim preserve this.Snippets(ub + 1)
+
+ elseif left(wst, 14) = "' DESCRIPTION=" then
+ ub = ubound(this.Snippets)
+ this.Snippets(ub).wszDescription = mid(wst, 15)
+
+ elseif left(wst, 10) = "' TRIGGER=" then
+ ub = ubound(this.Snippets)
+ this.Snippets(ub).wszTrigger = mid(wst, 11)
+
+ elseif left(wst, 7) = "' CODE=" then
+ ub = ubound(this.Snippets)
+ this.Snippets(ub).wszCode = AfxStrReplace( mid(wst, 8), "\LF", vbcrlf )
+
+ elseif left(wst, 13) = "' SNIPPET END" then
+ end if
+
+ loop
+ pStream.Close
+
+ function = 0
+end function
+
+
+''
+'' SAVE SNIPPETS TO DISK FILE
+''
+function clsConfig.SaveSnippets() as long
+
+ dim pStream as CTextStream '(utf16)
+ if pStream.Create(_SnippetsFilename, true, true) <> S_OK then return true ' error
+
+ for i as long = lbound(this.Snippets) to ubound(this.Snippets)
+ pStream.WriteLine "' SNIPPET START"
+ pStream.WriteLine "' DESCRIPTION=" & this.Snippets(i).wszDescription
+ pStream.WriteLine "' TRIGGER=" & this.Snippets(i).wszTrigger
+ pStream.WriteLine "' CODE=" & AfxStrReplace( this.Snippets(i).wszCode, vbcrlf, "\LF" )
+ pStream.WriteLine "' SNIPPET END"
+ next
+
+ pStream.Close
+
+ function = 0
+end function
+
+
+''
+'' Set default values for Explorer Categories should none exist
+''
+function clsConfig.SetCategoryDefaults() as long
+ if ubound(this.Cat) = -1 then
+ redim this.Cat(CATINDEX_NORMAL)
+
+ this.Cat(CATINDEX_FILES).idFileType = FILETYPE_UNDEFINED
+ this.Cat(CATINDEX_FILES).wszDescription = L(2, "File")
+
+ this.Cat(CATINDEX_MAIN).idFileType = FILETYPE_MAIN
+ this.Cat(CATINDEX_MAIN).wszDescription = L(212, "Main")
+
+ this.Cat(CATINDEX_RESOURCE).idFileType = FILETYPE_RESOURCE
+ this.Cat(CATINDEX_RESOURCE).wszDescription = L(213, "Resource")
+
+ this.Cat(CATINDEX_HEADER).idFileType = FILETYPE_HEADER
+ this.Cat(CATINDEX_HEADER).wszDescription = L(175, "Header")
+
+ this.Cat(CATINDEX_MODULE).idFileType = FILETYPE_MODULE
+ this.Cat(CATINDEX_MODULE).wszDescription = L(211, "Module")
+
+ this.Cat(CATINDEX_NORMAL).idFileType = FILETYPE_NORMAL
+ this.Cat(CATINDEX_NORMAL).wszDescription = L(210, "Normal")
+ end if
+
+ function = 0
+end function
+
+
+''
+'' LOAD CONFIGURATION FROM DISK FILE
+''
+function clsConfig.LoadConfigFile() as long
+
+ dim as CWSTR wst, wKey, wData, wData2
+ dim nData as long
+ dim i as long
+ dim bReadingNote as boolean
+ dim bNewConfigFile as boolean
+
+ ' Remove any existing Builds
+ ' We can not recreate the Categories each time the config reloads because the
+ ' structure contains references to existing hNodeExplorer nodes.
+ erase this.Builds
+
+ if AfxFileExists(_ConfigFilename) = 0 then
+ bNewConfigFile = true
+ else
+ dim pStream as CTextStream '(utf16)
+ if pStream.OpenUnicode(_ConfigFilename) <> S_OK then return true ' error
+
+ gApp.NonProjectNotes = ""
+
+ do until pStream.EOS
+ wst = pStream.ReadLine
+
+ if len(wst) = 0 then continue do
+ if left(wst, 1) = "'" then continue do
+ if left(wst, 1) = "[" then continue do
+
+ if left(wst, 11) = "NOTES-START" then
+ bReadingNote = true
+ continue do
+ end if
+ if left(wst, 9) = "NOTES-END" then
+ bReadingNote = false
+ continue do
+ end if
+ if bReadingNote then
+ gApp.NonProjectNotes = gApp.NonProjectNotes + wst + vbcrlf
+ continue do
+ end IF
+
+ i = instr(wst, "=")
+ if i = 0 then continue do
+
+ wKey = "": wData = "": nData = 0
+
+ wKey = left(wst, i-1)
+ wData = mid(wst.wstr, i+1)
+ nData = val(wData)
+
+
+ if left(wKey, 9) = "CATEGORY_" then ' is this a CATEGORY entry
+ i = val(right(wKey,2))
+ if i > ubound(this.Cat) then
+ redim preserve this.Cat(i)
+ this.Cat(i).idFileType = AfxStrParse(wData, 1, "|-|")
+ this.Cat(i).wszDescription = AfxStrParse(wData, 2, "|-|")
+ continue do
+ end if
+ end if
+
+
+ if left(wKey, 9) = "USERTOOL_" then ' is this a User Tool entry
+ i = val(right(wKey,2))
+ if i > ubound(this.Tools) then
+ redim preserve this.Tools(i)
+ this.Tools(i).wszDescription = AfxStrParse(wData, 1, "|-|")
+ this.Tools(i).wszCommand = ProcessFromCurdriveApp( AfxStrParse(wData, 2, "|-|") )
+ this.Tools(i).wszParameters = AfxStrParse(wData, 3, "|-|")
+ this.Tools(i).wszKey = AfxStrParse(wData, 4, "|-|")
+ this.Tools(i).wszWorkingFolder = ProcessFromCurdriveApp( AfxStrParse(wData, 5, "|-|") )
+ this.Tools(i).IsCtrl = val(AfxStrParse(wData, 6, "|-|"))
+ this.Tools(i).IsAlt = val(AfxStrParse(wData, 7, "|-|"))
+ this.Tools(i).IsShift = val(AfxStrParse(wData, 8, "|-|"))
+ this.Tools(i).IsPromptRun = val(AfxStrParse(wData, 9, "|-|"))
+ this.Tools(i).IsMinimized = val(AfxStrParse(wData, 10, "|-|"))
+ this.Tools(i).IsWaitFinish = val(AfxStrParse(wData, 11, "|-|"))
+ this.Tools(i).IsDisplayMenu = val(AfxStrParse(wData, 12, "|-|"))
+ this.Tools(i).Action = val(AfxStrParse(wData, 13, "|-|"))
+ continue do
+ end If
+ end If
+
+ if left(wKey, 6) = "BUILD_" then ' is this a BUILD entry
+ i = val(right(wKey,2))
+ if i > ubound(this.Builds) then
+ redim preserve this.Builds(i)
+ this.Builds(i).id = AfxStrParse(wData, 1, "|-|")
+ this.Builds(i).wszDescription = AfxStrParse(wData, 2, "|-|")
+ this.Builds(i).wszOptions = AfxStrParse(wData, 3, "|-|")
+ this.Builds(i).IsDefault = val(AfxStrParse(wData, 4, "|-|"))
+ this.Builds(i).Is32bit = val(AfxStrParse(wData, 5, "|-|"))
+ this.Builds(i).Is64bit = val(AfxStrParse(wData, 6, "|-|"))
+ continue do
+ end If
+ end If
+
+ if left(wKey, 4) = "MRU_" then ' is this an MRU entry
+ i = val(right(wKey,2))
+ if (i >= 0) And (i <= 9) then
+ this.MRU(i) = ProcessFromCurdriveApp(wData)
+ continue do
+ end If
+ end If
+
+ if left(wKey, 11) = "MRUPROJECT_" then ' is this an MRU Project entry
+ i = val(right(wKey,2))
+ if (i >= 0) And (i <= 9) then
+ this.MRUProject(i) = ProcessFromCurdriveApp(wData)
+ continue do
+ end If
+ end If
+
+
+ select case wKey
+ case "WinFBEversion": this.WinFBEversion = wData
+ case "AskExit": this.AskExit = nData
+ case "EnableProjectCache": this.EnableProjectCache = nData
+ case "CheckForUpdates": this.CheckForUpdates = nData
+ case "LastUpdateCheck": this.LastUpdateCheck = nData
+ case "AutoSaveFiles": this.AutoSaveFiles = nData
+ case "AutoSaveInterval": this.AutoSaveInterval = nData
+ case "RestoreSession": this.RestoreSession = nData
+ case "LastActiveSessionFile": this.wszLastActiveSession = ProcessFromCurdriveApp(wData)
+ case "MultipleInstances": this.MultipleInstances = nData
+ case "CompileAutosave": this.CompileAutosave = nData
+ case "CloseFuncList": this.CloseFuncList = nData
+ case "SyntaxHighlighting": this.SyntaxHighlighting = nData
+ case "Codetips": this.Codetips = nData
+ case "AutoComplete": this.AutoComplete = nData
+ case "CharacterAutoComplete": this.CharacterAutoComplete = nData
+ case "RightEdge": this.RightEdge = nData
+ case "RightEdgePosition": this.RightEdgePosition = wData
+ case "LeftMargin": this.LeftMargin = nData
+ case "FoldMargin": this.FoldMargin = nData
+ case "AutoIndentation": this.AutoIndentation = nData
+ case "FornextVariable": this.FornextVariable = nData
+ case "ConfineCaret": this.ConfineCaret = nData
+ case "LineNumbering": this.LineNumbering = nData
+ case "HighlightCurrentLine": this.HighlightCurrentLine = nData
+ case "IndentGuides": this.IndentGuides = nData
+ case "TabIndentSpaces": this.TabIndentSpaces = nData
+ case "PositionMiddle": this.PositionMiddle = nData
+ case "BraceHighlight": this.BraceHighlight = nData
+ case "OccurrenceHighlight": this.OccurrenceHighlight = nData
+ case "LocalizationFile": this.LocalizationFile = ProcessFromCurdriveApp(wData)
+ case "TabSize": this.TabSize = wData
+ case "UnicodeEncoding": this.UnicodeEncoding = nData
+ case "EditorFontname": this.EditorFontname = wData
+ case "EditorFontsize": this.EditorFontsize = wData
+ case "EditorFontCharSet": this.EditorFontCharSet = wData
+ case "FontExtraSpace": this.FontExtraSpace = wData
+ case "Theme": this.ThemeFilename = wData
+ case "KeywordCase": this.KeywordCase = nData
+ case "StartupLeft": this.StartupLeft = nData
+ case "StartupTop": this.StartupTop = nData
+ case "StartupRight": this.StartupRight = nData
+ case "StartupBottom": this.StartupBottom = nData
+ case "StartupMaximized": this.StartupMaximized = nData
+ case "ShowPanel": this.ShowPanel = nData
+ case "ShowPanelWidth": this.ShowPanelWidth = nData
+ case "ToolBoxLeft": this.ToolBoxLeft = nData
+ case "ToolBoxTop": this.ToolBoxTop = nData
+ case "ToolBoxRight": this.ToolBoxRight = nData
+ case "ToolBoxBottom": this.ToolBoxBottom = nData
+ case "FBWINCompiler32": this.FBWINCompiler32 = ProcessFromCurdriveApp(wData)
+ case "FBWINCompiler64": this.FBWINCompiler64 = ProcessFromCurdriveApp(wData)
+ case "WinFBXPath": this.WinFBXPath = ProcessFromCurdriveApp(wData)
+ case "CompilerBuild": this.CompilerBuild = wData
+ case "CompilerSwitches": this.CompilerSwitches = wData
+ case "CompilerHelpfile": this.CompilerHelpfile = ProcessFromCurdriveApp(wData)
+ case "WinFBXHelpfile": this.WinFBXHelpfile = ProcessFromCurdriveApp(wData)
+ case "RunViaCommandWindow": this.RunViaCommandWindow = nData
+ case "DisableCompileBeep": this.DisableCompileBeep = nData
+ end select
+
+ loop
+ pStream.Close
+ end if
+
+
+ ' Set some defaults if the config file was missing.
+ ' if no Tools exist then create some default ones...
+ if (ubound(this.Tools) = -1) and (bNewConfigFile = true) then
+ dim wszTools(4) as CWSTR
+ wszTools(0) = "ASCII Chart|-|.\Tools\asciichart32.exe|-||-|1|-||-|1|-|0|-|0|-|0|-|0|-|0|-|1|-|0"
+ wszTools(1) = "GUID Generator|-|.\Tools\GUIDgen32.exe|-||-|2|-||-|1|-|0|-|0|-|0|-|0|-|0|-|1|-|0"
+ wszTools(2) = "Registers|-|.\Tools\Registers.chm|-||-|3|-||-|1|-|0|-|0|-|0|-|0|-|0|-|1|-|0"
+ wszTools(3) = "Arch settings|-|.\Tools\ArchSettings.exe|-||-|4|-||-|1|-|0|-|0|-|0|-|0|-|0|-|1|-|0"
+ wszTools(4) = "Set compiler switches|-|.\Tools\SetCompilerSwitchesII.exe|-||-|5|-||-|1|-|0|-|0|-|0|-|0|-|0|-|1|-|0"
+ for i = lbound(wszTools) to ubound(wszTools)
+ if i > ubound(this.Tools) then
+ redim preserve this.Tools(i)
+ wData = wszTools(i)
+ this.Tools(i).wszDescription = AfxStrParse(wData, 1, "|-|")
+ this.Tools(i).wszCommand = ProcessFromCurdriveApp( AfxStrParse(wData, 2, "|-|") )
+ this.Tools(i).wszParameters = AfxStrParse(wData, 3, "|-|")
+ this.Tools(i).wszKey = AfxStrParse(wData, 4, "|-|")
+ this.Tools(i).wszWorkingFolder = ProcessFromCurdriveApp( AfxStrParse(wData, 5, "|-|") )
+ this.Tools(i).IsCtrl = val(AfxStrParse(wData, 6, "|-|"))
+ this.Tools(i).IsAlt = val(AfxStrParse(wData, 7, "|-|"))
+ this.Tools(i).IsShift = val(AfxStrParse(wData, 8, "|-|"))
+ this.Tools(i).IsPromptRun = val(AfxStrParse(wData, 9, "|-|"))
+ this.Tools(i).IsMinimized = val(AfxStrParse(wData, 10, "|-|"))
+ this.Tools(i).IsWaitFinish = val(AfxStrParse(wData, 11, "|-|"))
+ this.Tools(i).IsDisplayMenu = val(AfxStrParse(wData, 12, "|-|"))
+ this.Tools(i).Action = val(AfxStrParse(wData, 13, "|-|"))
+ end If
+ next
+ end if
+
+
+ ' Set some defaults if the config file was missing or corrupt
+ ' if no Categories exist then create some default ones...
+ ' NOTE: The default for Categories are not set here because some
+ ' category names depend on the translation from the Localization
+ ' file and that file is not loaded until the Config file is read.
+ ' We do the setting of default Categories in gConfig.SetCategoryDefaults
+ ' in WinMain after the localization is correctly loaded.
+
+
+ ' Set some defaults if the config file was missing or corrupt
+ ' if no builds exist then create some default ones... We do this
+ ' no matter if it is a bNewConfigFile or not.
+ if ubound(this.Builds) = -1 then
+ redim this.Builds(11)
+ this.Builds(0).id = AfxGuidText(AfxGuid())
+ this.Builds(0).wszDescription = "Win32 GUI (Release)"
+ this.Builds(0).wszOptions = "-s gui"
+ this.Builds(0).Is32bit = 1
+ this.Builds(0).Is64bit = 0
+
+ this.Builds(1).id = AfxGuidText(AfxGuid())
+ this.Builds(1).wszDescription = "Win32 GUI (Debug)"
+ this.Builds(1).wszOptions = "-g -exx -s gui"
+ this.Builds(1).Is32bit = 1
+ this.Builds(1).Is64bit = 0
+
+ this.Builds(2).id = AfxGuidText(AfxGuid())
+ this.Builds(2).wszDescription = "Win32 Console (Release)"
+ this.Builds(2).wszOptions = "-s console"
+ this.Builds(2).IsDefault = 1
+ this.Builds(2).Is32bit = 1
+ this.Builds(2).Is64bit = 0
+
+ this.Builds(3).id = AfxGuidText(AfxGuid())
+ this.Builds(3).wszDescription = "Win32 Console (Debug)"
+ this.Builds(3).wszOptions = "-g -exx -s console"
+ this.Builds(3).Is32bit = 1
+ this.Builds(3).Is64bit = 0
+
+ this.Builds(4).id = AfxGuidText(AfxGuid())
+ this.Builds(4).wszDescription = "Win32 Windows DLL"
+ this.Builds(4).wszOptions = "-s gui -dll -export"
+ this.Builds(4).Is32bit = 1
+ this.Builds(4).Is64bit = 0
+
+ this.Builds(5).id = AfxGuidText(AfxGuid())
+ this.Builds(5).wszDescription = "Win32 Static Library"
+ this.Builds(5).wszOptions = "-lib"
+ this.Builds(5).Is32bit = 1
+ this.Builds(5).Is64bit = 0
+
+ this.Builds(6).id = AfxGuidText(AfxGuid())
+ this.Builds(6).wszDescription = "Win64 GUI (Release)"
+ this.Builds(6).wszOptions = "-s gui"
+ this.Builds(6).Is32bit = 0
+ this.Builds(6).Is64bit = 1
+
+ this.Builds(7).id = AfxGuidText(AfxGuid())
+ this.Builds(7).wszDescription = "Win64 GUI (Debug)"
+ this.Builds(7).wszOptions = "-g -exx -s gui"
+ this.Builds(7).Is32bit = 0
+ this.Builds(7).Is64bit = 1
+
+ this.Builds(8).id = AfxGuidText(AfxGuid())
+ this.Builds(8).wszDescription = "Win64 Console (Release)"
+ this.Builds(8).wszOptions = "-s console"
+ this.Builds(8).Is32bit = 0
+ this.Builds(8).Is64bit = 1
+
+ this.Builds(9).id = AfxGuidText(AfxGuid())
+ this.Builds(9).wszDescription = "Win64 Console (Debug)"
+ this.Builds(9).wszOptions = "-g -exx -s console"
+ this.Builds(9).Is32bit = 0
+ this.Builds(9).Is64bit = 1
+
+ this.Builds(10).id = AfxGuidText(AfxGuid())
+ this.Builds(10).wszDescription = "Win64 Windows DLL"
+ this.Builds(10).wszOptions = "-s gui -dll -export"
+ this.Builds(10).Is32bit = 0
+ this.Builds(10).Is64bit = 1
+
+ this.Builds(11).id = AfxGuidText(AfxGuid())
+ this.Builds(11).wszDescription = "Win64 Static Library"
+ this.Builds(11).wszOptions = "-lib"
+ this.Builds(11).Is32bit = 0
+ this.Builds(11).Is64bit = 1
+
+ end IF
+
+ ' v3.0.0 if we are loading a config file that is pre-version 3.0.0 then we will
+ ' blank out some values in order to allow WinFBE to use the new version 3.0.0
+ ' values. The new values will eventually then be saved in a new v3 config file.
+ dim as CWSTR wszConfigVersion = AfxStrReplace(this.WinFBEversion, ".", "")
+ if val(wszConfigVersion) < 300 then
+ this.FBWINCompiler32 = ""
+ this.FBWINCompiler64 = ""
+ this.EditorFontname = ""
+ this.ThemeFilename = "winfbe_default_dark.theme"
+ this.EditorFontsize = 11
+ this.FontExtraSpace = 10
+ this.RightEdge = 0
+ this.CharacterAutoComplete = 0
+ this.OccurrenceHighlight = 0
+ end if
+
+
+
+ ' Attempt to fill in any missing compiler paths and help files
+ dim as CWSTR wszText
+ if len(this.FBWINCompiler32) = 0 then
+ wszText = AfxGetExePathName & "toolchains\" & gwszDefaultToolchain & "\fbc32.exe"
+ if AfxFileExists(wszText) then this.FBWINCompiler32 = wszText
+ end if
+ if len(this.FBWINCompiler64) = 0 then
+ wszText = AfxGetExePathName & "toolchains\" & gwszDefaultToolchain & "\fbc64.exe"
+ if AfxFileExists(wszText) then this.FBWINCompiler64 = wszText
+ end if
+ if len(this.CompilerHelpfile) = 0 then
+ wszText = AfxGetExePathName & "Help\freebasic_manual.chm"
+ if AfxFileExists(wszText) then this.CompilerHelpfile = wszText
+ end if
+
+ ' do some checks to see if the editor font exists. It is possible that the
+ ' user could be accessing WinFBE from a different computer of using it under
+ ' Wine where the previously selected font no longer exists.
+ if doFontSanityCheck() = false then
+' print "Defined font was not found. Now using this font: ", gConfig.EditorFontname
+ end if
+
+ ' Save the last write time so that it can be checked in the message loop
+ ' in order to detect external changes to it.
+ _DateFileTime = AfxGetFileLastWriteTime( _ConfigFilename )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Save current session (open files) to a diskfile
+' ========================================================================================
+function clsConfig.SaveSessionFile( byref wszSessionFile as wstring ) as boolean
+ dim as CWSTR wszText
+ dim as long nCount
+
+ dim pDoc as clsDocument ptr
+
+ dim pStream as CTextStream ' (utf16)
+ if pStream.Create( wszSessionFile, true, true ) <> S_OK then return false
+
+ pStream.WriteLine "' WINFBE SESSION FILE"
+
+ if gApp.IsProjectActive then
+ wszText = ProcessToCurdriveApp( gApp.ProjectFilename )
+ pStream.WriteLine "ProjectName=" & wszText
+ else
+ ' Save all of the loaded tabs
+ pStream.WriteLine "BuildConfig=" & this.CompilerBuild
+ pStream.WriteLine "ActiveTab=" & gTTabCtl.CurSel
+ pStream.WriteLine "CommandLine=" & gApp.wszCommandLine
+
+ nCount = gTTabCtl.GetItemCount
+
+ for i as long = 0 To nCount - 1
+ if gTTabCtl.IsSafeIndex(i) = false then continue for
+ pDoc = gTTabCtl.tabs(i).pDoc
+ ' Only deal with files that are no longer "new"
+ if pDoc->IsNewFlag = false then
+ wszText = ProcessToCurdriveApp(pDoc->DiskFilename)
+ pStream.WriteLine "File=" & wszText
+ pStream.WriteLine "FileType=" & pDoc->ProjectFileType
+ pStream.WriteLine "TabIndex=" & -1 ' use -1 rather than true
+ pStream.WriteLine "Bookmarks=" & pDoc->GetBookmarks()
+ pStream.WriteLine "FoldPoints=" & pDoc->GetFoldPoints()
+ pStream.WriteLine "IsDesigner=" & pDoc->IsDesigner
+ pStream.WriteLine "FirstLine=" & SendMessage( pDoc->hWindow(0), SCI_GETFIRSTVISIBLELINE, 0, 0)
+ pStream.WriteLine "Position=" & SendMessage( pDoc->hWindow(0), SCI_GETCURRENTPOS, 0, 0)
+ pStream.WriteLine "FirstLine1=" & SendMessage( pDoc->hWindow(1), SCI_GETFIRSTVISIBLELINE, 0, 0)
+ pStream.WriteLine "Position1=" & SendMessage( pDoc->hWindow(1), SCI_GETCURRENTPOS, 0, 0)
+ pStream.WriteLine "SplitPosition=" & pDoc->SplitY
+ pStream.WriteLine "FocusEdit=" & iif(pDoc->hWndActiveScintilla = pDoc->hWindow(0), 0, 1)
+ pStream.WriteLine "FileEnd=[-]"
+ end if
+ next
+
+ end if
+ pStream.Close
+
+ this.wszLastActiveSession = wszSessionFile
+ this.SaveConfigFile
+
+ function = true ' successful save
+end function
+
+
+' ========================================================================================
+' Load previously saved session file from a diskfile
+' ========================================================================================
+function clsConfig.LoadSessionFile( byref wszSessionFile as wstring ) as boolean
+
+ dim pDoc as clsDocument ptr
+ dim as CWSTR wst, wKey, wData, wszFilename, wszProjectName
+
+ dim sBookmarks as string
+ dim sFoldPoints as string
+ dim as long nData, i, iTab, nActiveTab, nFocusEdit
+ dim as long nFileIndex = -1
+ dim as long nFirstLine, nPosition, nFirstLine1, nPosition1, nSplitPosition
+
+ ' Info saved for each File and used to create the file once Fileend is found
+ dim as long nTabIndex
+ dim as CWSTR wszFileType
+ dim as boolean bLoadInTab
+ dim as boolean bIsDesigner
+ dim as boolean bDesignerView
+
+ dim pStream as CTextStream ' (utf16)
+ if AfxFileExists(wszSessionFile) = 0 then exit function
+ if pStream.OpenUnicode( wszSessionFile ) <> S_OK then return false
+
+ dim as HCURSOR hCurSave = GetCursor()
+ SetCursor( LoadCursor(0, IDC_WAIT) )
+
+ do until pStream.EOS
+ wst = pStream.ReadLine
+
+ if len(wst) = 0 then continue do
+ if left(wst, 1) = "'" then continue do
+ if left(wst, 1) = "[" then continue do
+
+ i = instr(wst, "=")
+ if i = 0 then continue do
+
+ wKey = left(wst, i-1)
+ wData = mid(wst, i+1)
+
+ select case ucase(wData)
+ case "TRUE": nData = true
+ case "FALSE": nData = false
+ case Else: nData = val(wData)
+ end select
+
+ wData = ProcessFromCurdriveApp(wData)
+
+ select case wKey
+ case "ProjectName"
+ wszProjectName = wData
+ if AfxFileExists(wszProjectName) then exit do
+
+ case "BuildConfig": this.CompilerBuild = wData
+ case "CommandLine": gApp.wszCommandLine = wData
+ case "ActiveTab": nActiveTab = nData
+
+ case "File": wszFilename = wData
+ case "FileType": wszFileType = wData
+
+ case "IsDesigner": bIsDesigner = nData
+ case "TabIndex": bLoadInTab = nData
+ case "Bookmarks": sBookmarks = str(wData)
+ case "FoldPoints": sFoldPoints = str(wData)
+ case "FirstLine": nFirstLine = nData
+ case "Position": nPosition = nData
+ case "FirstLine1": nFirstLine1 = nData
+ case "Position1": nPosition1 = nData
+ case "SplitPosition": nSplitPosition = nData
+ case "FocusEdit": nFocusEdit = nData
+
+ case "FileEnd":
+ if AfxFileExists(wszFilename) then
+ pDoc = frmMain_OpenFileSafely( _
+ HWND_FRMMAIN, _
+ false, _ ' bIsNewFile
+ false, _ ' bIsTemplate
+ false, _ ' bShowInTab (we'll manually add new tab below)
+ false, _ ' bIsInclude
+ wszFilename, _ ' wszName
+ 0, _ ' pDocIn
+ bIsDesigner, _ ' bIsDesigner
+ wszFileType )
+
+ iTab = gTTabCtl.AddTab( pDoc ) ' Add the new document to the top tabcontrol
+
+ ' Set the saved positions
+ pDoc->SplitY = nSplitPosition
+ if pDoc->SplitY then pDoc->bEditorIsSplit = true
+ SciExec( pDoc->hWindow(0), SCI_SETFIRSTVISIBLELINE, nFirstLine, 0)
+ SciExec( pDoc->hWindow(0), SCI_GOTOPOS, nPosition, 0)
+ SciExec( pDoc->hWindow(1), SCI_SETFIRSTVISIBLELINE, nFirstLine1, 0)
+ SciExec( pDoc->hWindow(1), SCI_GOTOPOS, nPosition1, 0)
+ pDoc->hWndActiveScintilla = pDoc->hWindow(nFocusEdit)
+ pDoc->SetBookmarks(sBookmarks)
+ pDoc->SetFoldPoints(sFoldPoints)
+ end if
+
+ end select
+
+ loop
+ pStream.Close
+
+ if AfxFileExists(wszProjectName) then
+ frmMain_OpenProjectSafely( HWND_FRMMAIN, wszProjectName )
+ return true
+ end if
+
+ ' Load all of the filenames into the Explorer listbox. Configure the node
+ ' array to allow all types of files to be shown in the listbox
+ for i as long = lbound(gConfig.Cat) to ubound(gConfig.Cat)
+ gConfig.Cat(i).bShow = true
+ next
+ LoadExplorerFiles()
+
+ ' Load all of the bookmarks into the Bookmarks listbox.
+ LoadBookmarksFiles()
+
+ ' Load all of the functions into the Function List listbox.
+ LoadFunctionsFiles()
+
+ ' Display the active editing window
+ gTTabCtl.CurSel = nActiveTab
+ gTTabCtl.DisplayScintilla( nActiveTab, true )
+ frmTopTabs_PositionWindows()
+
+ ' Highlight the selected tab file in the Explorer listbox
+ if gTTabCtl.IsSafeIndex(nActiveTab) then
+ frmExplorer_SelectItemData( gTTabCtl.tabs(nActiveTab).pDoc )
+ end if
+
+ frmMain_SetStatusbar
+ SetCursor( hCurSave )
+
+ ' Need to iterate the loaded forms that are currently visually active and
+ ' re-apply properties because loading of Image properties will fail until
+ ' all the forms are loaded in the editor.
+ dim as long nCount = gTTabCtl.GetItemCount
+ for i as long = 0 to nCount - 1
+ ' Get the document pointer and then save file to disk
+ if gTTabCtl.IsSafeIndex(i) = false then continue for
+ pDoc = gTTabCtl.tabs(i).pDoc
+ if pDoc then
+ if pDoc->IsDesigner then
+ ' Apply all control properties
+ for ii as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ dim pCtrl as clsControl ptr = pDoc->Controls.ItemAt(ii)
+ if pCtrl then ApplyControlProperties(pDoc, pCtrl)
+ next
+ end if
+ end if
+ next
+
+ this.wszLastActiveSession = wszSessionFile
+ this.SaveConfigFile
+
+ frmMain_PositionWindows
+ frmMain_SetFocusToCurrentCodeWindow
+
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ if pDoc->bEditorIsSplit then AfxRedrawWindow( HWND_FRMMAIN )
+ end if
+
+ function = true ' successful open
+end function
+
+
+' ========================================================================================
+' Save all options for the Project to a diskfile
+' ========================================================================================
+function clsConfig.ProjectSaveToFile() as boolean
+
+ dim as CWSTR cwzRelative, wszText
+ dim as long nCount
+ dim as long i
+
+ dim pDoc as clsDocument ptr
+
+ dim pStream as CTextStream ' (utf16)
+ if pStream.Create(gApp.ProjectFilename, true, true) <> S_OK then return false
+
+ pStream.WriteLine "' WINFBE PROJECT FILE"
+ pStream.WriteLine "ProjectBuild=" & gApp.ProjectBuild
+ pStream.WriteLine "ProjectOther32=" & gApp.ProjectOther32
+ pStream.WriteLine "ProjectOther64=" & gApp.ProjectOther64
+ pStream.WriteLine "ProjectCommandLine=" & gApp.ProjectCommandLine
+ pStream.WriteLine "ProjectDefaultFont=" & gApp.ProjectDefaultFont
+
+ ' Save all of the loaded tabs first
+ pStream.WriteLine "ActiveTab=" & gTTabCtl.CurSel
+
+ nCount = gTTabCtl.GetItemCount
+
+ for i = 0 To nCount - 1
+ if gTTabCtl.IsSafeIndex(i) = false then continue for
+ pDoc = gTTabCtl.tabs(i).pDoc
+ ' Only deal with files that are no longer "new"
+ if pDoc->IsNewFlag = false then
+ wszText = pDoc->DiskFilename
+ cwzRelative = AfxPathRelativePathTo( gApp.ProjectFilename, FILE_ATTRIBUTE_NORMAL, wszText, FILE_ATTRIBUTE_NORMAL)
+ if len(cwzRelative) then
+ if AfxPathIsRelative(cwzRelative) then wszText = cwzRelative
+ end if
+ wszText = ProcessToCurdriveProject(wszText)
+ pStream.WriteLine "File=" & wszText
+ pStream.WriteLine "FileType=" & pDoc->ProjectFileType
+ pStream.WriteLine "TabIndex=" & -1 ' use -1 rather than true
+ pStream.WriteLine "Bookmarks=" & pDoc->GetBookmarks()
+ pStream.WriteLine "FoldPoints=" & pDoc->GetFoldPoints()
+ pStream.WriteLine "IsDesigner=" & pDoc->IsDesigner
+ pStream.WriteLine "FirstLine=" & SendMessage( pDoc->hWindow(0), SCI_GETFIRSTVISIBLELINE, 0, 0)
+ pStream.WriteLine "Position=" & SendMessage( pDoc->hWindow(0), SCI_GETCURRENTPOS, 0, 0)
+ pStream.WriteLine "FirstLine1=" & SendMessage( pDoc->hWindow(1), SCI_GETFIRSTVISIBLELINE, 0, 0)
+ pStream.WriteLine "Position1=" & SendMessage( pDoc->hWindow(1), SCI_GETCURRENTPOS, 0, 0)
+ pStream.WriteLine "SplitPosition=" & pDoc->SplitY
+ pStream.WriteLine "FocusEdit=" & iif(pDoc->hWndActiveScintilla = pDoc->hWindow(0), 0, 1)
+ pStream.WriteLine "FileEnd=[-]"
+ end if
+ next
+
+ ' Save all other non-displayed documents for the project
+
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ ' Only deal with files that are no longer "new"
+ if pDoc->IsNewFlag = false then
+ if gTTabCtl.GetTabIndexByDocumentPtr(pDoc) = -1 then
+ wszText = pDoc->DiskFilename
+ cwzRelative = AfxPathRelativePathTo( gApp.ProjectFilename, FILE_ATTRIBUTE_NORMAL, wszText, FILE_ATTRIBUTE_NORMAL)
+ if AfxPathIsRelative(cwzRelative) then wszText = cwzRelative
+ wszText = ProcessToCurdriveProject(wszText)
+ pStream.WriteLine "File=" & wszText
+ pStream.WriteLine "FileType=" & pDoc->ProjectFileType
+ pStream.WriteLine "TabIndex=" & 0
+ pStream.WriteLine "Bookmarks=" & pDoc->GetBookmarks()
+ pStream.WriteLine "FoldPoints=" & pDoc->GetFoldPoints()
+ pStream.WriteLine "IsDesigner=" & pDoc->IsDesigner
+ pStream.WriteLine "FirstLine=" & SendMessage( pDoc->hWindow(0), SCI_GETFIRSTVISIBLELINE, 0, 0)
+ pStream.WriteLine "Position=" & SendMessage( pDoc->hWindow(0), SCI_GETCURRENTPOS, 0, 0)
+ pStream.WriteLine "FirstLine1=" & SendMessage( pDoc->hWindow(1), SCI_GETFIRSTVISIBLELINE, 0, 0)
+ pStream.WriteLine "Position1=" & SendMessage( pDoc->hWindow(1), SCI_GETCURRENTPOS, 0, 0)
+ pStream.WriteLine "SplitPosition=" & pDoc->SplitY
+ pStream.WriteLine "FocusEdit=" & iif(pDoc->hWndActiveScintilla = pDoc->hWindow(0), 0, 1)
+ pStream.WriteLine "FileEnd=[-]"
+ end If
+ end if
+ pDoc = pDoc->pDocnext
+ loop
+
+ ' if project is active then save NOTES to config file.
+ if gApp.IsProjectActive then
+ dim wszText as CWSTR = wstr("NOTES-START") + vbcrlf + _
+ gApp.ProjectNotes + vbcrlf + _
+ wstr("NOTES-END") + vbcrlf
+ pStream.WriteLine ""
+ pStream.WriteLine "[Notes]"
+ pStream.WriteLine wszText
+ end IF
+
+ pStream.Close
+
+ function = true ' successful save
+end function
+
+
+' ========================================================================================
+' Load all options for the Project from a diskfile
+' ========================================================================================
+function clsConfig.ProjectLoadFromFile( byval wszFile as CWSTR ) as boolean
+
+ dim pDoc as clsDocument ptr
+ dim as CWSTR wst, wKey, wData, wszFilename
+
+ dim sBookmarks as string
+ dim sFoldPoints as string
+ dim as long nData, i, iTab, nActiveTab, nFocusEdit
+ dim as long nFileIndex = -1
+ dim as long nFirstLine, nPosition, nFirstLine1, nPosition1, nSplitPosition
+
+ ' Info saved for each File and used to create the file once Fileend is found
+ dim as long nTabIndex
+ dim as CWSTR wszFileType
+ dim as boolean bLoadInTab
+ dim as boolean bReadingNote
+ dim as boolean bIsDesigner
+ dim as boolean bDesignerView
+
+ if AfxFileExists(wszFile) = 0 then exit function
+
+ dim as HCURSOR hCurSave = GetCursor()
+ SetCursor( LoadCursor(0, IDC_WAIT) )
+
+ gApp.ProjectFilename = wszFile
+ gApp.ProjectName = AfxStrPathname( "NAMEX", gApp.ProjectFilename )
+ gApp.ProjectNotes = ""
+
+ ' As of version 3.02 we no longer use the Project Fast Cache feature so
+ ' delete any old cache disk file that will just now be taking up space.
+ dim as CWSTR ProjectCacheFilename = _
+ AfxStrPathname("PATH", gApp.ProjectFilename) & _
+ AfxStrPathname("NAME", gApp.ProjectFilename) & _
+ "_db_data.ini"
+ AfxDeleteFile( ProjectCacheFilename )
+
+
+ dim pStream as CTextStream ' (utf16)
+ if pStream.OpenUnicode(gApp.ProjectFilename) <> S_OK then return false
+
+ ' Variable length array to hold sequence of all project files
+ dim docData(any) as PROJECT_FILELOAD_DATA
+
+ gApp.IsProjectLoading = true
+
+ gApp.FileLoadingCount = 0
+
+ do until pStream.EOS
+ wst = pStream.ReadLine
+
+ if len(wst) = 0 then continue do
+ if left(wst, 1) = "'" then continue do
+ if left(wst, 1) = "[" then continue do
+
+ if left(wst, 11) = "NOTES-START" then
+ bReadingNote = true
+ continue do
+ end if
+ if left(wst, 9) = "NOTES-END" then
+ bReadingNote = false
+ continue do
+ end if
+ if bReadingNote then
+ gApp.ProjectNotes = gApp.ProjectNotes + wst + vbcrlf
+ continue do
+ end IF
+
+ i = instr(wst, "=")
+ if i = 0 then continue do
+
+ wKey = left(wst, i-1)
+ wData = mid(wst, i+1)
+
+ select case ucase(wData)
+ case "TRUE": nData = true
+ case "FALSE": nData = false
+ case Else: nData = val(wData)
+ end select
+
+ wData = ProcessFromCurdriveProject(wData)
+
+ select case wKey
+ case "ProjectBuild": gApp.ProjectBuild = wData
+ case "ProjectOther32": gApp.ProjectOther32 = wData
+ case "ProjectOther64": gApp.ProjectOther64 = wData
+ case "ProjectCommandLine": gApp.ProjectCommandLine = wData
+ case "ProjectDefaultFont": gApp.ProjectDefaultFont = wData
+ case "ActiveTab": nActiveTab = nData
+ case "File": wszFilename = wData
+ case "FileType": wszFileType = wData
+ case "Bookmarks": sBookmarks = str(wData)
+ case "FoldPoints": sFoldPoints = str(wData)
+ case "IsDesigner": bIsDesigner = nData
+ case "TabIndex": bLoadInTab = nData
+ case "FirstLine": nFirstLine = nData
+ case "Position": nPosition = nData
+ case "FirstLine1": nFirstLine1 = nData
+ case "Position1": nPosition1 = nData
+ case "SplitPosition": nSplitPosition = nData
+ case "FocusEdit": nFocusEdit = nData
+
+ case "FileEnd":
+ ' if this is a relative filename then convert it back.
+ if AfxPathIsRelative(wszFilename) then
+ wszFilename = AfxPathCombine( AfxStrPathName("PATH", gApp.ProjectFilename), wszFilename)
+ end if
+ if AfxFileExists(wszFilename) then
+
+ wszFilename = OnCommand_FileAutoSaveFileCheck( wszFilename )
+
+ nFileIndex = nFileIndex + 1
+ if nFileIndex > ubound(docData) then
+ redim preserve docData( ubound(docData) + 100 )
+ end If
+
+ with docData(nFileIndex)
+ .wszFilename = wszFilename
+ .wszFileType = wszFileType
+ .bLoadInTab = bLoadInTab
+ .wszBookmarks = sBookmarks
+ .wszFoldPoints = sFoldPoints
+ .IsDesigner = bIsDesigner
+ .nFirstLine = nFirstLine
+ .nPosition = nPosition
+ .nFirstLine1 = nFirstLine1
+ .nPosition1 = nPosition1
+ .nSplitPosition = nSplitPosition
+ .nFocusEdit = nFocusEdit
+ end with
+
+ nFirstLine = 0: nPosition = 0
+ nFirstLine1 = 0: nPosition1 = 0
+ nFocusEdit = 0: nSplitPosition = 0
+ sBookmarks = ""
+ sFoldPoints = ""
+ bLoadInTab = false
+ bIsDesigner = false
+ bDesignerView = false
+ end if
+
+ end select
+
+ loop
+ pStream.Close
+
+
+ ' Load/Display all of the project files
+ for i as long = lbound(docData) to ubound(docData)
+
+ if AfxFileExists( docData(i).wszFilename ) = false then continue for
+
+ gApp.FileLoadingCount = gApp.FileLoadingCount + 1
+ gApp.wszPanelText = docData(i).wszFilename
+ frmMain_SetStatusbar
+
+ pDoc = frmMain_OpenFileSafely( _
+ HWND_FRMMAIN, _
+ false, _ ' bIsNewFile
+ false, _ ' bIsTemplate
+ false, _ ' bShowInTab (we'll manually add new tab below)
+ false, _ ' bIsInclude
+ docData(i).wszFilename, _ ' wszName
+ 0, _ ' pDocIn
+ docData(i).IsDesigner, _ ' bIsDesigner
+ docData(i).wszFileType )
+
+ if docData(i).bLoadInTab then
+ iTab = gTTabCtl.AddTab( pDoc ) ' Add the new document to the top tabcontrol
+ end if
+
+ ' Set the saved positions
+ pDoc->SplitY = docData(i).nSplitPosition
+ if pDoc->SplitY then pDoc->bEditorIsSplit = true
+ SciExec( pDoc->hWindow(0), SCI_SETFIRSTVISIBLELINE, docData(i).nFirstLine, 0)
+ SciExec( pDoc->hWindow(0), SCI_GOTOPOS, docData(i).nPosition, 0)
+ SciExec( pDoc->hWindow(1), SCI_SETFIRSTVISIBLELINE, docData(i).nFirstLine1, 0)
+ SciExec( pDoc->hWindow(1), SCI_GOTOPOS, docData(i).nPosition1, 0)
+ pDoc->hWndActiveScintilla = pDoc->hWindow(docData(i).nFocusEdit)
+ pDoc->SetBookmarks(docData(i).wszBookmarks)
+ pDoc->SetFoldPoints(docData(i).wszFoldPoints)
+ next
+
+ gApp.IsProjectLoading = false
+ gApp.IsProjectActive = true
+ gApp.wszPanelText = "" ' reset filename parsing text that displays in StatusBar panel
+ gApp.hIconPanel = 0
+ gApp.wszLastOpenFolder = ""
+
+ ' Load all of the filenames into the Explorer listbox. Configure the node
+ ' array to allow all types of files to be shown in the listbox
+ for i as long = lbound(gConfig.Cat) to ubound(gConfig.Cat)
+ gConfig.Cat(i).bShow = true
+ next
+
+ LoadExplorerFiles()
+
+ ' Load all of the bookmarks into the Bookmarks listbox.
+ LoadBookmarksFiles()
+
+ ' Load all of the functions into the Function List listbox.
+ LoadFunctionsFiles()
+
+ ' Display the active editing window
+ if gTTabCtl.IsSafeIndex(nActiveTab) = false then
+ ' active tab as stored in the config file is not valid. Could be that the
+ ' filename no longer exists of trouble loading that particular project file.
+ ' Try to use an alternate tab number
+ nActiveTab = gTTabCtl.GetItemCount - 1
+ end if
+ gTTabCtl.SetFocusTab(nActiveTab)
+
+ ' if no active build configuration then assign the currently active selection
+ if gApp.ProjectBuild = "" then
+ gApp.ProjectBuild = frmBuildConfig_GetSelectedBuildGUID()
+ end if
+
+ frmMain_SetStatusbar
+ SetCursor( hCurSave )
+
+ ' Show the correct notes and TODO data for this project
+ frmOutput_ShowNotes
+ frmOutput_UpdateToDoListview
+
+ ' Need to iterate the loaded forms that are currently visually active and
+ ' re-apply properties because loading of Image properties will fail until
+ ' all the forms are loaded in the editor.
+ dim as long nCount = gTTabCtl.GetItemCount
+ for i as long = 0 to nCount - 1
+ ' Get the document pointer and then save file to disk
+ if gTTabCtl.IsSafeIndex(i) = false then continue for
+ pDoc = gTTabCtl.tabs(i).pDoc
+ if pDoc then
+ if pDoc->IsDesigner then
+ ' Apply all control properties
+ for ii as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ dim pCtrl as clsControl ptr = pDoc->Controls.ItemAt(ii)
+ if pCtrl then
+ ApplyControlProperties(pDoc, pCtrl)
+ end if
+ next
+ end if
+ end if
+ next
+
+ frmMain_PositionWindows
+ frmMain_SetFocusToCurrentCodeWindow
+
+ function = true ' successful open
+end function
+
+
+' ========================================================================================
+' Reload the config file should it have been changed by an external program.
+' ========================================================================================
+function clsConfig.ReloadConfigFileTest() as boolean
+
+ if gApp.IsShutdown = true then return false
+
+ dim as FILETIME ft
+
+ ' Compare the disk file date time to the value currently stored in static variable.
+ ft = AfxGetFileLastWriteTime(_ConfigFilename)
+ if AfxFileTimeToVariantTime(ft) <> AfxFileTimeToVariantTime(_DateFileTime) then
+ gConfig.LoadConfigFile() ' this function also updates the _DateFileTime value
+ ' Apply the newly saved options to all open Scintilla windows
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ pDoc->ApplyProperties
+ pDoc = pDoc->pDocnext
+ loop
+ end if
+
+ function = 0
+end function
diff --git a/src/clsControl.bi b/src/clsControl.bi
index 58f9d765..7c57f11a 100644
--- a/src/clsControl.bi
+++ b/src/clsControl.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsControl.bi.bak b/src/clsControl.bi.bak
new file mode 100644
index 00000000..58f9d765
--- /dev/null
+++ b/src/clsControl.bi.bak
@@ -0,0 +1,66 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+enum PropertyType
+ EditEnter = 1
+ EditEnterNumericOnly
+ TrueFalse
+ ComboPicker
+ ColorPicker
+ FontPicker
+ ImagePicker
+ CustomDialog
+ AnchorPicker
+end enum
+
+type clsEvent
+ private:
+ public:
+ wszEventName as CWSTR ' Used for Get/Set of event value
+ bIsSelected as boolean ' User has selected this event to include into code
+end type
+
+type clsProperty
+ private:
+ public:
+ wszPropName as CWSTR ' Used for Get/Set of property value
+ wszPropValuePrev as CWSTR ' Previous property value (so that ApplyProperties will only act on changed properties)
+ wszPropValue as CWSTR
+ wszPropDefault as CWSTR
+ PropType as PropertyType
+end type
+
+type clsControl
+ private:
+
+ public:
+ hWindow as hwnd
+ ControlType as long
+ AfxButtonPtr as CXPButton ptr ' we use XPButton rather than the built in Windows button
+ AfxMaskedPtr as CMaskedEdit ptr
+ AfxPicturePtr as CImageCtx ptr
+ IsSelected as boolean
+ IsActive as boolean
+ SuspendLayout as boolean ' prevent layout properties from being acted on individually (instead treat as a group)
+ rcHandles(1 to 8) as RECT ' 8 grab handles
+ Properties(any) as clsProperty
+ Events(any) as clsEvent
+ hBackBrush as HBRUSH ' needed for STATIC/LABEL controls (destroyed in destructor)
+ hImageList as HANDLE ' needed for TabControl
+ declare destructor
+end type
+
+
diff --git a/src/clsControl.inc b/src/clsControl.inc
index 80dd9ba5..530b12b9 100644
--- a/src/clsControl.inc
+++ b/src/clsControl.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsControl.inc.bak b/src/clsControl.inc.bak
new file mode 100644
index 00000000..80dd9ba5
--- /dev/null
+++ b/src/clsControl.inc.bak
@@ -0,0 +1,20 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "clsControl.bi"
+
+destructor clsControl
+ if this.hBackBrush then DeleteBrush(this.hBackBrush)
+ if this.hImageList then ImageList_Destroy(this.hImageList)
+end destructor
+
diff --git a/src/clsDB2.bi b/src/clsDB2.bi
index fa5d2ed8..d52975e3 100644
--- a/src/clsDB2.bi
+++ b/src/clsDB2.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsDB2.bi.bak b/src/clsDB2.bi.bak
new file mode 100644
index 00000000..fa5d2ed8
--- /dev/null
+++ b/src/clsDB2.bi.bak
@@ -0,0 +1,78 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#include once "modParser.bi"
+
+''
+'' Application in-memory database
+''
+const DB2_VARIABLE = 1
+const DB2_FUNCTION = 2 ' Standalone and type functions
+const DB2_TYPE = 3
+const DB2_TODO = 4
+const DB2_STANDARDDATATYPE = 5 ' long, integer, string, etc...
+
+const DB2_FILETYPE_FB = 100
+const DB2_FILETYPE_WINAPI = 101
+const DB2_FILETYPE_WINFORMSX = 102
+const DB2_FILETYPE_WINFBX = 103
+const DB2_FILETYPE_USERCODE = 200
+
+' Do not adjust sizes of this type definition because it is saved
+' and reloaded from disk (codetip cache database).
+type DB2_DATA
+ deleted as boolean = true ' True/False
+ pDoc as clsDocument ptr ' Code Document
+ nFiletype as integer ' See list of DB2_FILETYPE above
+ fileName as wstring * MAX_PATH ' Filename of source file (needed for deleting).
+ id as integer ' See DB_* above for what type of record this is.
+ nLineStart as integer ' Location in the file where starts
+ nLineEnd as integer ' Location in the file where ends
+ ParentName as zstring * 75 ' Function name / TYPE Name (blank if global)
+ ElementName as zstring * 75 ' Function name / Variable Name / TYPE Name
+ ElementData as zstring * MAX_PATH ' Generic text data related to ElementName (todo text, etc)
+ CallTip as zstring * MAX_PATH ' Function Calltip associated with ElementName variable
+ Variabletype as zstring * 75 ' The type of variable this is. Could be a TYPE name.
+ TypeExtends as zstring * 75 ' The type is extended from this TYPE
+ VariableScope as DIMSCOPE ' Element is public in a type (default)
+ GetSet as zstring * 75 ' (get) (set)
+end type
+
+type clsDB2
+ private:
+ m_arrData(any) as DB2_DATA
+ m_index as integer
+
+ public:
+ declare function dbGetFreeSlot() as integer
+ declare function dbAdd( byval parser as ctxParser ptr, byval id as integer) as DB2_DATA ptr
+ declare function dbDelete( byref wszFilename as wstring ) as integer
+ declare function dbDeleteAll() as boolean
+ declare function dbDeleteByDocumentPtr( byval pDoc as clsDocument ptr ) as boolean
+ declare function dbDeleteByFileType( byval nFiletype as integer ) as boolean
+ declare function dbRewind() as integer
+ declare function dbGetNext() as DB2_DATA ptr
+ declare function dbSeek( byval sParentName as string, byval sLookFor as string, byval Action as integer, byval sFilename as string = "" ) as DB2_DATA ptr
+ declare function dbFindFunction( byref sFunctionName as string, byref sFilename as string = "" ) as DB2_DATA ptr
+ declare function dbFindFunctionTYPE( byref sTypeName as string, byref sFunctionName as string ) as DB2_DATA ptr
+ declare function dbFindVariable( byref sParentName as string, byref sVariableName as string ) as DB2_DATA ptr
+ declare function dbFindTYPE( byref sTypeName as string ) as DB2_DATA ptr
+ declare function dbWriteDB2( byref wszFilename as wstring ) as integer
+ declare function dbReadDB2( byref wszFilename as wstring ) as integer
+ declare function dbDebug() as integer
+
+ declare constructor
+end type
+
diff --git a/src/clsDB2.inc b/src/clsDB2.inc
index f1c7344f..76e73769 100644
--- a/src/clsDB2.inc
+++ b/src/clsDB2.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsDB2.inc.bak b/src/clsDB2.inc.bak
new file mode 100644
index 00000000..f1c7344f
--- /dev/null
+++ b/src/clsDB2.inc.bak
@@ -0,0 +1,362 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+''
+'' Application in-memory database
+''
+
+#include once "clsDB2.bi"
+#include once "modParser.bi"
+
+
+''
+''
+constructor clsDB2
+ redim m_arrData(500) as DB2_DATA
+
+ ' Add the standard builtin data types
+ dim parser as ctxParser
+ parser.objectStartLine = -1
+ parser.objectEndLine = -1
+
+ dim as CWSTR wszMainStr = _
+ "boolean|byte|ubyte|short|ushort|integer|uinteger|long|ulong|longint|ulongint|single|" & _
+ "double|string|wstring|zstring|true|false|CWSTR"
+
+ dim as integer nCount = AfxStrParseCount(wszMainStr, "|")
+
+ for i as integer = 1 to nCount
+ parser.varName = AfxStrParse(wszMainStr, i, "|")
+ parser.varType = parser.varName
+ this.dbAdd( @parser, DB2_STANDARDDATATYPE )
+ next
+ this.dbRewind
+end constructor
+
+
+''
+''
+function clsDB2.dbGetFreeSlot() as integer
+
+ dim as integer nSlot = -1
+
+ ' Find a slot to put the data in
+ for i as integer = lbound(m_arrData) to ubound(m_arrData)
+ if m_arrData(i).deleted then
+ nSlot = i: exit for
+ end if
+ next
+
+ ' If no slot found then resize the array to make room
+ if nSlot = -1 then
+ nSlot = ubound(m_arrData) + 1
+ redim preserve m_arrData( nSlot + 10000 ) as DB2_DATA
+ end if
+
+ function = nSlot
+end function
+
+
+''
+''
+function clsDB2.dbAdd( _
+ byval parser as ctxParser ptr, _
+ byval id as integer _
+ ) as DB2_DATA ptr
+
+ if parser = 0 then exit function
+
+ dim db as DB2_DATA
+
+ with db
+ .deleted = false
+ .id = id ' the type of database record that we are storing
+ .pDoc = parser->pDoc
+ if parser->pDoc then .fileName = parser->pDoc->DiskFilename
+ .nFileType = parser->nFileType
+
+ select CASE id
+ case DB2_STANDARDDATATYPE
+ .ElementName = parser->varName
+ .VariableType = parser->varType
+ if .ElementName = "" then exit function
+
+ case DB2_TYPE ' this handles ENUM also
+ ' If the type has already been added skip adding it again.
+ if this.dbFindTYPE( parser->typeName) then return 0
+ .nLineStart = parser->objectStartLine
+ .nLineEnd = parser->objectEndLine
+ .ElementName = parser->typeName
+ .VariableType = parser->typeAlias ' same as typeName unless it was an ALIAS (always search using this name)
+ .TypeExtends = parser->TypeExtends
+ if .ElementName = "" then exit function
+
+ case DB2_TODO
+ .ElementName = ""
+ .ElementData = parser->fullLine
+ .nLineStart = parser->objectStartLine + 1 ' display in listview
+ .nLineEnd = parser->objectEndLine + 1 ' display in listview
+
+ case DB2_FUNCTION
+ .nLineStart = parser->objectStartLine
+ .nLineEnd = parser->objectEndLine
+ .ElementName = parser->functionName
+ .ParentName = parser->typeName
+ .CallTip = parser->functionParams ' Calltip
+ .GetSet = parser->GetSet
+ if .ElementName = "" then exit function
+
+ case DB2_VARIABLE
+ .nLineStart = parser->objectStartLine
+ .nLineEnd = parser->objectEndLine
+ .ParentName = parser->functionName
+ .ElementName = parser->varName
+ .VariableType = parser->varType
+ .VariableScope = parser->varScope
+ if .ElementName = "" then exit function
+
+ end select
+
+ end with
+
+ dim as integer nSlot = this.dbGetFreeSlot()
+ m_arrData(nSlot) = db
+
+ function = @m_arrData(nSlot)
+end function
+
+
+''
+''
+function clsDB2.dbDelete( byref wszFilename as wstring ) as integer
+ dim nCount as integer
+ dim as CWSTR wszFile = ucase(wszFilename)
+ for i as integer = lbound(m_arrData) to ubound(m_arrData)
+ if m_arrData(i).deleted = true then continue for
+ if ucase(m_arrData(i).fileName) = wszFile then
+ m_arrData(i).deleted = true
+ nCount = nCount + 1
+ end if
+ next
+ function = nCount
+end function
+
+''
+''
+function clsDB2.dbDeleteAll() as boolean
+ for i as integer = lbound(m_arrData) to ubound(m_arrData)
+ m_arrData(i).deleted = true
+ function = true
+ next
+end function
+
+''
+''
+function clsDB2.dbDeleteByDocumentPtr( byval pDoc as clsDocument ptr ) as boolean
+ ' Delete database entry based on incoming clsDocument pointer
+ for i as integer = lbound(m_arrData) to ubound(m_arrData)
+ if m_arrData(i).pDoc = pDoc then
+ m_arrData(i).deleted = true
+ end if
+ function = true
+ next
+end function
+
+''
+''
+function clsDB2.dbDeleteByFileType( byval nFileType as integer ) as boolean
+ ' Delete database entry based on incoming DB2_FILETYPE_* value
+ for i as integer = lbound(m_arrData) to ubound(m_arrData)
+ if m_arrData(i).nFileType = nFileType then
+ m_arrData(i).deleted = true
+ end if
+ function = true
+ next
+end function
+
+''
+''
+function clsDB2.dbRewind() as integer
+ ' Set index pointer to immediately before first array index
+ m_index = lbound(m_arrData) - 1
+ function = 0
+END FUNCTION
+
+''
+''
+function clsDB2.dbGetnext() as DB2_DATA ptr
+ ' Set index pointer to next array index that is not deleted
+ dim as integer ub = ubound(m_arrData)
+ do
+ m_index = m_index + 1
+ if m_index > ub then return 0
+ if m_arrData(m_index).deleted then
+ continue do
+ else
+ exit do
+ end if
+ loop
+ function = @m_arrData(m_index)
+END FUNCTION
+
+
+''
+''
+function clsDB2.dbSeek( _
+ byval sParentName as string, _
+ byval sLookFor as string, _
+ byval Action as integer, _
+ byval sFilename as string = "" _
+ ) as DB2_DATA ptr
+
+ ' GENERIC SEEK FUNCTION THAT OTHER FUNCTIONS CALL TO DO THE HARD WORK
+ ' Find the array element that contains the function name beng searched for
+ dim pData as DB2_DATA ptr
+
+ sParentName = ucase(sParentName)
+ sLookFor = ucase(sLookFor)
+
+ this.dbRewind()
+ do
+ pData = this.dbGetnext()
+ if pData = 0 then exit do
+ if pData->deleted = true then continue do
+ if pData->id = Action then
+
+ if ( sLookFor = ucase(pData->ElementName) ) andalso _
+ ( sParentName = ucase(pData->ParentName) ) then
+
+ if len(sFilename) then
+ if ucase(pData->fileName) = ucase(sFilename) then
+ return pData
+ end if
+ else
+ return pData
+ end if
+
+ end if
+ end if
+
+ loop
+
+ function = 0
+end function
+
+
+''
+''
+function clsDB2.dbFindFunction( byref sFunctionName as string, byref sFilename as string = "") as DB2_DATA ptr
+ return this.dbSeek( "", sFunctionName, DB2_FUNCTION, sFilename )
+end function
+
+''
+''
+function clsDB2.dbFindFunctionTYPE( byref sTypeName as string, byref sFunctionName as string) as DB2_DATA ptr
+ return this.dbSeek( sTypeName, sFunctionName, DB2_FUNCTION )
+end function
+
+''
+''
+function clsDB2.dbFindVariable( byref sParentName as string, byref sVariableName as string ) as DB2_DATA ptr
+ return this.dbSeek( sParentName, sVariableName, DB2_VARIABLE )
+end function
+
+
+''
+''
+function clsDB2.dbFindTYPE( byref sTypeName as string ) as DB2_DATA ptr
+ dim pData as DB2_DATA ptr
+ pData = this.dbSeek("", sTypeName, DB2_TYPE)
+ if pData = 0 then return 0
+ ' If this Type is an ALIAS for another Type then get that real type
+ if ucase(pData->ElementName) <> ucase(pData->VariableType) then
+ return this.dbSeek("", pData->VariableType, DB2_TYPE)
+ end if
+ return pData
+end function
+
+
+''
+''
+function clsDB2.dbDebug() as integer
+ dim pStream as CTextStream
+ pStream.Create("_debug.txt")
+
+ dim as CWSTR wszTitle
+ dim as integer dataType
+
+ dim pData as DB2_DATA ptr
+
+ ' PRINT ALL TYPES
+ for i as integer = 1 to 3
+ select case i
+ case 1
+ wszTitle = "CLASSES/TYPES"
+ dataType = DB2_TYPE
+ case 2
+ wszTitle = "FUNCTIONS"
+ dataType = DB2_FUNCTION
+ case 3
+ wszTitle = "VARIABLES"
+ dataType = DB2_VARIABLE
+ end select
+
+ pStream.WriteLine wszTitle
+ this.dbRewind()
+ do
+ pData = this.dbGetnext
+ if pData = 0 then exit do
+ if pData->id <> dataType then continue do
+ 'if len(pData->fileName) = 0 then continue do ' bypass any predefined data
+
+ dim as CWSTR wszFileType
+ select case pData->nFileType
+ case DB2_FILETYPE_FB: wszFileType = "DB2_FILETYPE_FB"
+ case DB2_FILETYPE_WINAPI: wszFileType = "DB2_FILETYPE_WINAPI"
+ case DB2_FILETYPE_WINFORMSX: wszFileType = "DB2_FILETYPE_WINFORMSX"
+ case DB2_FILETYPE_WINFBX: wszFileType = "DB2_FILETYPE_WINFBX"
+ case DB2_FILETYPE_USERCODE: wszFileType = "DB2_FILETYPE_USERCODE"
+ end select
+
+ pStream.WriteLine " " & wszTitle
+ pStream.WriteLine " deleted: " & pData->deleted
+ pStream.WriteLine " fileName: " & pData->fileName
+
+ pStream.WriteLine " nFileType: " & wszFileType
+ pStream.WriteLine " ParentName: " & pData->ParentName
+ pStream.WriteLine " ElementName: " & pData->ElementName
+ pStream.WriteLine " TypeExtends: " & pData->TypeExtends
+ pStream.WriteLine " VariableType:" & pData->VariableType
+ pStream.WriteLine " CallTip: " & pData->CallTip
+ pStream.WriteLine " lineStart: " & pData->nLineStart
+ pStream.WriteLine " lineEnd: " & pData->nLineEnd
+ pStream.WriteLine " Get/Set/ctor/dtor: " & pData->GetSet
+' pStream.WriteLine " Scope: " & pData->varScope
+ pStream.WriteLine ""
+ loop
+ pStream.WriteLine ""
+ pStream.WriteLine ""
+ pStream.WriteLine ""
+
+ next
+ pStream.WriteLine ""
+
+ pStream.Close
+ function = 0
+end function
+
+
+dim shared gdb2 as clsDB2
+
+
diff --git a/src/clsDocument.bi b/src/clsDocument.bi
index 3ea22244..0b9a911d 100644
--- a/src/clsDocument.bi
+++ b/src/clsDocument.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General public License as published by
diff --git a/src/clsDocument.bi.bak b/src/clsDocument.bi.bak
new file mode 100644
index 00000000..3ea22244
--- /dev/null
+++ b/src/clsDocument.bi.bak
@@ -0,0 +1,242 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General public License for more details.
+
+#pragma once
+
+' Scintilla Control identifiers
+#define IDC_SCINTILLA 100
+
+' File encodings
+#define FILE_ENCODING_ANSI 0
+#define FILE_ENCODING_UTF8_BOM 1
+#define FILE_ENCODING_UTF16_BOM 2
+
+#define FILETYPE_UNDEFINED "0"
+#define FILETYPE_MAIN "1"
+#define FILETYPE_MODULE "2"
+#define FILETYPE_NORMAL "3"
+#define FILETYPE_RESOURCE "4"
+#define FILETYPE_HEADER "5"
+
+
+#include once "clsMenuItem.bi"
+#include once "clsToolBarItem.bi"
+#include once "clsPanelItem.bi"
+#include once "clsControl.bi" ' Includes properties and events types
+#include once "clsCollection.bi"
+
+' Structure that holds all of the user embedded compiler directives
+' in the source code. Currently, only the main source file is searched
+' for the '#CONSOLE ON|OFF directive but others can be added as needed.
+type COMPILE_DIRECTIVES
+ DirectiveFlag as long ' IDM_GUI, IDM_CONSOLE, IDM_RESOURCE
+ DirectiveText as string ' reource filename
+end type
+
+' Forward references
+type clsDocument_ as clsDocument
+
+' Structure that holds all Images found for an individual file.
+type IMAGES_TYPE
+ wszImageName as CWSTR ' Based on filename. IMAGE_OPEN, IMAGE_CLOSE, etc
+ wszFileName as CWSTR
+ wszFormat as CWSTR ' BITMAP, ICON, RCDATA, CURSOR
+ pDoc as clsDocument_ ptr ' backpointer to pDoc in case search on wszImageName performed.
+end type
+
+' Enum used to distinguish bewteen a sub/function and Property Get/Set
+enum ClassProperty
+ None = 0 ' sub/function
+ Getter = 1
+ Setter = 2
+ ctor = 3 ' constructor
+ dtor = 4 ' destructor
+end enum
+
+' type that holds data for all project files as it they are loaded from
+' the project file.
+type PROJECT_FILELOAD_DATA
+ wszFilename as CWSTR ' full path and filename
+ wszFiletype as CWSTR ' pDoc->ProjectFileType
+ bLoadInTab as boolean
+ wszBookmarks as CWSTR ' pDoc->GetBookmarks()
+ wszFoldPoints as CWSTR ' pDoc->GetFoldPoints()
+ IsDesigner as boolean
+ IsDesignerView as long
+ nFirstLine as long ' first line of main view
+ nPosition as long ' current position of main view
+ nFirstLine1 as long ' first line of second view
+ nPosition1 as long ' current position of second view
+ nSplitPosition as long ' pDoc->SplitY
+ nFocusEdit as long ' View 0 or View 1
+end type
+
+
+type clsDocument
+ private:
+ ' 2 Scintilla direct pointers to accommodate split editing
+ m_pSci(1) as any ptr
+ m_hWndActiveScintilla as hwnd
+ m_UserModified as boolean ' occurs when user manually changes state not captured by Scintilla changes
+
+ public:
+ pDocNext as clsDocument_ ptr = 0 ' pointer to next document in linked list
+ IsDesigner as boolean
+ IsNewFlag as boolean
+ LoadingFromFile as boolean
+
+ docData as PROJECT_FILELOAD_DATA ' loaded from project files
+
+ ' 2 Scintilla controls to accommodate split editing
+ ' hWindow(0) is our MAIN control (bottom)
+ ' hWindow(1) is our split control (top)
+ hWindow(1) as HWnd ' Scintilla split edit windows
+
+ ' Visual designer related
+ wszFormVersion as CWSTR
+ MenuItems(any) as clsMenuItem
+ ToolBarItems(any) as clsToolBarItem
+ wszToolBarSize as CWSTR = wstr("SIZE_24") ' SIZE_16, SIZE_24, SIZE_32, SIZE_48
+ PanelItems(any) as clsPanelItem
+ Controls as clsCollection
+ AllImages(any) as IMAGES_TYPE ' All Images belonging to the Form
+ GenerateMenu as boolean = true ' Indicates to generate code for the menu
+ GenerateToolBar as boolean = true ' Indicates to generate code for the menu
+ GenerateStatusBar as boolean = true ' Indicates to generate code for the statusbar
+ hWndDesigner as HWnd ' DesignMain window (switch to this window when in design mode (versus code mode)
+ DesignTabsCurSel as long
+ initialCtrlID as long ' The starting CtrlID to use for this form and all controls on it.
+ hWndFrame as hwnd ' DesignFrame for visual designer windows
+ hWndForm as hwnd ' DesignForm for visual designer windows
+ hWndFakeMenu as HWND ' Fake top menu to display when using Menu Editor
+ hFontFakeMenu as HFONT ' System font used for menus
+ hWndStatusBar as HWND ' StatusBar for the form using StatusBar Editor
+ hWndRebar as HWND ' Rebar for the form using ToolBar Editor
+ hWndToolBar as HWND ' ToolBar for the form using ToolBar Editor
+ GrabHit as long ' Which grab handle is currently active for sizing action
+ ptPrev as point ' Used for sizing action
+ bSizing as boolean ' Flag that sizing action is in progress
+ bMoving as boolean ' Flag that moving action is in progress
+ bRegenerateCode as boolean ' Flag to regenerate code when switching to the code tab
+ bLockControls as boolean ' Global flag that locks the form and all controls from moving or resizing.
+ rcSize as RECT ' Current size of form/control. Used during sizing action
+ pCtrlAction as clsControl ptr ' The control that the size/move action is being performed on
+ wszFormCodeGen as CWSTR ' Form code generated
+ wszFormMetaData as CWSTR ' Form metadata that defines the form
+ AppRunCount as long = 0 ' Only one should exist in the whole project so track if one or more exists in the code.
+
+ ' SnapLines
+ bSnapLines as boolean = true ' Enable/Disable SnapLines
+ hBrushSnapLine as HBRUSH
+ hSnapLine(3) as HWND ' top, bottom, left, right (ENUM SnapLinePosition)
+ bSnapActive(3) as boolean
+ ptCursorStart(3) as POINT ' Client coordinate of cursor at time of snap
+
+ ' Code document related
+ ProjectFiletype as CWSTR = FILETYPE_UNDEFINED
+ DiskFilename as wstring * MAX_PATH
+ DesignerFilename as wstring * MAX_PATH
+ AutoSaveFilename as wstring * MAX_PATH '#filename#
+ AutoSaveRequired as boolean
+ DateFileTime as FILETIME
+ bBookmarkExpanded as boolean = true ' Bookmarks list expand/collapse state
+ bFunctionsExpanded as boolean = true ' Functions list expand/collapse state
+ bHasFunctions as boolean = false ' FunctionList to determine if click will display the File
+ FileEncoding as long = FILE_ENCODING_ANSI
+ bNeedsParsing as boolean ' Document requires to be parsed due to changes.
+ DeletedButKeep as boolean ' file no longer exists but keep open anyway
+ DocumentBuild as string ' specific build configuration to use for this document
+ sMatchWord as string ' for the incremental autocomplete search
+ AutoCompletetype as long ' AUTOC_DIMAS, AUTOC_TYPE
+ AutoCStartPos as long
+ AutoCTriggerStartPos as long
+ lastCaretPos as long ' used for checking in SCN_UPDATEUI
+ lastXOffsetPos as long ' used for checking in SCN_UPDATEUI (horizontal offset)
+ LastCharTyped as long ' most recent entered character. Used to test for BACKSPACE resetting the autocomplete popup.
+
+ ' Following used for split edit views
+ rcSplitButton as RECT ' Split gripper vertical for Scintilla window
+ SplitY as long ' Y coordinate of vertical splitter
+ bEditorIsSplit as boolean
+
+ static NextFileNum as long
+
+ declare property hWndActiveScintilla() as hwnd
+ declare property hWndActiveScintilla(byval hWindow as hwnd)
+
+ declare property UserModified() as boolean
+ declare property UserModified( byval nModified as boolean )
+
+ declare function ParseDocument() as boolean
+ declare function MainMenuExists() as boolean
+ declare function ToolBarExists() as boolean
+ declare function StatusBarExists() as boolean
+ declare function IsValidScintillaID( byval idScintilla as long ) as boolean
+ declare function GetActiveScintillaPtr() as any ptr
+ declare function CreateCodeWindow( byval hWndParent as HWnd, byval IsNewFile as boolean, byval IsTemplate as boolean = False, byref wszFileName as wstring = "") as HWnd
+ declare function CreateDesignerWindow( byval hWndParent as HWnd) as HWnd
+ declare function FindReplace( byval strFindText as string, byval strReplaceText as string ) as long
+ declare function InsertFile() as boolean
+ declare function ParseFormMetaData( byval hWndParent as HWnd, byref sAllText as wstring, byval bLoadOnly as boolean = false ) as CWSTR
+ declare function LoadFormJSONdata( byval hWndParent as HWnd, byref wszAllText as string, byval bLoadOnly as boolean = false ) as long
+ declare function SaveFormJSONdata() as boolean
+ declare function SaveFile(byval bSaveAs as boolean = False, byval bAutoSaveOnly as boolean = false) as boolean
+ declare function ApplyProperties() as long
+ declare function GetTextRange( byval cpMin as long, byval cpMax as long) as string
+ declare function ChangeSelectionCase( byval fCase as long) as long
+ declare function GetCurrentLineNumber() as long
+ declare function SelectLine( byval nLineNum as long ) as long
+ declare function GetLine( byval nLine as long) as string
+ declare function IsFunctionLine( byval lineNum as long ) as long
+ declare function GotoNextFunction() as long
+ declare function GotoPrevFunction() as long
+ declare function GetLineCount() as long
+ declare function GetSelText() as string
+ declare function GetText() as string
+ declare function SetText( byref sText as const string ) as long
+ declare function SetLine( byval nLineNum as long, byval sNewText as string) as long
+ declare function AppendText( byref sText as const string ) as long
+ declare function CenterCurrentLine() as long
+ declare function GetSelectedLineRange( byref startLine as long, byref endLine as long, byref startPos as long, byref endPos as long ) as long
+ declare function BlockComment( byval flagBlock as boolean ) as long
+ declare function CurrentLineUp() as long
+ declare function CurrentLineDown() as long
+ declare function MoveCurrentLines( byval flagMoveDown as boolean ) as long
+ declare function NewLineBelowCurrent() as long
+ declare function ToggleBookmark( byval nLine as long ) as long
+ declare function NextBookmark() as long
+ declare function PrevBookmark() as long
+ declare function FoldToggle( byval nLine as long ) as long
+ declare function FoldAll() as long
+ declare function UnFoldAll() as long
+ declare function FoldToggleOnwards( byval nLine as long) as long
+ declare function ConvertEOL( byval nMode as long) as long
+ declare function TabsToSpaces() as long
+ declare function GetWord( byval curPos as long = -1 ) as string
+ declare function GetBookmarks() as string
+ declare function SetBookmarks( byval sBookmarks as string ) as long
+ declare function GetFoldPoints() as string
+ declare function SetFoldPoints( byval sFoldPoints as string ) as long
+ declare function GetCurrentFunctionName( byref sFunctionName as string, byref nGetSet as ClassProperty ) as long
+ declare function LineDuplicate() as long
+ declare function SetMarkerHighlight() as long
+ declare function RemoveMarkerHighlight() as long
+ declare function IsMultiLineSelection() as boolean
+ declare function HasMarkerHighlight() as boolean
+ declare function FirstMarkerHighlight() as long
+ declare function LastMarkerHighlight() as long
+ declare function LinesPerPage( byval idxWindow as long ) as long
+ declare function CompileDirectives( Directives() as COMPILE_DIRECTIVES) as long
+ declare destructor
+end type
+dim clsDocument.NextFileNum as long = 0
diff --git a/src/clsDocument.inc b/src/clsDocument.inc
index 95f8642b..9ded95c8 100644
--- a/src/clsDocument.inc
+++ b/src/clsDocument.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
@@ -1174,7 +1174,7 @@ function clsDocument.SaveFormJSONdata() as boolean
' Convert UTF-16 to UTF-8 encoding
wst = "{" & wst & "}"
- '// Per email from "Allan" on Jan 14, 2023, I made to UnicodeToUtf8
+ '// Per email from "Allan" on Jan 14, 2023, changes I made to UnicodeToUtf8
'// function (eliminating the ending Trim(0), and use BytesWritten instead) seems to be
'// the reason for the Chinese characters now writing 100% correctly.
dim pStream as CTextStream
diff --git a/src/clsDocument.inc.bak b/src/clsDocument.inc.bak
new file mode 100644
index 00000000..021d89d2
--- /dev/null
+++ b/src/clsDocument.inc.bak
@@ -0,0 +1,2701 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+''
+'' clsDocument (Class to handle everything related to a Scintilla editing window)
+''
+
+#include once "clsDocument.bi"
+#include once "modVDToolbox.bi"
+#include once "frmFindReplace.bi"
+#include once "modVDRoutines.bi"
+#include once "modVDControls.bi"
+#include once "modVDDesignFrame.bi"
+#include once "modVDDesignMain.bi"
+#include once "modVDApplyProperties.bi"
+#include once "modVDProperties.bi"
+#include once "modGenerateCode.bi"
+#include once "modMRU.bi"
+
+
+''
+''
+destructor clsDocument
+ ' Delete any manually allocated CWindows in the designer
+ for i as long = lbound(this.hWindow) to ubound(this.hWindow)
+ DestroyWindow this.hWindow(i) ' destroy the scintilla/designer windows
+ next
+ if this.IsDesigner then
+ ' Remove all controls
+ dim pCtrl as clsControl ptr
+ do until this.Controls.Count <= 1
+ for i as long = this.Controls.ItemFirst to this.Controls.ItemLast
+ pCtrl = this.Controls.ItemAt(i)
+ this.Controls.Remove(pCtrl)
+ next
+ loop
+ for i as long = 0 to 3
+ DestroyWindow(this.hSnapLine(i))
+ next
+ DestroyWindow(this.hWndForm)
+ DestroyWindow(this.hWndFrame)
+ DestroyWindow(this.hWndDesigner)
+ DeleteObject(this.hFontFakeMenu)
+ end if
+
+ ' Repaint the main area because we don't want any splitter to show
+ AfxRedrawWindow(HWND_FRMMAIN)
+
+end destructor
+
+
+''
+'' Returns true/False indicating whether user manual changes were made
+'' outside of whatever edit changes Scintilla makes.
+''
+property clsDocument.UserModified() as boolean
+ return m_UserModified
+end property
+
+property clsDocument.UserModified( byval nModified as boolean )
+ m_UserModified = nModified
+ if nModified = true then this.AutoSaveRequired = true
+end property
+
+
+' ========================================================================================
+' Parse the code for this document. Invokes the ctxParser which does all of
+' the actual parse work and database updating.
+' ========================================================================================
+function clsDocument.ParseDocument() as boolean
+ if this.bNeedsParsing = false then
+ return false
+ end if
+
+ static as boolean bInParseDocument
+
+ ' Prevent any potential recursive parsing
+ if bInParseDocument then exit function
+ bInParseDocument = true
+
+ ' Delete any existing data related to this pDoc
+ gdb2.dbDeleteByDocumentPtr(@this)
+
+ dim parser as ctxParser
+ parser.nFileType = DB2_FILETYPE_USERCODE
+ parser.parse(@this)
+ frmOutput_UpdateToDoListview()
+
+ bInParseDocument = false
+ return true
+end function
+
+
+' ========================================================================================
+' Determines if the IDC_SCINTILLA id being checked belongs to any of the
+' currently defined Scintilla windows (needed for splitter windows).
+' ========================================================================================
+function clsDocument.IsValidScintillaID( byval idScintilla as long ) as boolean
+ for i as long = lbound(this.hWindow) to ubound(this.hWindow)
+ if IDC_SCINTILLA + i = idScintilla then
+ return true
+ end if
+ next
+end function
+
+
+''
+''
+function clsDocument.GetActiveScintillaPtr() as any ptr
+ dim as hwnd hEdit = this.hWndActiveScintilla
+ for i as long = lbound(this.hWindow) to ubound(this.hWindow)
+ if this.hWindow(i) = hEdit then return m_pSci(i)
+ next
+ ' if no other matches then return
+ function = m_pSci(0)
+end function
+
+
+property clsDocument.hWndActiveScintilla() as hwnd
+ if m_hWndActiveScintilla = 0 then m_hWndActiveScintilla = this.hWindow(0)
+ property = m_hWndActiveScintilla
+end property
+
+property clsDocument.hWndActiveScintilla(byval hWindow as hwnd)
+ m_hWndActiveScintilla = hWindow
+end property
+
+''
+'' Returns true/False indicating that a valid top mainmenu exists for this form.
+function clsDocument.MainMenuExists() as boolean
+ dim as long numItems = (ubound(this.MenuItems) - lbound(this.MenuItems)) + 1
+ if (this.GenerateMenu = true) andalso (numItems > 0) then
+ return true
+ else
+ return false
+ end if
+end function
+
+''
+'' Returns true/False indicating that a valid top toolbar exists for this form.
+function clsDocument.ToolBarExists() as boolean
+ dim as long numItems = (ubound(this.ToolBarItems) - lbound(this.ToolBarItems)) + 1
+ if (this.GenerateToolBar = true) andalso (numItems > 0) then
+ return true
+ else
+ return false
+ end if
+end function
+
+''
+'' Returns true/False indicating that a valid top statusbar exists for this form.
+function clsDocument.StatusBarExists() as boolean
+ dim as long numItems = (ubound(this.PanelItems) - lbound(this.PanelItems)) + 1
+ if (this.GenerateStatusBar = true) andalso (numItems > 0) then
+ return true
+ else
+ return false
+ end if
+end function
+
+''
+''
+function clsDocument.CreateDesignerWindow( byval hWndParent as HWnd ) as hwnd
+
+ ' for the Visual Designer, there exists three (3) levels of windows:
+ ' (1) The DesignMain (hWindow) used by the top tabcontrol to display the document.
+ ' This is the highest level window and is basically just the container for
+ ' the other two windows. Contains tab control to switch between design/code views.
+ ' (2) The DesignFrame window. This is the scrollable window.
+ ' (3) The DesignForm window. This is the actual visual form that we manipulate by
+ ' adding controls to it, etc.
+ ' (*4) There is a 4th window in the sense that the Scintilla code window swaps
+ ' out the DesignFrame whenever the tabcontrol switches between design/code view.
+ '
+ this.IsDesigner = true
+
+ ' In version 3.02+ form file encoding does not have to be unicode because the form meta
+ ' data is saved to a separate .design file (UTF-8 encoded no sigature). Therefore, unless
+ ' the user specifically changes the code file encoding then we will default to ANSI. That
+ ' ANSI setting for the file was set on pDoc creation. Do not reset the value here otherwise
+ ' it will affect any existing user files and essentially make all Form files as ANSI.
+ ' this.FileEncoding = FILE_ENCODING_UTF16_BOM
+
+ dim rc as RECT
+
+ ' (1) Create the DesignMain window
+ dim pMain as CWindow ptr = new CWindow
+ pMain->DPI = AfxCWindowPtr(hwndParent)->DPI
+ this.hWndDesigner = _
+ pMain->Create( hWndParent, "", @DesignerMain_WndProc, 0, 0, 0, 0, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT or WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR)
+ pMain->Brush = ghDesigner.hPanelBrush
+ pMain->SetClientSize(3000, 3000)
+ ' We will set our own mouse pointer as needed
+ SetClassLongPtr(this.hWindow(0), GCLP_HCURSOR, 0)
+ ' Allow the Designer Frame window to scroll. This allows us to create Forms that
+ ' are larger than the current viewable screen area.
+ dim pScrollWindow as CScrollWindow ptr = new CScrollWindow(pMain->hWindow)
+ pMain->ScrollWindowPtr = pScrollWindow
+
+
+ ' (2) Create the Design Frame window (child of the Main)
+ dim pFrame as CWindow ptr = new CWindow
+ pFrame->DPI = AfxCWindowPtr(hwndParent)->DPI
+ this.hWndFrame = _
+ pFrame->Create( pMain->hWindow, "", @DesignerFrame_WndProc, 0, 0, 0, 0, _
+ WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT or WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR)
+ pFrame->ClassStyle = CS_DBLCLKS
+ SetWindowLongPtr( pFrame->hWindow, GWLP_ID, IDC_DESIGNFRAME )
+ ' We will set our own mouse pointer as needed
+ SetClassLongPtr(this.hWndFrame, GCLP_HCURSOR, 0)
+ pFrame->Brush = ghDesigner.hPanelBrush
+
+
+ ' (3) Create the Design Form (child of the Frame)
+ dim pCtrl as clsControl ptr
+ if this.IsNewFlag then
+ this.UserModified = true
+ SetRect(@rc, 10, 10, 510, 310)
+ pCtrl = CreateToolboxControl( @this, CTRL_FORM, rc )
+ end if
+
+ function = this.hWindow(0)
+end function
+
+
+''
+''
+function clsDocument.CreateCodeWindow( _
+ byval hWndParent as HWnd, _
+ byval IsNewFile as boolean, _
+ byval IsTemplate as boolean = false, _
+ byref wszFile as wstring = "" _
+ ) as HWnd
+
+ ' Creates a Scintilla editing window (initially not visible). Optionally, load a diskfile
+ ' into the window and apply properties to it.
+ for i as long = lbound(this.hWindow) to ubound(this.hWindow)
+ this.hWindow(i) = CreateWindowEx( 0, "Scintilla", "", _
+ WS_CHILD or WS_TABSTOP or WS_CLIPCHILDREN, _
+ 0,0,0,0,hWndParent, _
+ cast(HMENU, IDC_SCINTILLA+i), GetModuleHandle(null), null)
+
+ SendMessage( this.hWindow(i), SCI_SETMODEVENTMASK, _
+ SC_MOD_INSERTTEXT or SC_MOD_DELETETEXT, 0 )
+
+ ' Initialize our direct access to the Scintilla code windows. This is much faster than
+ ' using SendMessage to the window. Only need to initialize once no matter how many
+ ' code windows that are eventually opened.
+ if IsWindow(this.hWindow(i)) then
+ ' NOTE: In my testing, need to only set the Scintilla lexer to the base editing
+ ' window only and NOT both split windows. Also need to do this immediately after
+ ' the window is created and do not send the message again afterwards.
+ ' Also, every window must have a separate new call to CreateLexer. We can not
+ ' just get one lexer and then try to share it amongst multiple new windows. When
+ ' a window is destroyed then the pointer would be as well causing other existing
+ ' windows to GPF.
+ if i = 0 then
+ ' Load the FB lexer from Lexilla and feed it into Scintilla
+ dim as any ptr pLexer = gApp.pfnCreateLexerfn( "winfbe" )
+ SendMessage( this.hWindow(i), SCI_SETILEXER, 0, cast(LPARAM, pLexer) )
+ end if
+ if SciMsg = 0 then
+ SciMsg = cast( Scintilla_Directfunction, SendMessage( this.hWindow(0), SCI_GETDIRECTFUNCTION, 0, 0 ) )
+ end if
+ ' Call the direct function for speed purposes rather than relying on the traditional SendMessage method.
+ m_pSci(i) = cast(any ptr, SendMessage( this.hWindow(i), SCI_GETDIRECTPOINTER, 0, 0 ))
+ end if
+ next
+
+ ' Disable scintilla vertical scroll bar (wParam = 1 to enable)
+ SciMsg( m_pSci(0), SCI_SETVSCROLLBAR, 0, 0 )
+ SciMsg( m_pSci(0), SCI_SETHSCROLLBAR, 0, 0 )
+ SciMsg( m_pSci(1), SCI_SETVSCROLLBAR, 0, 0 )
+ SciMsg( m_pSci(1), SCI_SETHSCROLLBAR, 0, 0 )
+
+ ' Get the document pointer from our main control and assign it to the other split windows
+ dim as any ptr pDoc = cast(any ptr, SciMsg(m_pSci(0), SCI_GETDOCPOINTER, 0, 0))
+ if pDoc then SciMsg( m_pSci(1), SCI_SETDOCPOINTER, 0, cast(LPARAM, pDoc))
+
+ dim nResult as long = IS_TEXT_UNICODE_SIGNATURE
+
+ ' if a disk file was specified then open it and load it into the editor
+ this.IsNewFlag = IsNewFile
+ if (IsNewFile = true) orelse (IsTemplate = true) then
+ this.nextFileNum = this.nextFileNum + 1
+ this.DiskFilename = "Untitled" & this.nextFileNum
+ if this.IsDesigner then
+ this.CreateDesignerWindow(hWndParent) ' Create the new visual designer window
+ end if
+ end if
+ this.ProjectFileType = FILETYPE_UNDEFINED
+
+ if len(wszFile) then
+ ' do not use Dir() > "" here b/c if incoming file originated from a Do/loop
+ ' of files using Dir() then there will be problems.
+
+ if AfxFileExists(wszFile) then
+ dim as string st, sText
+ dim as long idx
+
+ if IsTemplate then
+ dim pStream as CTextStream
+ if pStream.Open(wszFile) = S_OK then
+ ' Look at the first 4 lines
+ ' Line 3 tells us the file type (bas or xml)
+ do until pStream.EOS
+ st = pStream.ReadLine
+ idx = idx + 1
+ select case idx
+ case 1
+ case 2
+ case 3: this.DiskFilename = this.DiskFilename & trim(st)
+ case 4
+ case else
+ sText = sText & st & vbCrLf
+ end select
+ loop
+ pStream.Close
+ if IsTextUnicode(strptr(sText), 2, cast(LPINT, @nResult) ) then
+ sText = mid(sText, 3)
+ sText = AfxACode( cast(wstring ptr, strptr(sText)) )
+ end if
+ this.SetText( sText )
+ end if
+ ' Force the template file to be considered "new" so it will be saved.
+ this.IsNewFlag = true
+ ' Search for "|", replace it with an empty space "" and position the caret in that place
+ this.FindReplace( "|", "" )
+ ' don't set SAVEPOINT for newly loaded Template files because we want the document to display as dirty
+
+ else
+
+ ' Set a flag that we are loading code from a file. This is important because if the file
+ ' contains visual designer code then we only want to apply control properties after all of
+ ' the file is read, otherwise it would get applied immediately after each call to CreateToolboxControl.
+ this.LoadingFromFile = true
+ this.DiskFilename = wszFile ' assign before GetFileTostring because needed for RelativeFile calculation.
+ this.DesignerFilename = wszFile & ".design"
+
+ ' GetFileTostring has a call to pDoc->ParseFormMetaData which will create/recreate the designer form.
+ ' We continue to use this function in post version 3.02 form file format in order to ensure
+ ' that older form files can be imported.
+ dim sText as string ' this will be an UTF-8 encoded string
+
+ if GetFileToString(wszFile, sText, @this) = false then
+ ' Take this opportunity to determine the text line endings
+ if instr(sText, chr(13,10)) then
+ SciMsg( m_pSci(0), SCI_SETEOLMODE, SC_EOL_CRLF, 0)
+ elseif instr(sText, chr(10)) then
+ SciMsg( m_pSci(0), SCI_SETEOLMODE, SC_EOL_LF, 0)
+ elseif instr(sText, chr(13)) then
+ SciMsg( m_pSci(0), SCI_SETEOLMODE, SC_EOL_CR, 0)
+ end if
+ this.SetText( sText )
+ this.DateFileTime = AfxGetFileLastWriteTime( wszFile )
+ else
+ print "Error opening: "; wszFile
+ end if
+
+ ' Do a check for IsDesigner. New post version 3.02+ files have new form JSON file
+ ' format and require a different parsing routine in order to load. They are also
+ ' stored in UTF-8 (no signature).
+ if AfxFileExists(this.DesignerFilename) then
+ this.IsDesigner = true
+ if (ConvertWinFBEversion(this.wszFormVersion) >= ConvertWinFBEversion("3.0.2")) orelse _
+ (ConvertWinFBEversion(this.wszFormVersion) = 0) then 'b/c upgraded form files do not have version loaded yet
+ sText = ""
+ ' Need to save and then restore the File Encoding for this pDoc because the call to GetFileString
+ ' for the designer file could reset the encoding of the main file.
+ dim as long savedEncoding = this.FileEncoding
+ if GetFileToString(this.DesignerFilename, sText, @this) = false then
+ this.CreateDesignerWindow(hWndParent) ' Create the new visual designer window
+ this.LoadFormJSONdata(HWND_FRMMAIN, sText) ' this should now be UTF-8
+ end if
+ this.FileEncoding = savedEncoding
+ end if
+ end if
+
+ this.LoadingFromFile = false
+ SciMsg( m_pSci(0), SCI_SETSAVEPOINT, 0, 0)
+ SciMsg( m_pSci(0), SCI_EMPTYUNDOBUFFER, 0, 0)
+ this.UserModified = false
+ this.AutoSaveRequired = false
+ this.AutoSaveFilename = OnCommand_FileAutoSaveGenerateFilename(wszFile)
+ ' Update the most recently used file list (only for non-IsNewFlag files)
+ ' Only add file to MRU list if it is not part of an active Project.
+ if gApp.IsProjectActive = false then
+ UpdateMRUList(wszFile)
+ end if
+ end if
+ end if
+ end if
+
+ if this.IsDesigner then
+ ' select the Form as the default focus control
+ this.Controls.SelectControl( this.hWndForm )
+ this.Controls.SetActiveControl( this.hWndForm )
+
+ ' if the data that was read contained anything that caused the form to have
+ ' to be code regenerated then we need to save the file back to disk with the
+ ' new meta data and code generation.
+ if this.bRegenerateCode then
+ if this.IsNewFlag = false then this.SaveFile
+ end if
+
+ end if
+
+ ' Apply code editor properties to the edit window
+ this.ApplyProperties
+
+ function = this.hWindow(0)
+end function
+
+''
+''
+function clsDocument.FindReplace( _
+ byval strFindText as string, _
+ byval strReplaceText as string _
+ ) as long
+
+ ' return Value: new position if successful; -1 if text not found.
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim as long findFlags = SCFIND_MATCHcase or SCFIND_WHOLEWORD
+ dim as long startPos = SciMsg( pSci, SCI_GETCURRENTPOS, 0, 0)
+ dim as long endPos = SciMsg( pSci, SCI_GETTEXTLENGTH, 0, 0)
+ dim as long newPos
+
+ ' Set the start and end positions, and search flags, and finally do the search
+ SciMsg( pSci, SCI_SETTARGETSTART, startPos, 0)
+ SciMsg( pSci, SCI_SETTARGETEND, endPos, 0)
+ SciMsg( pSci, SCI_SETSEARCHFLAGS, findFlags, 0)
+
+ ' Search the text to replace
+ newPos = SciMsg( pSci, SCI_SEARCHINTARGET, len(strFindText), cast(LPARAM, strptr(strFindText)) )
+
+ ' return -1 if not found
+ if newPos = - 1 then return -1
+
+ gApp.SuppressNotify = true
+ ' Position the caret and select the text
+ SciMsg( pSci, SCI_SETCURRENTPOS, newPos, 0)
+ SciMsg( pSci, SCI_GOTOPOS, newPos, 0)
+ SciMsg( pSci, SCI_SETSELECTIONSTART, newPos, 0)
+ SciMsg( pSci, SCI_SETSELECTIONEND, newPos + len(strFindText), 0)
+
+ ' Replace the selection (SCI_REPLACESEL fails if text is "" so use Cut instead for that scenario)
+ if len(strReplaceText) = 0 then
+ SciMsg( pSci, SCI_CUT, 0, 0 )
+ else
+ SciMsg( pSci, SCI_REPLACESEL, 0, cast(LPARAM, strptr(strReplaceText)) )
+ end if
+ gApp.SuppressNotify = false
+
+ ' return the new position
+ function = newPos
+
+end function
+
+''
+''
+function clsDocument.InsertFile() as boolean
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Display the Open File Dialog
+ dim pwszName as wstring ptr = AfxIFileOpenDialogW(HWND_FRMMAIN, IDM_INSERTFILE)
+ if pwszName then
+ ' save the main file encoding because GetFileTostring may change it
+ dim as string sText
+ GetFileTostring(*pwszName, sText, @this)
+ SciMsg( pSci, SCI_INSERTTEXT, -1, cast(LPARAM, strptr(sText)) )
+ CoTaskMemFree pwszName
+ this.ApplyProperties()
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Load the JSON data to populate the various Form's data structures.
+' ========================================================================================
+function clsDocument.LoadFormJSONdata( _
+ byval hWndParent as HWnd, _
+ byref JSONtext as string, _ ' this will be UTF-8 text
+ byval bLoadOnly as boolean = false _
+ ) as long
+
+ dim pCtrl as clsControl ptr
+ dim pCtrlActive as clsControl ptr
+
+ dim as RECT rc
+ dim as CWSTR wst, wszPropName, wszPropValue, wszEventName
+ dim as boolean bIsValidControl = true
+
+ dim as long numItems
+
+ dim as cJSON ptr filePtr, keyPtr
+ dim as cJSON ptr itemsPtr, itemPtr
+ dim as cJSON ptr ctrlsPtr, ctrlPtr
+ dim as cJSON ptr propsPtr, propPtr
+ dim as cJSON ptr eventsPtr, eventPtr
+
+ dim json as CJSON_TYPE
+
+ filePtr = json.parse(JSONtext)
+ if filePtr = NULL then exit function
+
+ ' First, make sure that this is actually a Form file!
+ if json.getbool( filePtr, "form" ) <> true then exit function
+
+ this.IsDesigner = true
+
+ ' Remove any previously created controls, etc otherwise reloading the form
+ ' file will result in duplicates.
+ if bLoadOnly = false then
+ if this.hWndForm then DestroyWindow(this.hWndForm)
+ if this.hWndFrame then DestroyWindow(this.hWndFrame)
+ if this.hWndDesigner then DestroyWindow(this.hWndDesigner)
+ this.CreateDesignerWindow(hWndParent)
+ end if
+
+ this.wszFormVersion.Utf8 = json.gettext(filePtr, "version")
+ if this.wszFormVersion = "" then this.wszFormVersion = APPVERSION
+
+ this.bLockControls = json.getbool(filePtr, "lockcontrols")
+ this.bSnapLines = json.getbool(filePtr, "snaplines")
+
+ ' Retrieve data related to IMAGES
+ itemsPtr = json.getptr(filePtr, "images")
+ numItems = json.arraycount(itemsPtr)
+ if numItems then
+ redim preserve this.AllImages(numItems - 1)
+ dim as long i = 0
+ itemPtr = json.arrayitem(itemsPtr, i)
+ do until itemPtr = 0
+ this.AllImages(i).pDoc = @this
+ this.AllImages(i).wszImageName.Utf8 = json.gettext(itemPtr, "imagename")
+ wst.Utf8 = json.gettext(itemPtr, "filename")
+ ' if this is a relative filename then convert it back.
+ dim as CWSTR wszImageFilename = ProcessFromCurdriveProject(wst)
+ if AfxPathIsRelative(wszImageFilename) then
+ wszImageFilename = AfxPathCombine( AfxStrPathName("PATH", this.DiskFilename), wszImageFilename)
+ end if
+ this.AllImages(i).wszFileName = wszImageFilename
+
+ this.AllImages(i).wszFormat.Utf8 = json.gettext(itemPtr, "resourcetype")
+ i += 1
+ itemPtr = itemPtr->next
+ loop
+ end if
+
+ ' Retrieve data related to MAINMENU
+ keyPtr = json.getptr(filePtr, "mainmenu")
+ if keyPtr then
+ this.GenerateMenu = json.getbool(keyPtr, "display")
+ itemsPtr = json.getptr(keyPtr, "items")
+ numItems = json.arraycount(itemsPtr)
+ if numItems then
+ redim preserve this.MenuItems(numItems - 1)
+ dim as long i = 0
+ itemPtr = json.arrayitem(itemsPtr, i)
+ do until itemPtr = 0
+ dim as CWSTR wszName
+ wszName.Utf8 = json.gettext(itemPtr, "name")
+ if len(rtrim(wszName)) > 0 then
+ this.MenuItems(i).wszName = wszName
+ this.MenuItems(i).wszCaption.Utf8 = json.gettext(itemPtr, "caption")
+ this.MenuItems(i).nIndent = json.getnumber(itemPtr, "indent")
+ this.MenuItems(i).chkAlt = json.getnumber(itemPtr, "alt")
+ this.MenuItems(i).chkShift = json.getnumber(itemPtr, "shift")
+ this.MenuItems(i).chkCtrl = json.getnumber(itemPtr, "ctrl")
+ this.MenuItems(i).wszShortcut.Utf8 = json.gettext(itemPtr, "shortcut")
+ this.MenuItems(i).chkChecked = json.getnumber(itemPtr, "checked")
+ this.MenuItems(i).chkGrayed = json.getnumber(itemPtr, "grayed")
+ i += 1
+ end if
+ itemPtr = itemPtr->next
+ loop
+ end if
+ end if
+
+ ' Retrieve data related to STATUSBAR
+ keyPtr = json.getptr(filePtr, "statusbar")
+ if keyPtr then
+ this.GenerateStatusBar = json.getbool(keyPtr, "display")
+ itemsPtr = json.getptr(keyPtr, "items")
+ numItems = json.arraycount(itemsPtr)
+ if numItems then
+ redim preserve this.PanelItems(numItems - 1)
+ dim as long i = 0
+ itemPtr = json.arrayitem(itemsPtr, i)
+ do until itemPtr = 0
+ this.PanelItems(i).wszName.Utf8 = json.gettext(itemPtr, "name")
+ this.PanelItems(i).wszText.Utf8 = json.gettext(itemPtr, "text")
+ this.PanelItems(i).wszTooltip.Utf8 = json.gettext(itemPtr, "tooltip")
+ this.PanelItems(i).wszAlignment.Utf8 = json.gettext(itemPtr, "alignment")
+ this.PanelItems(i).wszAutoSize.Utf8 = json.gettext(itemPtr, "autosize")
+ this.PanelItems(i).wszWidth.Utf8 = json.gettext(itemPtr, "width")
+ this.PanelItems(i).wszMinWidth.Utf8 = json.gettext(itemPtr, "minwidth")
+ this.PanelItems(i).pProp.wszPropValue.Utf8 = json.gettext(itemPtr, "image")
+ this.PanelItems(i).wszBackColor.Utf8 = json.gettext(itemPtr, "backcolor")
+ this.PanelItems(i).wszBackColorHot.Utf8 = json.gettext(itemPtr, "backcolorhot")
+ this.PanelItems(i).wszForeColor.Utf8 = json.gettext(itemPtr, "forecolor")
+ this.PanelItems(i).wszForeColorHot.Utf8 = json.gettext(itemPtr, "forecolorhot")
+ ' BorderStyle is deprecated as of v2.0.4 as it has no effect
+ ' in WinFBE programs where Windows Themes are enabled.
+ i += 1
+ itemPtr = itemPtr->next
+ loop
+ end if
+ end if
+
+ ' Retrieve data related to TOOLBAR
+ keyPtr = json.getptr(filePtr, "toolbar")
+ if keyPtr then
+ this.GenerateToolbar = json.getbool(keyPtr, "display")
+ this.wszToolBarSize.Utf8 = json.gettext(keyPtr, "size")
+ itemsPtr = json.getptr(keyPtr, "items")
+ numItems = json.arraycount(itemsPtr)
+ if numItems then
+ redim preserve this.ToolBarItems(numItems - 1)
+ dim as long i = 0
+ itemPtr = json.arrayitem(itemsPtr, i)
+ do until itemPtr = 0
+ this.ToolBarItems(i).wszName.Utf8 = json.gettext(itemPtr, "name")
+ this.ToolBarItems(i).wszButtonType.Utf8 = json.gettext(itemPtr, "type")
+ this.ToolBarItems(i).wszTooltip.Utf8 = json.gettext(itemPtr, "tooltip")
+ this.ToolBarItems(i).pPropNormalImage.wszPropValue.Utf8 = json.gettext(itemPtr, "normalimage")
+ this.ToolBarItems(i).pPropHotImage.wszPropValue.Utf8 = json.gettext(itemPtr, "hotimage")
+ this.ToolBarItems(i).pPropDisabledImage.wszPropValue.Utf8 = json.gettext(itemPtr, "disabledimage")
+ i += 1
+ itemPtr = itemPtr->next
+ loop
+ end if
+ end if
+
+ ctrlsPtr = json.getptr(filePtr, "controls")
+ dim as long numControls = json.arraycount(ctrlsPtr)
+ if numControls then
+ dim wszControlType as CWSTR
+ dim nControlType as long
+
+ ctrlPtr = json.arrayitem(ctrlsPtr, 0)
+ do until ctrlPtr = 0
+ wszControlType.Utf8 = json.gettext(ctrlPtr, "type")
+ nControlType = GetControlType( wszControlType)
+
+ ' Control Start
+ if nControlType = 0 then
+ ' no longer a valid toolbox control
+ ctrlPtr = ctrlPtr->next
+ continue do
+ else
+ if bLoadOnly = true then
+ dim pCtrlTemp as clsControl ptr = new clsControl
+ pCtrlTemp->ControlType = nControlType
+ this.Controls.Add(pCtrlTemp)
+ else
+ pCtrl = CreateToolboxControl( @this, nControlType, rc )
+ pCtrlActive = pCtrl
+ end if
+ end if
+
+ propsPtr = json.getptr(ctrlPtr, "properties")
+ dim as long numProps = json.arraycount(propsPtr)
+ if numProps then
+ propPtr = json.arrayitem(propsPtr, 0)
+ do until propPtr = 0
+ wszPropName.Utf8 = json.gettext(propPtr, "name")
+ wszPropValue.Utf8 = json.gettext(propPtr, "value")
+ ' Only set the loading property if it exists in the current property
+ ' listing. We do this otherwise older now unused properties will continue
+ ' to get loaded when we no longer want them to.
+ if IsPropertyExists( pCtrl, wszPropName ) then
+ SetControlProperty( pCtrl, wszPropName, wszPropValue )
+ end if
+ propPtr = propPtr->next
+ loop
+ end if
+
+ eventsPtr = json.getptr(ctrlPtr, "events")
+ dim as long numEvents = json.arraycount(eventsPtr)
+ if numEvents then
+ eventPtr = json.arrayitem(eventsPtr, 0)
+ do until eventPtr = 0
+ wszEventName.Utf8 = json.gettext(eventPtr, "name")
+ SetControlEvent( pCtrl, wszEventName, true )
+ eventPtr = eventPtr->next
+ loop
+ end if
+
+ ' Control End
+ if bLoadOnly = false then
+ pCtrl->SuspendLayout = true
+ ApplyControlProperties( @this, pCtrl )
+ pCtrl->SuspendLayout = false
+ end if
+
+ ctrlPtr = ctrlPtr->next
+ loop
+
+ end if
+
+ if filePtr then json.deleteptr(filePtr)
+
+ return 0
+
+end function
+
+
+' ========================================================================================
+' Parse all of the file's code to remove and process any visual designer specific code.
+' Returns a string representing just the code only (visual designer metastatements removed).
+' ========================================================================================
+function clsDocument.ParseFormMetaData( _
+ byval hWndParent as HWnd, _
+ byref wszAllText as wstring, _
+ byval bLoadOnly as boolean = false _
+ ) as CWSTR
+
+ ' NOTE: THIS FUNCTION IS STILL REQUIRED IN ORDER TO LOAD PRE-VERSION 3.02 FORM FILE
+ ' THAT ARE THEN UPGRADED BY WINFBE AFTER THEY ARE LOADED.
+
+ ' NOTE: The incoming wszAllText string is UTF-16 encoded. The resulting string that
+ ' is returned from this function is also UTF-16 encoded. All WinFBE form files
+ ' must be unicode encoded.
+
+ ' This function filters out all form metadata as well as any code generated code between
+ ' the two codegen tags:
+ ' ' WINFBE_CODEGEN_START
+ ' ' WINFBE_CODEGEN_END
+
+
+ dim pCtrl as clsControl ptr
+ dim pCtrlActive as clsControl ptr
+
+ dim as RECT rc, rcCtrl
+ dim as CWSTR wszControlType, wszPropName, wszPropValue, wszEventName
+ dim as CWSTR wst
+ dim as long nControlType, numLines, numOffsetLines
+ dim as boolean bIsValidControl = true
+
+ ' The first line MUST contain the identifier that this is a form file.
+
+ if left(wszAllText, 13) = "' WINFBE FORM" then
+ this.IsDesigner = true
+ ' Remove any previously created controls, etc otherwise reloading the form
+ ' file will result in duplicates.
+ if bLoadOnly = false then
+ if this.hWndForm then DestroyWindow(this.hWndForm)
+ if this.hWndFrame then DestroyWindow(this.hWndFrame)
+ if this.hWndDesigner then DestroyWindow(this.hWndDesigner)
+ this.CreateDesignerWindow(hWndParent)
+ end if
+ numOffsetLines = 1
+ else
+ ' This is just a regular code file with no visual designer
+ this.IsDesigner = false
+ return wszAllText
+ end if
+
+
+ ' Iterate all of the lines related to the visual designer
+ dim as long iLineStart = 1
+ dim as long iLineEnd, nextMenuItem, nextToolBarItem, nextPanelItem, nextImageItem
+
+ dim as boolean bReadingMenuItem, bReadingToolBarItem, bReadingPanelItem, bReadingImageItem
+
+ do until iLineStart >= len(wszAllText)
+
+ iLineend = instr(iLineStart, wszAllText, vbcrlf)
+ if iLineend = 0 then iLineend = len(wszAllText) ' cr/lf not found
+ wst = mid(wszAllText, iLineStart, iLineend - iLineStart)
+ iLineStart = iLineStart + len(wst) + len(vbcrlf)
+
+ numOffsetLines = numOffsetLines + 1
+
+ if left(wst, 16) = "' WINFBE VERSION" then
+ wszPropValue = trim(mid(wst, 17))
+ if ConvertWinFBEversion(wszPropValue) < ConvertWinFBEversion(APPVERSION) then
+ this.bRegenerateCode = true
+ this.UserModified = true
+ end if
+ this.wszFormVersion = wszPropValue
+
+ elseif left(wst, 15) = "' LOCKCONTROLS=" then
+ wszPropValue = mid(wst, 16) ' default is false
+ if wszPropValue = "true" then this.bLockControls = true
+
+ elseif left(wst, 12) = "' SNAPLINES=" then
+ wszPropValue = mid(wst, 13) ' default is true
+ if wszPropValue = "False" then this.bSnapLines = false
+
+ elseif left(wst, 17) = "' WINFBE FORM_END" then
+
+ elseif left(wst, 18) = "' MENUITEM_START" then
+ dim as long ub = ubound(this.MenuItems)
+ redim preserve this.MenuItems(ub + 1)
+ nextMenuItem = ub + 1
+ bReadingMenuItem = true
+ elseif left(wst, 21) = "' MAINMENU_DISPLAY=" then
+ this.GenerateMenu = val(mid(wst, 22))
+ elseif left(wst, 11) = "' NAME=" then
+ if bReadingMenuItem then this.MenuItems(nextMenuItem).wszName = mid(wst, 12)
+ elseif left(wst, 14) = "' CAPTION=" then
+ if bReadingMenuItem then this.MenuItems(nextMenuItem).wszCaption = mid(wst, 15)
+ elseif left(wst, 13) = "' INDENT=" then
+ if bReadingMenuItem then this.MenuItems(nextMenuItem).nIndent = val(mid(wst, 14))
+ elseif left(wst, 10) = "' ALT=" then
+ if bReadingMenuItem then this.MenuItems(nextMenuItem).chkAlt = val(mid(wst, 11))
+ elseif left(wst, 12) = "' SHIFT=" then
+ if bReadingMenuItem then this.MenuItems(nextMenuItem).chkShift = val(mid(wst, 13))
+ elseif left(wst, 11) = "' CTRL=" then
+ if bReadingMenuItem then this.MenuItems(nextMenuItem).chkCtrl = val(mid(wst, 12))
+ elseif left(wst, 15) = "' SHORTCUT=" then
+ if bReadingMenuItem then this.MenuItems(nextMenuItem).wszShortcut = mid(wst, 16)
+ elseif left(wst, 14) = "' CHECKED=" then
+ if bReadingMenuItem then this.MenuItems(nextMenuItem).chkChecked = val(mid(wst, 15))
+ elseif left(wst, 13) = "' GRAYED=" then
+ if bReadingMenuItem then this.MenuItems(nextMenuItem).chkGrayed = val(mid(wst, 14))
+ elseif left(wst, 16) = "' MENUITEM_END" then
+ bReadingMenuItem = false
+
+ elseif left(wst, 21) = "' TOOLBARITEM_START" then
+ dim as long ub = ubound(this.ToolBarItems)
+ redim preserve this.ToolBarItems(ub + 1)
+ nextToolBarItem = ub + 1
+ bReadingToolBarItem = true
+ elseif left(wst, 20) = "' TOOLBAR_DISPLAY=" then
+ this.GenerateToolBar = val(mid(wst, 21))
+ elseif left(wst, 17) = "' TOOLBAR_SIZE=" then
+ this.wszToolBarSize = mid(wst, 18)
+ elseif left(wst, 17) = "' BUTTONNAME=" then
+ if bReadingToolBarItem then this.ToolBarItems(nextToolBarItem).wszName = mid(wst, 18)
+ elseif left(wst, 17) = "' BUTTONTYPE=" then
+ if bReadingToolBarItem then this.ToolBarItems(nextToolBarItem).wszButtonType = mid(wst, 18)
+ elseif left(wst, 20) = "' BUTTONTOOLTIP=" then
+ if bReadingToolBarItem then this.ToolBarItems(nextToolBarItem).wszTooltip = mid(wst, 21)
+ elseif left(wst, 24) = "' BUTTONNORMALIMAGE=" then
+ if bReadingToolBarItem then this.ToolBarItems(nextToolBarItem).pPropNormalImage.wszPropValue = mid(wst, 25)
+ elseif left(wst, 21) = "' BUTTONHOTIMAGE=" then
+ if bReadingToolBarItem then this.ToolBarItems(nextToolBarItem).pPropHotImage.wszPropValue = mid(wst, 22)
+ elseif left(wst, 26) = "' BUTTONDISABLEDIMAGE=" then
+ if bReadingToolBarItem then this.ToolBarItems(nextToolBarItem).pPropDisabledImage.wszPropValue = mid(wst, 27)
+ elseif left(wst, 19) = "' TOOLBARITEM_END" then
+ bReadingToolBarItem = false
+
+
+ elseif left(wst, 19) = "' PANELITEM_START" then
+ dim as long ub = ubound(this.PanelItems)
+ redim preserve this.PanelItems(ub + 1)
+ nextPanelItem = ub + 1
+ bReadingPanelItem = true
+ elseif left(wst, 22) = "' STATUSBAR_DISPLAY=" then
+ this.GenerateStatusBar = val(mid(wst, 23))
+ elseif left(wst, 16) = "' PANELNAME=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszName = mid(wst, 17)
+ elseif left(wst, 16) = "' PANELTEXT=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszText = mid(wst, 17)
+ elseif left(wst, 19) = "' PANELTOOLTIP=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszTooltip = mid(wst, 20)
+ elseif left(wst, 21) = "' PANELALIGNMENT=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszAlignment = mid(wst, 22)
+ ' BorderStyle is deprecated as of v2.0.4 as it has no effect
+ ' in WinFBE programs where Windows Themes are enabled.
+ 'elseif left(wst, 23) = "' PANELBORDERSTYLE=" then
+ ' if bReadingPanelItem then this.PanelItems(nextPanelItem).wszBorderStyle = mid(wst, 24)
+ elseif left(wst, 20) = "' PANELAUTOSIZE=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszAutoSize = mid(wst, 21)
+ elseif left(wst, 17) = "' PANELWIDTH=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszWidth = mid(wst, 18)
+ elseif left(wst, 20) = "' PANELMINWIDTH=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszMinWidth = mid(wst, 21)
+ elseif left(wst, 17) = "' PANELIMAGE=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).pProp.wszPropValue = mid(wst, 18)
+ elseif left(wst, 21) = "' PANELBACKCOLOR=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszBackColor = mid(wst, 22)
+ elseif left(wst, 24) = "' PANELBACKCOLORHOT=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszBackColorHot = mid(wst, 25)
+ elseif left(wst, 21) = "' PANELFORECOLOR=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszForeColor = mid(wst, 22)
+ elseif left(wst, 24) = "' PANELFORECOLORHOT=" then
+ if bReadingPanelItem then this.PanelItems(nextPanelItem).wszForeColorHot = mid(wst, 25)
+ elseif left(wst, 17) = "' PANELITEM_END" then
+ bReadingPanelItem = false
+
+ elseif left(wst, 15) = "' IMAGE_START" then
+ dim as long ub = ubound(this.AllImages)
+ redim preserve this.AllImages(ub + 1)
+ nextImageItem = ub + 1
+ this.AllImages(nextImageItem).pDoc = @this
+ bReadingImageItem = true
+ elseif left(wst, 16) = "' IMAGENAME=" then
+ if bReadingImageItem then this.AllImages(nextImageItem).wszImageName = mid(wst, 17)
+ elseif left(wst, 15) = "' FILENAME=" then
+ if bReadingImageItem then
+ ' if this is a relative filename then convert it back.
+ dim as CWSTR wszImageFilename = ProcessFromCurdriveProject(mid(wst, 16))
+ if AfxPathIsRelative(wszImageFilename) then
+ wszImageFilename = AfxPathCombine( AfxStrPathName("PATH", this.DiskFilename), wszImageFilename)
+ end if
+ this.AllImages(nextImageItem).wszFileName = wszImageFilename
+ end if
+ elseif left(wst, 19) = "' RESOURCETYPE=" then
+ if bReadingImageItem then this.AllImages(nextImageItem).wszFormat = mid(wst, 20)
+ elseif left(wst, 13) = "' IMAGE_END" then
+ bReadingImageItem = false
+
+ elseif left(wst, 20) = "' WINFBE_CODEGEN_END" then
+ wszAllText = ltrim(AfxStrRemain( wszAllText, "' WINFBE_CODEGEN_END" ), vbcrlf)
+ return wszAllText
+
+ elseif left(wst, 23) = "' WINFBE CONTROL_START " then
+ ' The control type name is parse #4 (blank space)
+ wszControlType = AfxStrParse(wst, 4, " ")
+ nControlType = GetControlType(wszControlType)
+ if nControlType = 0 then
+ ' no longer a valid toolbox control
+ bIsValidControl = false
+ else
+ bIsValidControl = true
+ if bLoadOnly = true then
+ dim pCtrlTemp as clsControl ptr = new clsControl
+ pCtrlTemp->ControlType = nControlType
+ this.Controls.Add(pCtrlTemp)
+ else
+ pCtrl = CreateToolboxControl( @this, nControlType, rc )
+ pCtrlActive = pCtrl
+ end if
+ end if
+
+ elseif left(wst, 20) = "' WINFBE CONTROL_END" then
+ if bIsValidControl then
+ if bLoadOnly = false then
+ pCtrl->SuspendLayout = true
+ ApplyControlProperties( @this, pCtrl )
+ pCtrl->SuspendLayout = false
+ end if
+ end if
+
+ elseif left(wst, 16) = "' PROP_NAME=" then
+ if bIsValidControl then
+ wszPropName = mid(wst, 17)
+ end if
+
+ elseif left(wst, 17) = "' PROP_VALUE=" then
+ if bIsValidControl then
+ wszPropValue = mid(wst, 18) ' utf8 encoded
+ ' Only set the loading property if it exists in the current property
+ ' listing. We do this otherwise older now unused properties will continue
+ ' to get loaded when we no longer want them to.
+ if IsPropertyExists(pCtrl, wszPropName) = false then
+ ' Set the flag to regenerate code otherwise a compile time error
+ ' will occur because the old property could exist in previously generated code.
+ this.bRegenerateCode = true
+ else
+ SetControlProperty(pCtrl, wszPropName, wszPropValue)
+ end if
+ end if
+
+ elseif left(wst, 17) = "' EVENT_NAME=" then
+ if bIsValidControl then
+ wszEventName = mid(wst, 18)
+ SetControlEvent(pCtrl, wszEventName, true)
+ end if
+ end if
+
+ loop
+
+ return wszAllText
+
+end function
+
+
+''
+''
+function clsDocument.SaveFormJSONdata() as boolean
+ if this.IsDesigner = false then return true
+
+ dim pCtrl as clsControl ptr
+ dim as CWSTR wst
+ dim as CWSTR wcomma = ","
+
+ wst = _
+ qnum("form:true") & wcomma & _
+ qstr("version:3.0.2") & wcomma & _
+ qnum("lockcontrols:" & iif(this.bLockControls, "true", "false")) & wcomma & _
+ qnum("snaplines:" & iif(this.bSnapLines, "true", "false"))
+
+ ' Save Images(if applicable)
+ dim as long numImageItems = ubound(this.AllImages) - lbound(this.AllImages) + 1
+ if numImageItems > 0 then
+ wst = wst & wcomma & _
+ qnum("images: [")
+ for ii as long = lbound(this.AllImages) to ubound(this.AllImages)
+ dim as CWSTR wszRelative
+ dim as CWSTR wszImageFilename = this.AllImages(ii).wszFilename
+
+ ' Attempt to convert the image file name to relative path
+ if AfxFileExists( this.DiskFilename ) then
+ wszRelative = AfxPathRelativePathTo( this.DiskFilename, FILE_ATTRIBUTE_NORMAL, wszImageFilename, FILE_ATTRIBUTE_NORMAL)
+ if AfxPathIsRelative(wszRelative) then wszImageFilename = wszRelative
+ end if
+
+ wst = wst & _
+ "{" & _
+ qstr("imagename:" & this.AllImages(ii).wszImageName) & wcomma & _
+ qstr("filename:" & AfxStrReplace(ProcessToCurdriveProject(wszImageFilename), "\", "\\")) & wcomma & _
+ qstr("resourcetype:" & this.AllImages(ii).wszFormat) & _
+ "},"
+ next
+ wst = rtrim(wst, ",") & "]"
+ end if
+
+ ' Save MainMenu (if applicable)
+ dim as long numMenuItems = ubound(this.MenuItems) - lbound(this.MenuItems) + 1
+ if numMenuItems > 0 then
+ wst = wst & wcomma & _
+ qnum("mainmenu:{") & _
+ qnum("display:" & iif(this.GenerateMenu, "true", "false")) & wcomma
+
+ wst = wst & _
+ qnum("items: [")
+ for ii as long = lbound(this.MenuItems) to ubound(this.MenuItems)
+ ' Skip any "blank" lines that may have been added from the Menu Editor
+ if rtrim(this.MenuItems(ii).wszName) = "" then continue for
+
+ wst = wst & _
+ "{" & _
+ qstr("name:" & this.MenuItems(ii).wszName) & wcomma & _
+ qstr("caption:" & this.MenuItems(ii).wszCaption) & wcomma & _
+ qnum("indent:" & this.MenuItems(ii).nIndent) & wcomma & _
+ qnum("alt:" & this.MenuItems(ii).chkAlt) & wcomma & _
+ qnum("shift:" & this.MenuItems(ii).chkShift) & wcomma & _
+ qnum("ctrl:" & this.MenuItems(ii).chkCtrl) & wcomma & _
+ qstr("shortcut:" & this.MenuItems(ii).wszShortcut) & wcomma & _
+ qnum("checked:" & this.MenuItems(ii).chkChecked) & wcomma & _
+ qnum("grayed:" & this.MenuItems(ii).chkGrayed) & _
+ "},"
+ next
+ wst = rtrim(wst, ",") & "]}"
+ end if
+
+ ' Save ToolBar items (if applicable)
+ dim as long numToolBarItems = Ubound(this.ToolBarItems) - lbound(this.ToolBarItems) + 1
+ if numToolBarItems > 0 then
+ wst = wst & wcomma & _
+ qnum("toolbar:{") & _
+ qnum("display:" & iif(this.GenerateToolBar, "true", "false")) & wcomma & _
+ qstr("size:" & this.wszToolBarSize) & wcomma
+
+ wst = wst & _
+ qnum("items: [")
+ for ii as long = lbound(this.ToolBarItems) to ubound(this.ToolBarItems)
+ wst = wst & _
+ "{" & _
+ qstr("name:" & this.ToolBarItems(ii).wszName) & wcomma & _
+ qstr("type:" & this.ToolBarItems(ii).wszButtonType) & wcomma & _
+ qstr("tooltip:" & this.ToolBarItems(ii).wszTooltip) & wcomma & _
+ qstr("hotimage:" & this.ToolBarItems(ii).pPropHotImage.wszPropValue) & wcomma & _
+ qstr("normalimage:" & this.ToolBarItems(ii).pPropNormalImage.wszPropValue) & wcomma & _
+ qstr("disabledimage:" & this.ToolBarItems(ii).pPropDisabledImage.wszPropValue) & _
+ "},"
+ next
+ wst = rtrim(wst, ",") & "]}"
+ end if
+
+
+ ' Save StatusBar Panels (if applicable)
+ dim as long numPanelItems = Ubound(this.PanelItems) - lbound(this.PanelItems) + 1
+ if numPanelItems > 0 then
+ wst = wst & wcomma & _
+ qnum("statusbar:{") & _
+ qnum("display:" & iif(this.GenerateStatusBar, "true", "false")) & wcomma
+
+ wst = wst & _
+ qnum("items: [")
+ for ii as long = lbound(this.PanelItems) to ubound(this.PanelItems)
+ wst = wst & _
+ "{" & _
+ qstr("name:" & this.PanelItems(ii).wszName) & wcomma & _
+ qstr("text:" & this.PanelItems(ii).wszText) & wcomma & _
+ qstr("tooltip:" & this.PanelItems(ii).wszTooltip) & wcomma & _
+ qstr("alignment:" & this.PanelItems(ii).wszAlignment) & wcomma & _
+ qstr("autosize:" & this.PanelItems(ii).wszAutoSize) & wcomma & _
+ qstr("width:" & this.PanelItems(ii).wszWidth) & wcomma & _
+ qstr("minwidth:" & this.PanelItems(ii).wszMinWidth) & wcomma & _
+ qstr("image:" & this.PanelItems(ii).pProp.wszPropValue) & wcomma & _
+ qstr("backcolor:" & this.PanelItems(ii).wszBackColor) & wcomma & _
+ qstr("backcolorhot:" & this.PanelItems(ii).wszBackColorHot) & wcomma & _
+ qstr("forecolor:" & this.PanelItems(ii).wszForeColor) & wcomma & _
+ qstr("forecolorhot:" & this.PanelItems(ii).wszForeColorHot) & _
+ "},"
+ ' BorderStyle is deprecated as of v2.0.4 as it has no effect
+ ' in WinFBE programs where Windows Themes are enabled.
+ '"' PANELBORDERSTYLE=" & this.PanelItems(ii).wszBorderStyle & vbcrlf & _
+ next
+ wst = rtrim(wst, ",") & "]}"
+ end if
+
+
+ ' Iterate all of the controls on the form
+ if this.Controls.Count then
+ wst = wst & wcomma & _
+ qnum("controls:[")
+
+ ' We want to ensure that we output code for the Form first because
+ ' when the form is loaded the controls need to attach themselves
+ ' to the form that must exist otherwise a GPF will occur.
+ dim bOutputForm as boolean = true
+ for numLoops as long = 1 to 2
+ ' First time through the loop we get the Form data. The second time through
+ ' we get everything except for the form.
+ for i as long = this.Controls.ItemFirst to this.Controls.ItemLast
+ pCtrl = this.Controls.ItemAt(i)
+ if pCtrl then
+ if bOutputForm = true then
+ if pCtrl->ControlType <> CTRL_FORM then continue for
+ elseif bOutputForm = false then
+ if pCtrl->ControlType = CTRL_FORM then continue for
+ end if
+
+ wst = wst & _
+ "{" & _
+ qstr("type:" & GetToolBoxName(pCtrl->ControlType)) & wcomma & _
+ qnum("properties: [")
+
+ for ii as long = lbound(pCtrl->Properties) to ubound(pCtrl->Properties)
+ wst = wst & "{" & _
+ qstr("name:" & pCtrl->Properties(ii).wszPropName) & wcomma & _
+ qstr("value:" & pCtrl->Properties(ii).wszPropValue) & _
+ "},"
+ next
+
+ wst = rtrim(wst, ",") & "]," & _
+ qnum("events: [")
+
+ for ii as long = lbound(pCtrl->Events) to ubound(pCtrl->Events)
+ ' Only need to output the names of the Events that have been ticked as being in use.
+ if pCtrl->Events(ii).bIsSelected then
+ if rtrim(pCtrl->Events(ii).wszEventName) > "" then
+ wst = wst & "{" & _
+ qstr("name:" & pCtrl->Events(ii).wszEventName) & _
+ "},"
+ end if
+ end if
+ next
+ wst = rtrim(wst, ",") & "]"
+
+ end if
+
+ wst = wst & "},"
+ next
+
+ bOutputForm = false
+ next
+
+ wst = rtrim(wst, ",") & "]"
+ end if
+
+ ' Convert UTF-16 to UTF-8 encoding
+ wst = "{" & wst & "}"
+
+ '// Per email from "Allan" on Jan 14, 2023, changes I made to UnicodeToUtf8
+ '// function (eliminating the ending Trim(0), and use BytesWritten instead) seems to be
+ '// the reason for the Chinese characters now writing 100% correctly.
+ dim pStream as CTextStream
+ if pStream.Create(this.DesignerFilename, true, false) <> S_OK then return true ' error
+ pStream.WriteLine( UnicodeToUtf8(wst) )
+ pStream.Close
+
+ function = false
+end function
+
+
+''
+''
+function clsDocument.SaveFile( _
+ byval bSaveAs as boolean = false, _
+ byval bAutoSaveOnly as boolean = false _
+ ) as boolean
+
+ dim sText as string
+ dim wszFilename as wstring * MAX_PATH
+ dim wszAutoSaveFilename as wstring * MAX_PATH
+ dim wszExtension as wstring * MAX_PATH
+ dim wszText as wstring * MAX_PATH
+ dim wst as CWSTR
+
+ ' don't allow the AutoSave timer to be re-entrant on this function
+ ' while a save is currently taking place.
+ static bAutoSaveIsActive as boolean
+ if bAutoSaveOnly andalso bAutoSaveIsActive then exit function
+ bAutoSaveIsActive = true
+
+ ' if this is a new Untitled document then set flag to display SaveAs dialog.
+ if this.IsNewFlag then bSaveAs = true
+
+ ' Don't let AutoSave allow bSaveAs
+ if bAutoSaveOnly then bSaveAs = false
+
+ wszFilename = this.Diskfilename
+ wszAutoSaveFilename = this.AutoSaveFilename
+
+ if bSaveAs then
+ ' if this is a new Form being saved for the first time then the extension should
+ ' be .bas if no project is active, and .inc if a project is active.
+ if this.IsNewFlag then
+ if this.IsDesigner then
+ wszExtension = iif(gApp.IsProjectActive, "inc", "bas")
+ end if
+ end if
+ ' Display the Save File Dialog
+ dim pwszName as wstring ptr = AfxIFileSaveDialog(HWND_FRMMAIN, @wszFilename, @wszExtension, IDM_FILESAVEAS)
+ if pwszName then
+ wszFilename = *pwszName
+ CoTaskMemFree(pwszName)
+ this.bNeedsParsing = true
+ else
+ return false
+ end if
+ end if
+
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+
+ ' if pSci does not exist then this file exists in the Explorer but has not yet been
+ ' displayed in order to create a Scintilla window. Simply need to exit.
+ if pSci = 0 then return true
+
+ ' Save text buffer to disk by directly accessing buffer rather
+ ' saving it to an intermediary string variable first.
+ dim as zstring ptr psz = cast( zstring ptr, SciExec(this.hWindow(0), SCI_GETCHARACTERPOINTER, 0, 0) )
+ dim as long sciCodePage = SciMsg(pSci, SCI_GETCODEPAGE, 0, 0) ' 0 or SC_CP_UTF8
+
+ dim as CWSTR wszSaveFilename
+ if bAutoSaveOnly then
+ if AfxFileExists(wszAutoSaveFilename) then AfxDeleteFile(wszAutoSaveFilename)
+ wszSaveFilename = wszAutoSaveFilename
+ else
+ ' If we are upgrading to v3.02+ then save the original file because the original
+ ' file format has visual designer and code all in one file.
+ ' Save a copy of the original file to the backup in the event that there is
+ ' issues with the upgrade process. Fail if backup already exists.
+ if this.IsDesigner then
+ if (ConvertWinFBEversion(this.wszFormVersion) >= ConvertWinFBEversion("3.0.2")) orelse _
+ (ConvertWinFBEversion(this.wszFormVersion) = 0) then 'b/c upgraded form files do not have version loaded yet
+ ' We are already using new form file format
+ else
+ dim as CWSTR wszBackupFilename = this.DiskFilename & ".backup-before-upgrade"
+ AfxCopyFile( this.DiskFilename, wszBackupFilename, CTRUE )
+ end if
+ end if
+
+ ' ensure any previously created AutoSave files are delete should
+ ' the user had chosen a new filename
+ if AfxFileExists(wszFilename) then AfxDeleteFile(wszFilename)
+ if AfxFileExists(wszAutoSaveFilename) then AfxDeleteFile(wszAutoSaveFilename)
+ wszSaveFilename = wszFilename
+ end if
+
+
+ dim pStream as CFileStream
+ if pStream.Open(wszSaveFilename, STGM_CREATE or STGM_WRITE) = S_OK then
+ dim as string st
+ select case this.FileEncoding
+ case FILE_ENCODING_ANSI
+ if sciCodePage = 0 then
+ pStream.Write psz, len(*psz) ' no conversion necessary
+ else
+ ' need to convert
+ st = Utf8ToAscii(*psz)
+ pStream.Write strptr(st), len(st)
+ end if
+
+ case FILE_ENCODING_UTF8_BOM
+ ' Output the BOM first
+ st = chr(&HEF, &HBB, &HBF)
+ pStream.Write strptr(st), len(st)
+ if sciCodePage = SC_CP_UTF8 then
+ ' no conversion necessary
+ pStream.Write psz, len(*psz) ' no conversion necessary
+ else
+ ' need to convert
+ st = AnsiToUtf8(*psz)
+ pStream.Write strptr(st), len(st)
+ end if
+
+ case FILE_ENCODING_UTF16_BOM
+ ' Output the BOM first
+ st = chr(&HFF, &HFE)
+ pStream.Write strptr(st), len(st)
+ if sciCodePage = SC_CP_UTF8 then
+ ' convert utf8 to utf16
+ wst.Utf8 = *psz ' convert the utf *psz from Utf8
+ pStream.Write wst.m_pBuffer, wst.m_BufferLen
+ else
+ ' need to convert ansi to unicode
+ dim as CWSTR wst = Wstr(*psz)
+ pStream.Write wst.m_pBuffer, wst.m_BufferLen
+ end if
+
+ end SELECT
+ end if
+ pStream.Close
+
+ this.DiskFilename = wszFilename
+ this.DesignerFilename = wszFilename & ".design"
+ this.AutoSaveFilename = OnCommand_FileAutoSaveGenerateFilename(wszFilename)
+ this.DateFileTime = AfxGetFileLastWriteTime( wszFilename )
+ this.AutoSaveRequired = false
+
+ if this.IsDesigner then this.SaveFormJSONdata()
+
+ ' if this was a new document then it needs to be saved to Recent File list.
+ if this.IsNewFlag then
+ if gApp.IsProjectActive = false then
+ UpdateMRUList(wszFilename)
+ end if
+ end if
+ this.IsNewFlag = false
+
+ ' Set the current state of the document to unmodified
+ if bAutoSaveOnly = false then
+ this.UserModified = false
+ SciMsg( pSci, SCI_SETSAVEPOINT, 0, 0)
+ end if
+
+ bAutoSaveIsActive = false
+
+ function = true
+end function
+
+
+''
+''
+function clsDocument.GetTextRange( _
+ byval cpMin as long, _
+ byval cpMax as long _
+ ) as string
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim p as long
+ dim buffer as string
+ dim txtrg as SCI_TEXTRANGE
+ txtrg.chrg.cpMin = cpMin
+ txtrg.chrg.cpMax = cpMax
+ buffer = space(cpMax - cpMin + 1)
+ txtrg.lpstrText = strptr(buffer)
+ SciMsg(pSci, SCI_GETTEXTRANGE, 0, cast(LPARAM, @txtrg))
+ p = instr(buffer, chr(0))
+ if p then buffer = left(buffer, p - 1)
+ function = buffer
+end function
+
+''
+''
+function clsDocument.ChangeSelectionCase( byval fcase as long) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim startSelPos as long ' Starting position
+ dim endSelPos as long ' Ending position
+ dim strText as string ' Selected text
+ dim i as long
+
+ ' fcase = 1 (upper case), 2 (lower case), 3 (mixed case)
+ if (fcase < 1) or (fcase > 3) then exit function
+
+ ' if startSelPos and endSelPos are the same there is not selection,
+ startSelPos = SciMsg( pSci, SCI_GETSELECTIONSTART, 0, 0)
+ endSelPos = SciMsg( pSci, SCI_GETSELECTIONEND, 0, 0)
+ if startSelPos = endSelPos then exit function
+
+ ' Retrieve the text
+ strText = this.GetTextRange(startSelPos, endSelPos)
+
+ ' Convert it to upper, lower case, or mixed case
+ if fcase = 1 then
+ strText = ucase(strText)
+ elseif fcase = 2 then
+ strText = LCase(strText)
+ elseif fcase = 3 then
+ ' Always uppercase the first character regardless
+ strText = LCase(strText)
+ mid(strText,1,1) = ucase(mid(strText,1,1))
+ dim as string prevChar
+ for i as long = 2 to len(strText)
+ prevChar = mid(strText,i-1,1)
+ select case prevChar
+ case chr(13), chr(10), " "
+ mid(strText,i,1) = ucase(mid(strText,i,1))
+ end select
+ next
+ end if
+
+ ' Replace the selected text
+ SciMsg( pSci, SCI_REPLACESEL, 0, cast(LPARAM, strptr(strText)))
+
+ function = 0
+end function
+
+''
+''
+function clsDocument.SetMarkerHighlight() as long
+ ' Set a marker that will highlight the background of the current selection. This
+ ' is used when we are attempting to search a selection. We want the current search
+ ' area to be a different color than the regular highlighted text because any
+ ' search results are colored using the normal highlight colors so we need them
+ ' to stand out from the selected range.
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_MARKERDELETEALL, 10, 0) ' Remove any existing before drawing the new highlight
+ dim as long startPos, endPos, startLine, endLine
+ this.GetSelectedLineRange( startLine, endLine, startPos, endPos )
+ if endLine <> startLine then
+ SciMsg( pSci, SCI_MARKERDEFINE, 10, SC_MARK_BACKGROUND ) ' define as marker #10
+ SciMsg( pSci, SCI_SETMARGINMASKN, 4, &H400 ) ' set margin mask to allow SC_MARK_BACKGROUND
+ for i as long = startLine to endLine
+ function = SciMsg( pSci, SCI_MARKERADD, i, 10) ' add defined marker #10 to each line
+ next
+ ' set backcolor of marker #10
+ dim as COLORREF clr = ghEditor.BackColorSelection
+ SciMsg( pSci, SCI_MARKERSETBACK, 10, clr)
+ end if
+end function
+
+''
+''
+function clsDocument.RemoveMarkerHighlight() as long
+ ' Remove any markers that were set in the document that signify a highlighted range.
+ ' This is used when we are attempting to search a selection.
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ function = SciMsg( pSci, SCI_MARKERDELETEALL, 10, 0) ' delete all marker #10
+end function
+
+''
+''
+function clsDocument.FirstMarkerHighlight() as long
+ ' Get the first line with marker #10 highlight
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim as long markerMask
+ markerMask = bitset(markerMask, 10)
+ function = SciMsg( pSci, SCI_MARKERNEXT, 0, markerMask)
+end function
+
+''
+''
+function clsDocument.LastMarkerHighlight() as long
+ ' Get the first line with marker #10 highlight
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim as long nLastPos = SciMsg( pSci, SCI_GETTEXTLENGTH, 0, 0)
+ dim as long nLastLine = SciMsg( pSci, SCI_LINEFROMPOSITION, nLastPos, 0)
+ dim as long markerMask
+ markerMask = bitset(markerMask, 10)
+ function = SciMsg( pSci, SCI_MARKERPREVIOUS, nLastLine, markerMask)
+end function
+
+''
+''
+function clsDocument.HasMarkerHighlight() as boolean
+ ' true/False if selection markers exist in the document search for marker #10
+ function = iif(this.FirstMarkerHighlight = -1, false, true)
+end function
+
+''
+''
+function clsDocument.GetCurrentLineNumber() as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim nPos as long = SciMsg( pSci, SCI_GETCURRENTPOS, 0, 0)
+ function = SciMsg( pSci, SCI_LINEFROMPOSITION, nPos, 0)
+end function
+
+''
+''
+function clsDocument.SelectLine( byval nLineNum as long ) as long
+ ' select the incoming nLineNum. if nLineNum is negative then select the current line
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ nLineNum = iif( nLineNum < 0, this.GetCurrentLineNumber, nLineNum)
+ dim nStartPos as long = SciMsg( pSci, SCI_POSITIONFROMLINE, nLineNum, 0)
+ dim nEndPos as long = SciMsg( pSci, SCI_GETLINEENDPOSITION, nLineNum, 0)
+ SciMsg( pSci, SCI_SETSELECTIONSTART, nStartPos, 0)
+ SciMsg( pSci, SCI_SETSELECTIONEND, nEndPos, 0)
+ function = 0
+end function
+
+''
+''
+function clsDocument.GetLine( byval nLine as long ) as string
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim nLen as long
+ dim buffer as string
+ nLen = SciMsg( pSci, SCI_LINELENGTH, nLine , 0)
+ if nLen < 1 then exit function
+ buffer = space(nLen)
+ SciMsg( pSci, SCI_GETLINE, nLine, cast(LPARAM, strptr(buffer)))
+ function = rtrim(buffer, any chr(13,10,0))
+end function
+
+''
+''
+function clsDocument.SetLine( byval nLineNum as long, byval sText as string) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim nStartPos as long = SciMsg( pSci, SCI_POSITIONFROMLINE, nLineNum, 0)
+ dim nEndPos as long = SciMsg( pSci, SCI_GETLINEENDPOSITION, nLineNum, 0)
+ SciMsg( pSci, SCI_SETTARGETSTART, nStartPos, 0)
+ SciMsg( pSci, SCI_SETTARGETEND, nEndPos, 0)
+ SciMsg( pSci, SCI_REPLACETARGET, len(sText), cast(LPARAM, strptr(sText)))
+ function = 0
+end function
+
+''
+''
+function clsDocument.GetSelText() as string
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim nLen as long
+ dim buffer as string
+ nLen = SciMsg( pSci, SCI_GETSELTEXT, 0, 0)
+ if nLen < 1 then exit function
+ buffer = space(nLen)
+ SciMsg( pSci, SCI_GETSELTEXT, 0, cast(LPARAM, strptr(buffer)))
+ function = trim(buffer, chr(0))
+end function
+
+''
+''
+function clsDocument.GetText() as string
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim nLen as long
+ dim buffer as string
+ nLen = SciMsg( pSci, SCI_GETLENGTH, 0 , 0)
+ if nLen < 1 then exit function
+ buffer = space(nLen+1)
+ SciMsg( pSci, SCI_GETTEXT, nLen+1, cast(LPARAM, strptr(buffer)) )
+ function = trim(buffer, chr(0))
+end function
+
+''
+''
+function clsDocument.SetText( byref sText as const string ) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_SETTEXT, 0, cast(LPARAM, strptr(sText)) )
+ SciMsg( pSci, SCI_COLOURISE, 0, -1 )
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.AppendText( byref sText as const string ) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_APPENDTEXT, len(sText), cast(LPARAM, strptr(sText)) )
+ SciMsg( pSci, SCI_COLOURISE, 0, -1 )
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.CenterCurrentLine() as long
+ ' Center the current line to the middle of the visible screen. This is useful
+ ' when searching and finding text. The found text will always display in the
+ ' middle of the screen.
+ if gConfig.PositionMiddle = 0 then exit function
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim as long numLinesOnScreen = SciMsg( pSci, SCI_LINESONSCREEN, 0, 0)
+ dim as long nMiddle = (this.GetCurrentLineNumber - (numLinesOnScreen / 2) + 1)
+ SciMsg( pSci, SCI_SETFIRSTVISIBLELINE, nMiddle, 0)
+ function = 0
+end function
+
+
+
+''
+'' IsFunctionLine
+''
+'' Determine if incoming line number is the start of a valid sub/function.
+'' By default we assume every line will be a valid function in order to
+'' make the comparisons easier. The value returned is the position
+'' immediately after the declaration (0 if not found). This is useful
+'' because this function can then also be used for determining the
+'' actual sub/function name rather than having to code a separate function
+'' to do the same comparisons.
+''
+function clsDocument.IsFunctionLine( byval lineNum as long ) as long
+
+ ' default that no function declaration found
+ dim as long position = 0
+
+ ' trim and remove double spaces and replace TABs with single space
+ dim as string lineText = this.GetLine( lineNum )
+ if len( lineText ) < 4 then exit function
+ lineText = ltrim(ucase( AfxStrShrink(lineText, chr(32,9)) ))
+ if len( lineText ) < 4 then exit function
+
+ if left( lineText, 9 ) = "FUNCTION " then
+ ' bypass any line with = that is a "function = " line.
+ dim as string subText = ltrim( mid(lineText, 9) )
+ if left( subText, 1 ) <> "=" then position = 10
+ elseif left(lineText, 17) = "PRIVATE FUNCTION " then
+ position = 18
+ elseif left(lineText, 16) = "PUBLIC FUNCTION " then
+ position = 17
+ elseif left(lineText, 4) = "SUB " then
+ position = 5
+ elseif left(lineText, 12) = "PRIVATE SUB " then
+ position = 13
+ elseif left(lineText, 11) = "PUBLIC SUB " then
+ position = 12
+ elseif left(lineText, 9) = "PROPERTY " then
+ ' bypass any line with = that is a "PROPERTY = " line.
+ dim as string subText = ltrim( mid(lineText, 9) )
+ if left( subText, 1 ) <> "=" then position = 10
+ elseif left(lineText, 17) = "PRIVATE PROPERTY " then
+ position = 18
+ elseif left(lineText, 12) = "CONSTRUCTOR " then
+ position = 13
+ elseif left(lineText, 11) = "DESTRUCTOR " then
+ position = 12
+
+ ' if we encounter one of these end statements then our cursor must
+ ' be positioned between functions (ie we're at the module level).
+ elseif left(lineText, 12) = "END FUNCTION" then
+ position = -1
+ elseif left(lineText, 7) = "END SUB" then
+ position = -1
+ elseif left(lineText, 15) = "END CONSTRUCTOR" then
+ position = -1
+ elseif left(lineText, 14) = "END DESTRUCTOR" then
+ position = -1
+ elseif left(lineText, 12) = "END PROPERTY" then
+ position = -1
+
+ end if
+
+ function = position
+end function
+
+
+' ========================================================================================
+' Determine the sub/function name based on the current editing position
+' within the file. This is needed by CodeTips (DereferenceLine) and for code navigation
+' in the editor to set the functions ComboBox to the correct item.
+' ========================================================================================
+function clsDocument.GetCurrentfunctionName( _
+ byref sfunctionName as string, _
+ byref nGetSet as ClassProperty _
+ ) as long
+
+ dim as string lineText
+ dim as string funcName
+ dim as string funcParams
+
+ dim as long curLine
+ dim as long position
+
+ ' search up the file until we find the start of a sub/function or start of file.
+ curLine = this.GetCurrentLineNumber
+ nGetSet = ClassProperty.None
+
+ for i as long = curLine to 0 step -1
+ position = this.IsfunctionLine( i )
+
+ if position = -1 then
+ ' We found an "end SUB", "end function", "end PROPERTY" line. Keep looking for
+ ' the very next instance of SUB/function and then break out of loop
+ ' with that function name.
+ if i = this.GetCurrentLineNumber then
+ continue for
+ else
+ exit for
+ end if
+
+ elseif position = 0 then
+ ' Just a regular line... keep looking...
+
+ elseif position > 0 then
+ ' We found a valid SUB/function line so process it
+ ' trim and remove double spaces and replace TABs with single space
+ lineText = ltrim(ucase( AfxStrShrink(this.GetLine(i), chr(32,9)) ))
+ funcName = ltrim(mid(lineText, position))
+ funcName = AfxStrParseAny( funcName, 1, " (" )
+
+ ' if this is a Property then we need to differentiate between a Get/Set
+ if ( left(lineText, 9) = "PROPERTY " ) orelse _
+ ( left(lineText, 17) = "PRIVATE PROPERTY " ) then
+ ' if funcParams exist then this must be a Set property. Need to sanitize the
+ ' property parameters first. Need to get the starting ( and the ending ) and
+ ' evaluate the text between it. Not as easy as using Parse because there could
+ ' be embedded array() parameters and the property could end in something like
+ ' as long, etc.
+ dim as string st
+ dim as string sFuncParams = lineText
+ dim as long p1, p2
+ p1 = instr( sFuncParams, "(" )
+ p2 = InstrRev( sFuncParams, ")" )
+ if ( p1 = 0 ) orelse (p2 = 0 ) then
+ st = ""
+ elseif p2 > p1 then
+ st = mid( sFuncParams, p1, p2 - p1 )
+ end if
+ st = trim( st, any "( )" )
+ if len( st ) then
+ nGetSet = ClassProperty.Setter
+ else
+ nGetSet = ClassProperty.Getter
+ end if
+
+ elseif ( left(lineText, 12) = "CONSTRUCTOR " ) then
+ nGetSet = ClassProperty.ctor
+
+ elseif ( left(lineText, 11) = "DESTRUCTOR " ) then
+ nGetSet = ClassProperty.dtor
+ end if
+
+ exit for
+ end if
+ next
+
+ sfunctionName = funcName
+ nGetSet = nGetSet
+
+ function = 0
+end function
+
+
+''
+'' GotoNextfunction
+''
+'' Go to the next sub/function in the document
+''
+function clsDocument.GotoNextFunction() as long
+ dim as long curLine = this.GetCurrentLineNumber
+ dim as long maxLines = this.GetLineCount - 1
+ dim as long newLine = curLine
+
+ for i as long = curLine + 1 to maxLines
+ if this.IsfunctionLine( i ) > 0 then
+ newLine = i
+ exit for
+ end if
+ next
+
+ ' if we have found a new line then reposition to that line
+ if newLine <> curLine then
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_SETFIRSTVISIBLELINE, newLine - 5, 0)
+ SciMsg( pSci, SCI_GOTOLINE, newLine, 0)
+ end if
+
+ function = 0
+end function
+
+
+''
+'' GotoPrevfunction
+''
+'' Go to the previous sub/function in the document
+''
+function clsDocument.GotoPrevFunction() as long
+ dim as long curLine = this.GetCurrentLineNumber
+ dim as long newLine = curLine
+
+ for i as long = curLine - 1 to 0 step -1
+ if this.IsFunctionLine( i ) > 0 then
+ newLine = i
+ exit for
+ end if
+ next
+
+ ' if we have found a new line then reposition to that line
+ if newLine <> curLine then
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_SETFIRSTVISIBLELINE, newLine - 5, 0)
+ SciMsg( pSci, SCI_GOTOLINE, newLine, 0)
+ end if
+
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.GetSelectedLineRange( _
+ byref startLine as long, _
+ byref endLine as long, _
+ byref startPos as long, _
+ byref endPos as long _
+ ) as long
+
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ startPos = SciMsg( pSci, SCI_GETSELECTIONSTART, 0, 0)
+ endPos = SciMsg( pSci, SCI_GETSELECTIONEND, 0, 0)
+ startLine = SciMsg( pSci, SCI_LINEFROMPOSITION, startPos, 0)
+ endLine = SciMsg( pSci, SCI_LINEFROMPOSITION, endPos, 0)
+
+ dim nCol as long = SciMsg( pSci, SCI_GETCOLUMN, endPos, 0)
+ if (nCol = 0) and (endLine > startLine) then endLine = endLine - 1
+
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.BlockComment( byval flagBlock as boolean ) as long
+ dim i as long ' loop counter
+ dim firstPos as long ' Starting position of the line
+ dim startPos as long ' Starting position of selection
+ dim endPos as long ' Ending position of selection
+ dim startLine as long ' Starting line number
+ dim endLine as long ' Ending line number
+ dim nPos as long ' Position
+ dim strText as string ' Portion of the line to replace
+ dim strNewText as string ' new text to insert or delete
+ dim nCount as long ' Number of "'" added or removed
+
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' flagBlock = true for Blocking comment, false for UnBlocking comment
+ this.GetSelectedLineRange( startLine, endLine, startPos, endPos )
+
+ gApp.SuppressNotify = true
+ SetWindowRedraw( this.hWndActiveScintilla, false )
+ SciMsg( pSci, SCI_BEGINUNDOACTION, 0, 0)
+ for i = startLine to endLine
+ strText = this.GetLine(i)
+ if flagBlock = false then
+ ' unblock comment
+ if left(strText, 1) <> "'" then
+ continue For
+ else
+ firstpos = SciMsg( pSci, SCI_POSITIONFROMLINE, i, 0 )
+ SciMsg( pSci, SCI_DELETERANGE, firstpos, cast(LPARAM, 1) )
+ end if
+ nCount += 1
+ else
+ ' block comment
+ if len(rtrim(strText)) then
+ strNewText = "'"
+ firstpos = SciMsg( pSci, SCI_POSITIONFROMLINE, i, 0 )
+ SciMsg( pSci, SCI_INSERTTEXT, firstpos, cast(LPARAM, strptr(strNewText)) )
+ nCount += 1
+ end if
+ end if
+ next
+ SciMsg( pSci, SCI_ENDUNDOACTION, 0, 0)
+
+ if startPos <> endPos then
+ SciMsg( pSci, SCI_SETSELECTIONSTART, startPos, 0)
+ SciMsg( pSci, SCI_SETSELECTIONEND, endPos + iif(flagBlock, nCount, -nCount), 0)
+ else
+ SciMsg( pSci, SCI_SETSELECTIONSTART, endPos + iif(flagBlock, nCount, -nCount), 0)
+ SciMsg( pSci, SCI_SETSELECTIONEND, endPos + iif(flagBlock, nCount, -nCount), 0)
+ end if
+
+ SetWindowRedraw( this.hWndActiveScintilla, true )
+ gApp.SuppressNotify = false
+ AfxRedrawWindow( this.hWndActiveScintilla )
+
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.CurrentLineUp() as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim currentLine as long = this.GetCurrentLineNumber()
+ if (currentLine <> 0) then
+ SciMsg( pSci, SCI_BEGINUNDOACTION, 0, 0)
+ currentLine = currentLine -1
+ SciMsg( pSci, SCI_LINETRANSPOSE, 0, 0)
+ SciMsg( pSci, SCI_GOTOLINE, currentLine, 0)
+ SciMsg( pSci, SCI_ENDUNDOACTION, 0, 0)
+ end if
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.GetLineCount() as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ function = SciMsg( pSci, SCI_GETLINECOUNT, 0, 0)
+end function
+
+
+''
+''
+function clsDocument.CurrentLineDown() as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim currentLine as long = this.GetCurrentLineNumber()
+ if currentLine <> SciMsg( pSci, SCI_GETLINECOUNT, 0, 0) - 1 then
+ SciMsg( pSci, SCI_BEGINUNDOACTION, 0, 0)
+ currentLine = currentLine + 1
+ SciMsg( pSci, SCI_GOTOLINE, currentLine, 0)
+ SciMsg( pSci, SCI_LINETRANSPOSE, 0, 0)
+ SciMsg( pSci, SCI_ENDUNDOACTION, 0, 0)
+ end if
+ function = 0
+end function
+
+''
+''
+function clsDocument.MoveCurrentLines( byval flagMoveDown as boolean ) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ if flagMoveDown then
+ SciMsg( pSci, SCI_MOVESELECTEDLINESDOWN, 0, 0)
+ else
+ SciMsg( pSci, SCI_MOVESELECTEDLINESUP, 0, 0)
+ end if
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.NewLineBelowCurrent() as long
+ ' From anywhere on the current line creates a new line immediately
+ ' below the current line and positions the cursor to the start of
+ ' that new line.
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_LINEEND, 0, 0)
+ SciMsg( pSci, SCI_NEWLINE, 0, 0)
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.ToggleBookmark( byval nLine as long ) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim fMark as long ' must be a 32 bit value
+ fMark = SciMsg( pSci, SCI_MARKERGET, nLine, 0 )
+ if bit(fMark, 0) = -1 then
+ SciMsg( pSci, SCI_MARKERDELETE, nLine, 0 )
+ else
+ SciMsg( pSci, SCI_MARKERADD, nLine, 0 )
+ end if
+ function = 0
+end function
+
+''
+''
+function clsDocument.NextBookmark() as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim fMark as long ' 32 bit value
+ dim nCurLine as long = this.GetCurrentLineNumber()
+ dim nLine as long = this.GetCurrentLineNumber() + 1 ' start line
+ fMark = bitset(fMark, 0)
+ nLine = SciMsg( pSci, SCI_MARKERNEXT, nLine, fMark)
+ if nLine > -1 then
+ SciMsg( pSci, SCI_GOTOLINE, nLine, 0)
+ else
+ nLine = SciMsg( pSci, SCI_MARKERNEXT, nLine, fMark)
+ if nLine > -1 then
+ SciMsg( pSci, SCI_GOTOLINE, nLine, 0)
+ end if
+ end if
+ if nLine <> -1 then
+ if nLine <> nCurLine then this.CenterCurrentLine()
+ end if
+ function = 0
+end function
+
+''
+''
+function clsDocument.PrevBookmark() as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim fMark as long ' 32 bit value
+ dim nCurLine as long = this.GetCurrentLineNumber()
+ dim nLine as long = this.GetCurrentLineNumber() - 1 ' start line
+ dim nLines as long = SciMsg( pSci, SCI_GETLINECOUNT, 0, 0) - 1
+ fMark = bitset(fMark, 0)
+ nLine = SciMsg( pSci, SCI_MARKERPREVIOUS, nLine, fMark)
+ if nLine > -1 then
+ SciMsg( pSci, SCI_GOTOLINE, nLine, 0)
+ else
+ nLine = SciMsg( pSci, SCI_MARKERPREVIOUS, nLines, fMark)
+ if nLine > -1 then
+ SciMsg( pSci, SCI_GOTOLINE, nLine, 0)
+ end if
+ end if
+ if nLine <> -1 then
+ if nLine <> nCurLine then this.CenterCurrentLine()
+ end if
+ function = 0
+end function
+
+''
+''
+function clsDocument.FoldToggle( byval nLine as long ) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim nFoldLevel as long = SciMsg( pSci, SCI_GETFOLDLEVEL, nLine, 0)
+
+ if (nFoldLevel and SC_FOLDLEVELHEADERFLAG) = 0 then
+ ' Get the number of the head line of the procedure or function
+ nLine = SciMsg( pSci, SCI_GETFOLDPARENT, nLine, 0)
+ end if
+ if nLine > -1 then
+ SciMsg( pSci, SCI_TOGGLEFOLD, nLine, 0)
+ SciMsg( pSci, SCI_GOTOLINE, nLine, 0)
+ end if
+
+ function = nLine
+end function
+
+''
+''
+function clsDocument.FoldAll() as long
+
+ dim i as long
+ dim nLines as long
+ dim nFoldLevel as long
+
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Force the lexer to style the whole document
+ SciMsg( pSci, SCI_COLOURISE, -1, 0)
+
+ nLines = SciMsg( pSci, SCI_GETLINECOUNT, 0, 0)
+
+ for i = 0 to nLines
+ ' if we are in the head line ...
+ nFoldLevel = SciMsg( pSci, SCI_GETFOLDLEVEL, i, 0)
+ if (nFoldLevel and SC_FOLDLEVELNUMBERMASK) = SC_FOLDLEVELBASE then
+ if SciMsg( pSci, SCI_GETFOLDEXPANDED, i, 0) then
+ SciMsg( pSci, SCI_TOGGLEFOLD, i, 0)
+ end if
+ end if
+ next
+
+ function = 0
+end function
+
+''
+''
+function clsDocument.UnFoldAll() as long
+ dim i as long
+ dim nLines as long
+ dim nFoldLevel as long
+
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Force the lexer to style the whole document
+ SciMsg( pSci, SCI_COLOURISE, -1, 0 )
+
+ nLines = SciMsg( pSci, SCI_GETLINECOUNT, 0, 0)
+
+ for i = 0 to nLines
+ ' if we are in the head line ...
+ nFoldLevel = SciMsg( pSci, SCI_GETFOLDLEVEL, i, 0)
+ if (nFoldLevel and SC_FOLDLEVELNUMBERMASK) = SC_FOLDLEVELBASE then
+ if SciMsg( pSci, SCI_GETFOLDEXPANDED, i, 0) = 0 then
+ SciMsg( pSci, SCI_TOGGLEFOLD, i, 0)
+ end if
+ end if
+ next
+
+ function = 0
+end function
+
+''
+''
+function clsDocument.FoldToggleOnwards( byval nLine as long) as long
+ ' Toggles the curent fold point and all folds below it that are of greater depth
+ dim i as long
+ dim nLines as long
+ dim nFoldLevel as long
+ dim nFoldLevelBase as long
+ dim FoldState as long
+
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Force the lexer to style the whole document
+ SciMsg( pSci, SCI_COLOURISE, -1, 0 )
+
+ nLines = SciMsg( pSci, SCI_GETLINECOUNT, 0, 0)
+
+ ' Toggle the first sub or function
+ nLine = this.FoldToggle(nLine)
+ nFoldLevelBase = SciMsg( pSci, SCI_GETFOLDLEVEL, nLine, 0)
+
+ ' Determine whether the fold is expanded or not
+ FoldState = SciMsg( pSci, SCI_GETFOLDEXPANDED, nLine, 0)
+
+ for i = nLine to nLines
+ nFoldLevel = SciMsg( pSci, SCI_GETFOLDLEVEL, i, 0)
+ if nFoldLevel > nFoldLevelBase then
+ ' if the state is different ...
+ if SciMsg( pSci, SCI_GETFOLDEXPANDED, i, 0) <> FoldState then
+ SciMsg( pSci, SCI_TOGGLEFOLD, i, 0)
+ end if
+ end if
+ next
+
+ function = 0
+end function
+
+''
+''
+function clsDocument.ConvertEOL( byval nMode as long) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ function = SciMsg( pSci, SCI_CONVERTEOLS, nMode, 0)
+ SciMsg( pSci, SCI_SETEOLMODE, nMode, 0)
+end function
+
+''
+''
+function clsDocument.TabsToSpaces() as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim as long i, n, nLen, nLines, TabSize, nLineNumber
+ dim as string strText, strBuffer
+
+ ' Get the current line
+ nLineNumber = this.GetCurrentLineNumber
+ ' Get the tab size
+ TabSize = SciMsg( pSci, SCI_GETTABWIDTH, 0, 0)
+ if TabSize < 1 then exit function
+ ' Get the length of the text
+ nLen = SciMsg( pSci, SCI_GETTEXTLENGTH, 0, 0)
+ ' Get the number of lines
+ nLines = SciMsg( pSci, SCI_GETLINECOUNT, 0, 0)
+ ' Remove tabs, line by line
+ for i = 0 to nLines - 1
+ strText = this.GetLine(i)
+ n = 1
+ Do
+ n = instr(n, strText, chr(9))
+ if n > 0 then
+ strText = left(strText, n - 1) & space(TabSize) & mid(strText, n + 1)
+ n += 1
+ end if
+ loop until n = 0
+ strBuffer = strBuffer & strText & chr(13,10)
+ next
+ ' Set the new text
+ this.SetText(strBuffer)
+ ' Set the caret position
+ SciMsg( pSci, SCI_GOTOLINE, nLineNumber, 0)
+
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.IsMultiLineSelection() as boolean
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ dim as long startPos, endPos, startLine, endLine
+ startPos = SciMsg( pSci, SCI_GETSELECTIONSTART, 0, 0)
+ endPos = SciMsg( pSci, SCI_GETSELECTIONEND, 0, 0)
+ startLine = SciMsg( pSci, SCI_LINEFROMPOSITION, startPos, 0)
+ endLine = SciMsg( pSci, SCI_LINEFROMPOSITION, endPos, 0)
+ if endLine <> startLine then return true
+end function
+
+
+''
+''
+function clsDocument.ApplyProperties() as long
+ dim nCount as long
+ dim i as long
+ dim nPixels as long
+ dim bitsNeeded as long
+ dim wFileExt as wstring * MAX_PATH
+ dim strFontName as string
+ dim nFontExtraSpace as long
+ dim nFontSize as long
+ dim nFontcase as long
+ dim rxRatio as single = 1
+ dim ryRatio as single = 1
+
+
+ if m_pSci(0) = 0 then exit function
+
+ ' Determine the pWindow parent of the Scintilla window in order
+ ' to ensure that DPI ratios are correctly used.
+ dim pWindow as CWindow ptr = AfxCWindowOwnerPtr(this.hWindow(0))
+ if pWindow then
+ rxRatio = pWindow->rxRatio
+ ryRatio = pWindow->ryRatio
+ end if
+
+ ' if this is a read-only file then set the flag so that the document can not be edited.
+ if AfxIsReadOnlyFile( this.DiskFilename ) then
+ SciMsg( m_pSci(0), SCI_SETREADONLY, 1, 0)
+ else
+ SciMsg( m_pSci(0), SCI_SETREADONLY, 0, 0)
+ end if
+
+ strFontName = str(gConfig.EditorFontname)
+ nFontSize = val(gConfig.EditorFontsize)
+ nFontExtraSpace = val(gConfig.FontExtraSpace)
+
+ select case gConfig.KeywordCase
+ case 0: nFontcase = SC_CASE_LOWER
+ case 1: nFontcase = SC_CASE_UPPER
+ case 2: nFontcase = SC_CASE_CAMEL
+ case 3: nFontcase = SC_CASE_MIXED ' original case
+ end select
+
+
+ ' Must apply all settings/styles to each Scintilla split window to ensure that
+ ' they all appear and act the same.
+
+ for i as long = lbound(m_pSci) to ubound(m_pSci)
+
+ ' Add Brace Highlighting functionality:
+ ' First, we set the style of the indicator number we want to use to the Box style
+ SciMsg( m_pSci(i), SCI_INDICSETSTYLE, 9, INDIC_STRAIGHTBOX )
+ ' then, we make that indicator the current one
+ SciMsg( m_pSci(i), SCI_SETINDICATORCURRENT, 9, 0 )
+ ' Lastly, we apply the indicator (in this case), to a single char
+ SciMsg( m_pSci(i), SCI_BRACEHIGHLIGHTINDICATOR, 1, 9 ) ' use indicator for SCI_BRACEHIGHLIGHTINDICATOR...
+ SciMsg( m_pSci(i), SCI_BRACEBADLIGHTINDICATOR, 1, 9 ) ' and SCI_BRACEBADLIGHTINDICATOR
+
+ SciMsg( m_pSci(i), SCI_STYLESETFONT, STYLE_DEFAULT, cast(LPARAM, strptr(strFontName)) )
+ SciMsg( m_pSci(i), SCI_STYLESETSIZE, STYLE_DEFAULT, nFontSize )
+ SciMsg( m_pSci(i), SCI_SETEXTRAASCENT, nFontExtraSpace, 0 )
+ SciMsg( m_pSci(i), SCI_SETEXTRADESCENT, nFontExtraSpace, 0 )
+ SciMsg( m_pSci(i), SCI_STYLESETCHARACTERSET, STYLE_DEFAULT, GetFontCharSetID(gConfig.EditorFontCharset) )
+
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, STYLE_DEFAULT, ghEditor.ForeColorText)
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, STYLE_DEFAULT, ghEditor.BackColorText)
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, STYLE_DEFAULT, ghEditor.TextBold )
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, STYLE_DEFAULT, ghEditor.TextItalic )
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, STYLE_DEFAULT, ghEditor.TextUnderline )
+ SciMsg( m_pSci(i), SCI_STYLECLEARALL, 0, 0 ) ' Copies global style to all others
+
+ ' Set the style for the AutoComplete popup list
+ SciMsg( m_pSci(i), SCI_STYLESETFONT, STYLE_AUTOCOMPLETE, cast(LPARAM, pWindow->DefaultFontName) )
+ SciMsg( m_pSci(i), SCI_STYLESETSIZE, STYLE_AUTOCOMPLETE, pWindow->DefaultFontSize)
+ SciMsg( m_pSci(i), SCI_STYLESETCHARACTERSET, STYLE_AUTOCOMPLETE, GetFontCharSetID(gConfig.EditorFontCharset) )
+
+ ''
+ '' MARGIN 0: Line Numbering (defaults to width 0)
+ nPixels = SciMsg( m_pSci(i), SCI_TEXTWIDTH, 0, cast(LPARAM, @"_99999"))
+ SciMsg( m_pSci(i), SCI_SETMARGINTYPEN, 0, SC_MARGIN_NUMBER )
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, STYLE_LINENUMBER, ghEditor.ForeColorLinenumbers )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, STYLE_LINENUMBER, ghEditor.BackColorLinenumbers )
+ SciMsg( m_pSci(i), SCI_SETMARGINWIDTHN, 0, iif(gConfig.LineNumbering, nPixels, 0) )
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, STYLE_LINENUMBER, ghEditor.LineNumbersBold )
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, STYLE_LINENUMBER, ghEditor.LineNumbersItalic )
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, STYLE_LINENUMBER, ghEditor.LineNumbersUnderline )
+
+ ''
+ '' MARGIN 1: Non-Folding symbols (defaults to width 16) (Bookmark symbol, etc) (will be same color as line numbering)
+ SciMsg( m_pSci(i), SCI_SETMARGINTYPEN, 1, SC_MARGIN_TEXT )
+ SciMsg( m_pSci(i), SCI_SETMARGINSENSITIVEN, 1, 1 )
+ SciMsg( m_pSci(i), SCI_SETMARGINWIDTHN, 1, iif(gConfig.LeftMargin, 16 * rxRatio, 0) )
+
+ ''
+ '' MARGIN 2: Folding symbols (defaults to width 0)
+ SciMsg( m_pSci(i), SCI_SETMARGINTYPEN, 2, SC_MARGIN_SYMBOL )
+ SciMsg( m_pSci(i), SCI_SETMARGINMASKN, 2, SC_MASK_FOLDERS )
+ SciMsg( m_pSci(i), SCI_SETFOLDMARGINCOLOUR, Ctrue, ghEditor.ForeColorFoldmargin )
+ SciMsg( m_pSci(i), SCI_SETFOLDMARGINHICOLOUR, Ctrue, ghEditor.ForeColorFoldmargin )
+ SciMsg( m_pSci(i), SCI_SETMARGINSENSITIVEN, 2, 1 )
+ SciMsg( m_pSci(i), SCI_SETMARGINWIDTHN, 2, iif(gConfig.FoldMargin, 16 * rxRatio, 0) )
+
+ ''
+ '' MARGIN 3: Small margin to offset left margins from actual text (4 pixels)
+ SciMsg( m_pSci(i), SCI_SETMARGINTYPEN, 3, SC_MARGIN_TEXT )
+ SciMsg( m_pSci(i), SCI_SETMARGINWIDTHN, 3, 4 * rxRatio )
+ SciMsg( m_pSci(i), SCI_SETMARGINTYPEN, 3, SC_MARGIN_FORE )
+ SciMsg( m_pSci(i), SCI_SETMARGINTYPEN, 3, SC_MARGIN_BACK )
+
+ ''
+ '' CONFINE CARET to TEXT
+ if gConfig.ConfineCaret then
+ SciMsg( m_pSci(i), SCI_SETVIRTUALSPACEOPTIONS, SCVS_RECTANGULARSELECTION, 0 )
+ else
+ SciMsg( m_pSci(i), SCI_SETVIRTUALSPACEOPTIONS, SCVS_RECTANGULARSELECTION or SCVS_USERACCESSIBLE, 0 )
+ end if
+
+ ''
+ '' TABS as SPACES
+ if gConfig.TabIndentSpaces then
+ SciMsg( m_pSci(i), SCI_SETUSETABS, false, 0 )
+ else
+ SciMsg( m_pSci(i), SCI_SETUSETABS, Ctrue, 0 )
+ end if
+
+ ''
+ '' SELECTIONS FILL ENTIRE SCREEN SPACE
+ SciMsg( m_pSci(i), SCI_SETSELEOLFILLED, Ctrue, 0 )
+
+ ''
+ '' TAB WIDTH
+ SciMsg( m_pSci(i), SCI_SETTABWIDTH, val(gConfig.TabSize), 0 )
+ SciMsg( m_pSci(i), SCI_SETINDENT, val(gConfig.TabSize), 0 )
+
+ ''
+ '' INDENTATION GUIDES
+ if gConfig.IndentGuides then
+ SciMsg( m_pSci(i), SCI_SETINDENTATIONGUIDES, Ctrue, 0)
+ else
+ SciMsg( m_pSci(i), SCI_SETINDENTATIONGUIDES, false, 0)
+ end if
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, STYLE_INDENTGUIDE, ghEditor.ForeColorIndentguides )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, STYLE_INDENTGUIDE, ghEditor.BackColorIndentguides )
+
+ ''
+ '' CARET
+ SciMsg( m_pSci(i), SCI_SETCARETFORE, ghEditor.ForeColorCaret, 0 )
+ SciMsg( m_pSci(i), SCI_SETCARETWIDTH, 2, 0 ) ' 2 pixels
+
+ ''
+ '' SHOW CARET LINE
+ if gConfig.HighlightCurrentLine then
+ SciMsg( m_pSci(i), SCI_SETCARETLINEVISIBLE, Ctrue, 0 )
+ SciMsg( m_pSci(i), SCI_SETCARETLINEBACK, ghEditor.BackColorCurrentline, 0 )
+ else
+ SciMsg( m_pSci(i), SCI_SETCARETLINEVISIBLE, false, 0 )
+ end if
+
+ ''
+ '' SELECTION COLORS
+ SciMsg( m_pSci(i), SCI_SETSELFORE, Ctrue, ghEditor.ForeColorSelection )
+ SciMsg( m_pSci(i), SCI_SETSELBACK, Ctrue, ghEditor.BackColorSelection )
+
+ ''
+ '' MULTIPLE SELECTIONS
+ SciMsg( m_pSci(i), SCI_SETMULTIPLESELECTION, Ctrue, 0 )
+
+ ''
+ '' ALWAYS KEEP THE CARET LINE VISIBLE
+ SciMsg( m_pSci(i), SCI_SETCARETLINEVISIBLEALWAYS, Ctrue, 0 )
+
+ ''
+ '' DISABLE RIGHT CLICK POPUP MENU
+ SciMsg( m_pSci(i), SCI_USEPOPUP, false, 0 )
+
+ ''
+ '' IDENTIFY CHARACTERS to BE USED IN WORDS
+ SciMsg( m_pSci(i), SCI_SETWORDCHARS, 0, cast(LPARAM, @"~_\abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") )
+
+ '' UNICODE (UTF-8 encoding)
+ if this.FileEncoding = FILE_ENCODING_ANSI then
+ SciMsg( m_pSci(i), SCI_SETCODEPAGE, 0, 0 )
+ else
+ ' UTF8 or UTF16 would have been converted to UTF8 in order to display in the editor.
+ SciMsg( m_pSci(i), SCI_SETCODEPAGE, SC_CP_UTF8, 0 )
+ end if
+
+ '' RIGHT EDGE COLUMN
+ SciMsg( m_pSci(i), SCI_SETEDGEMODE, iif(gConfig.RightEdge, EDGE_LINE, EDGE_NONE), 0 )
+ SciMsg( m_pSci(i), SCI_SETEDGECOLUMN, val(gConfig.RightEdgePosition), 0 )
+
+ ''
+ '' OTHER
+ SciMsg( m_pSci(i), SCI_SETADDITIONALSELECTIONTYPING, true, 0 )
+
+
+ ''
+ '' APPLY ALL LANGUAGE SPECIFIC SYNTAX COLORING
+ wFileExt = AfxStrPathname( "EXTN", this.DiskFilename )
+ wFileExt = ucase(wFileExt)
+
+ if cbool(wFileExt = ".BAS") orelse cbool(wFileExt = ".INC") _
+ orelse cbool(wFileExt = ".BI") orelse (this.IsNewFlag = true) _
+ orelse cbool(wFileExt = ".FBTPL") then
+
+ bitsNeeded = SciMsg( m_pSci(i), SCI_GETSTYLEBITSNEEDED, 0, 0)
+ SciMsg( m_pSci(i), SCI_SETSTYLEBITS, bitsNeeded, 0 )
+
+ ' Set FreeBASIC Keywords
+ if len(gConfig.FBKeywords) then
+ SciMsg( m_pSci(i), SCI_SETKEYWORDS, 0, cast(LPARAM, strptr(gConfig.FBKeywords)) )
+ end if
+
+ ' Set Windows Api Keywords
+ if len(gConfig.WinApiKeywords) then
+ SciMsg( m_pSci(i), SCI_SETKEYWORDS, 1, cast(LPARAM, strptr(gConfig.WinApiKeywords)) )
+ end if
+
+ if gConfig.SyntaxHighlighting then
+ ' Set the Default text colors
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, SCE_B_DEFAULT, ghEditor.ForeColorText)
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, SCE_B_DEFAULT, ghEditor.BackColorText)
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, SCE_B_DEFAULT, ghEditor.TextBold )
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, SCE_B_DEFAULT, ghEditor.TextItalic )
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, SCE_B_DEFAULT, ghEditor.TextUnderline )
+
+ ' Set the Multiline Comments style
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, SCE_B_MULTILINECOMMENT, ghEditor.ForeColorComments )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, SCE_B_MULTILINECOMMENT, ghEditor.BackColorComments )
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, SCE_B_MULTILINECOMMENT, ghEditor.CommentsBold )
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, SCE_B_MULTILINECOMMENT, ghEditor.CommentsItalic )
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, SCE_B_MULTILINECOMMENT, ghEditor.CommentsUnderline )
+
+ ' Set the Comments style
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, SCE_B_COMMENT, ghEditor.ForeColorComments )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, SCE_B_COMMENT, ghEditor.BackColorComments )
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, SCE_B_COMMENT, ghEditor.CommentsBold )
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, SCE_B_COMMENT, ghEditor.CommentsItalic )
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, SCE_B_COMMENT, ghEditor.CommentsUnderline )
+
+ ' Set the Keywords style (FreeBasic)
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, SCE_B_KEYWORD, ghEditor.ForeColorKeyword )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, SCE_B_KEYWORD, ghEditor.BackColorKeyword )
+ SciMsg( m_pSci(i), SCI_STYLESETCASE, SCE_B_KEYWORD, nFontcase )
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, SCE_B_KEYWORD, ghEditor.KeywordBold )
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, SCE_B_KEYWORD, ghEditor.KeywordItalic )
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, SCE_B_KEYWORD, ghEditor.KeywordUnderline )
+
+ ' Set the Keywords style (Windows Api)
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, SCE_B_KEYWORD2, ghEditor.ForeColorKeyword2 )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, SCE_B_KEYWORD2, ghEditor.BackColorKeyword2 )
+ SciMsg( m_pSci(i), SCI_STYLESETCASE, SCE_B_KEYWORD2, nFontcase )
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, SCE_B_KEYWORD2, ghEditor.KeywordBold2 )
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, SCE_B_KEYWORD2, ghEditor.KeywordItalic2 )
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, SCE_B_KEYWORD2, ghEditor.KeywordUnderline2 )
+
+ ' Set the Numbers style
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, SCE_B_NUMBER, ghEditor.ForeColorNumbers )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, SCE_B_NUMBER, ghEditor.BackColorNumbers )
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, SCE_B_NUMBER, ghEditor.NumbersBold )
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, SCE_B_NUMBER, ghEditor.NumbersItalic)
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, SCE_B_NUMBER, ghEditor.NumbersUnderline)
+
+ ' Set the Operators style
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, SCE_B_OPERATOR, ghEditor.ForeColorOperators )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, SCE_B_OPERATOR, ghEditor.BackColorOperators )
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, SCE_B_OPERATOR, ghEditor.OperatorsBold)
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, SCE_B_OPERATOR, ghEditor.OperatorsItalic)
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, SCE_B_OPERATOR, ghEditor.OperatorsUnderline)
+
+ ' Set the Preprocessor style
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, SCE_B_PREPROCESSOR, ghEditor.ForeColorPreprocessor )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, SCE_B_PREPROCESSOR, ghEditor.BackColorPreprocessor )
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, SCE_B_PREPROCESSOR, ghEditor.PreprocessorBold)
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, SCE_B_PREPROCESSOR, ghEditor.PreprocessorItalic)
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, SCE_B_PREPROCESSOR, ghEditor.PreprocessorUnderline)
+
+ ' Set the strings style
+ SciMsg( m_pSci(i), SCI_STYLESETFORE, SCE_B_STRING, ghEditor.ForeColorStrings )
+ SciMsg( m_pSci(i), SCI_STYLESETBACK, SCE_B_STRING, ghEditor.BackColorStrings )
+ SciMsg( m_pSci(i), SCI_STYLESETBOLD, SCE_B_STRING, ghEditor.StringsBold)
+ SciMsg( m_pSci(i), SCI_STYLESETITALIC, SCE_B_STRING, ghEditor.StringsItalic)
+ SciMsg( m_pSci(i), SCI_STYLESETUNDERLINE, SCE_B_STRING, ghEditor.StringsUnderline)
+
+ end if
+ end if
+
+ ''
+ '' CODE FOLDING
+ if gConfig.FoldMargin then
+ ' Enable folding of the procedures and functions
+ SciMsg( m_pSci(i), SCI_SETPROPERTY, cast(WPARAM, @"fold"), cast(LPARAM, @"1") )
+
+ ' Initialize fold symbols for folding - Box tree
+ SciMsg( m_pSci(i), SCI_MARKERDEFINE, SC_MARKNUM_FOLDEROPEN, SC_MARK_BOXMINUS )
+ SciMsg( m_pSci(i), SCI_MARKERDEFINE, SC_MARKNUM_FOLDER, SC_MARK_BOXPLUS )
+ SciMsg( m_pSci(i), SCI_MARKERDEFINE, SC_MARKNUM_FOLDERSUB, SC_MARK_VLINE)
+ SciMsg( m_pSci(i), SCI_MARKERDEFINE, SC_MARKNUM_FOLDERTAIL, SC_MARK_LCORNER)
+ SciMsg( m_pSci(i), SCI_MARKERDEFINE, SC_MARKNUM_FOLDEREND, SC_MARK_BOXPLUSCONNECTED)
+ 'SciMsg( m_pSci(i), SCI_MARKERDEFINE, SC_MARKNUM_FOLDEROPENMID, SC_MARK_EMPTY) ' SC_MARK_BOXMINUSCONNECTED
+ SciMsg( m_pSci(i), SCI_MARKERDEFINE, SC_MARKNUM_FOLDEROPENMID, SC_MARK_BOXMINUSCONNECTED)
+ SciMsg( m_pSci(i), SCI_MARKERDEFINE, SC_MARKNUM_FOLDERMIDTAIL, SC_MARK_TCORNER)
+
+ ' Draw line below if not expanded
+ SciMsg( m_pSci(i), SCI_SETFOLDFLAGS, 16, 0 )
+
+ ' Colors for folders closed and folders opened
+ dim as COLORREF clrFore = ghEditor.ForeColorFoldsymbol
+ dim as COLORREF clrBack = ghEditor.BackColorFoldsymbol
+
+ SciMsg( m_pSci(i), SCI_MARKERSETFORE, SC_MARKNUM_FOLDER, clrBack)
+ SciMsg( m_pSci(i), SCI_MARKERSETBACK, SC_MARKNUM_FOLDER, clrFore)
+
+ SciMsg( m_pSci(i), SCI_MARKERSETFORE, SC_MARKNUM_FOLDEROPEN, clrBack)
+ SciMsg( m_pSci(i), SCI_MARKERSETBACK, SC_MARKNUM_FOLDEROPEN, clrFore)
+
+ SciMsg( m_pSci(i), SCI_MARKERSETFORE, SC_MARKNUM_FOLDERSUB, clrBack)
+ SciMsg( m_pSci(i), SCI_MARKERSETBACK, SC_MARKNUM_FOLDERSUB, clrFore)
+
+ SciMsg( m_pSci(i), SCI_MARKERSETFORE, SC_MARKNUM_FOLDERTAIL, clrBack)
+ SciMsg( m_pSci(i), SCI_MARKERSETBACK, SC_MARKNUM_FOLDERTAIL, clrFore)
+
+ SciMsg( m_pSci(i), SCI_MARKERSETFORE, SC_MARKNUM_FOLDEREND, clrBack)
+ SciMsg( m_pSci(i), SCI_MARKERSETBACK, SC_MARKNUM_FOLDEREND, clrFore)
+
+ SciMsg( m_pSci(i), SCI_MARKERSETFORE, SC_MARKNUM_FOLDEROPENMID, clrBack)
+ SciMsg( m_pSci(i), SCI_MARKERSETBACK, SC_MARKNUM_FOLDEROPENMID, clrFore)
+
+ SciMsg( m_pSci(i), SCI_MARKERSETFORE, SC_MARKNUM_FOLDERMIDTAIL, clrBack)
+ SciMsg( m_pSci(i), SCI_MARKERSETBACK, SC_MARKNUM_FOLDERMIDTAIL, clrFore)
+
+ SciMsg( m_pSci(i), SCI_MARKERENABLEHIGHLIGHT, false, 0)
+
+ else
+ ' Disable folding of the procedures and functions
+ SciMsg( m_pSci(i), SCI_SETPROPERTY, cast(WPARAM, @"fold"), cast(LPARAM, @"0") )
+ end if
+
+ next
+
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.GetWord( byval curPos as long = -1 ) as string
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Get word at the specified location or under the cursor
+ dim as long x, y, p
+ dim as string buffer
+
+ ' Retrieve the current position
+ if curPos = -1 then curPos = SciMsg( pSci, SCI_GETCURRENTPOS, 0, 0)
+ ' Retrieve the starting and ending position of the word
+ x = SciMsg( pSci, SCI_WORDSTARTPOSITION, curPos, true)
+ y = SciMsg( pSci, SCI_WORDENDPOSITION, curPos, false)
+ if y > x then
+ ' Text range
+ buffer = this.GetTextRange(x, y)
+ ' Remove the $NUL
+ p = instr(buffer, chr(0))
+ if p then buffer = left(buffer, p - 1)
+ end if
+ buffer = AfxStrRemoveAny( buffer, chr(13, 10, 34) & "()%," )
+ function = buffer
+
+end function
+
+''
+''
+function clsDocument.GetBookmarks() as string
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Retrieve all bookmark positions in the document and return it
+ ' as a comma delimited string to be saved to project file.
+ dim as string buffer
+ dim as long fMark ' 32 bit value
+ dim as long nLines = SciMsg( pSci, SCI_GETLINECOUNT, 0, 0)
+
+ for i as long = 0 to nLines - 1
+ fMark = SciMsg( pSci, SCI_MARKERGET, i, 0)
+ if bit(fMark, 0) then
+ buffer = buffer & i & ","
+ end if
+ next
+
+ function = rtrim(buffer, ",")
+
+end function
+
+''
+''
+function clsDocument.SetBookmarks( byval sBookmarks as string ) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Set all bookmark positions in the document and based on the
+ ' incoming comma delimited string retrieved from a project file.
+ sBookmarks = trim(sBookmarks)
+ if len(sBookmarks) = 0 then exit function
+
+ dim as long nCount = AfxStrParseCount(sBookmarks, ",")
+ dim as long nLine
+
+ for i as long = 1 to nCount
+ nLine = val( AfxStrParse(sBookmarks, i, ",") )
+ SciMsg( pSci, SCI_MARKERADD, nLine, 0)
+ next
+
+ function = 0
+
+end function
+
+''
+''
+function clsDocument.GetFoldPoints() as string
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Retrieve all folding positions in the document and return it
+ ' as a comma delimited string to be saved to project file.
+ dim as string buffer
+ dim as long nLines = SciMsg( pSci, SCI_GETLINECOUNT, 0, 0)
+
+ for i as long = 0 to nLines - 1
+ dim nFoldLevel as long = SciMsg( pSci, SCI_GETFOLDLEVEL, i, 0)
+ if (nFoldLevel and SC_FOLDLEVELHEADERFLAG) then
+ if SciMsg( pSci, SCI_GETFOLDEXPANDED, i, 0) = 0 then
+ buffer = buffer & i & ","
+ end if
+ end if
+ next
+
+ function = rtrim(buffer, ",")
+
+end function
+
+''
+''
+function clsDocument.SetFoldPoints( byval sFoldPoints as string ) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Set all folding positions in the document and based on the
+ ' incoming comma delimited string retrieved from a project file.
+ sFoldPoints = trim(sFoldPoints)
+ if len(sFoldPoints) = 0 then exit function
+
+ dim as long nCount = AfxStrParseCount(sFoldPoints, ",")
+ dim as long nLine
+
+ for i as long = 1 to nCount
+ nLine = val( AfxStrParse(sFoldPoints, i, ",") )
+ SciMsg( pSci, SCI_FOLDLINE, nLine, SC_FOLDACTION_CONTRACT)
+ next
+
+ function = 0
+
+end function
+
+''
+''
+function clsDocument.LineDuplicate() as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' Duplicate the current caret line, or an entire block of
+ ' code should a selection be active.
+ dim as long startSelPos = SciMsg( pSci, SCI_GETSELECTIONSTART, 0, 0)
+ dim as long endSelPos = SciMsg( pSci, SCI_GETSELECTIONEND, 0, 0)
+ if startSelPos = endSelPos then ' no selection
+ ' Simply duplicate the line that the caret is on.
+ SciMsg( pSci, SCI_LINEDUPLICATE, 0, 0)
+ else
+ SciMsg( pSci, SCI_SELECTIONDUPLICATE, 0, 0)
+ end if
+ function = 0
+end function
+
+
+''
+''
+function clsDocument.LinesPerPage( byval idxWindow as long ) as long
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+ ' SCI_LINESONSCREEN is not a reliable count of lines per screen because
+ ' it does not take into account any extra ascent or descent value.
+ dim as long nLineHeight = SciMsg( pSci, SCI_TEXTHEIGHT, 0, 0 )
+ dim as RECT rc = AfxGetWindowRect(this.hWindow(idxWindow))
+ MapWindowPoints( HWND_DESKTOP, HWND_FRMMAIN, cast(POINT ptr, @rc), 2 )
+ dim as long nHeight = rc.bottom - rc.top
+ function = (nHeight / nLineHeight)
+end function
+
+
+''
+''
+function clsDocument.CompileDirectives( Directives() as COMPILE_DIRECTIVES ) as long
+ ' Search the source code for any user embedded compiler directives.
+ dim ub as long
+ dim i as long
+ dim nLines as long
+ dim st as string
+
+ dim sText as string ' this will be an UTF-8 encoded string
+
+ dim as any ptr pSci = this.GetActiveScintillaPtr()
+
+ if pSci = 0 then exit function
+
+ nLines = SciMsg( pSci, SCI_GETLINECOUNT, 0, 0)
+
+ for i = 0 to nLines - 1
+ st = ltrim(this.GetLine(i))
+
+ if left(st, 1) <> "'" then continue for
+ st = ltrim(mid(st, 2))
+
+ if len(st) < 11 then continue for
+ st = ucase(st)
+
+ ub = ubound(Directives)
+
+ ' '#CONSOLE ON|OFF
+ if left(st, 11) = "#CONSOLE ON" then
+ redim preserve Directives(ub+1)
+ Directives(ub+1).DirectiveFlag = IDM_CONSOLE
+ elseif left(st, 12) = "#CONSOLE OFF" then
+ redim preserve Directives(ub+1)
+ Directives(ub+1).DirectiveFlag = IDM_GUI
+ end if
+
+ ' '#RESOURCE "filename.rc"
+ if left(st, 10) = "#RESOURCE " then
+ redim preserve Directives(ub+1)
+ Directives(ub+1).DirectiveFlag = IDM_RESOURCE
+ st = mid(st, 11)
+ Directives(ub+1).DirectiveText = AfxStrExtract(st, chr(34), chr(34))
+ end if
+
+ next
+
+ function = 0
+end function
+
+
diff --git a/src/clsLasso.bi b/src/clsLasso.bi
index 1c504760..f481462e 100644
--- a/src/clsLasso.bi
+++ b/src/clsLasso.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsLasso.bi.bak b/src/clsLasso.bi.bak
new file mode 100644
index 00000000..1c504760
--- /dev/null
+++ b/src/clsLasso.bi.bak
@@ -0,0 +1,39 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+type clsLasso
+ private:
+ pWindow as CWindow ptr
+ hWindow as hwnd
+ hWndParent as hwnd
+ ptStart as POINT
+ ptEnd as POINT
+ bLasso as boolean
+
+ public:
+ declare destructor
+ declare function IsActive() as boolean
+ declare function GetLassoRect() as RECT
+ declare function SetStartPoint( byval x as long, byval y as Long) as Long
+ declare function SetEndPoint( byval x as long, byval y as Long) as Long
+ declare function GetStartPoint() as POINT
+ declare function GetEndPoint() as POINT
+ declare function FillAlpha(byval hBmp as HBITMAP) as boolean
+ declare function Show() as Long
+ declare function Create( byval hWndParent as HWND ) as boolean
+ declare function Destroy() as boolean
+end type
+
diff --git a/src/clsLasso.inc b/src/clsLasso.inc
index d81fd820..c237d69d 100644
--- a/src/clsLasso.inc
+++ b/src/clsLasso.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsLasso.inc.bak b/src/clsLasso.inc.bak
new file mode 100644
index 00000000..d81fd820
--- /dev/null
+++ b/src/clsLasso.inc.bak
@@ -0,0 +1,206 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "clsLasso.bi"
+
+
+' ========================================================================================
+' Lasso window callback procedure
+' ========================================================================================
+function clsLasso_WndProc( _
+ byval hwnd as HWND, _
+ byval uMsg as UINT, _
+ byval wParam as WPARAM, _
+ byval lParam as LPARAM _
+ ) as LRESULT
+
+ ' Default processing of Windows messages
+ function = DefWindowProc(hWnd, uMsg, wParam, lParam)
+
+end function
+
+
+destructor clsLasso
+ if pWindow then this.Destroy
+end destructor
+
+function clsLasso.IsActive() as boolean
+ function = this.bLasso
+end function
+
+function clsLasso.GetLassoRect() as RECT
+ dim as RECT rc = (this.ptStart.x, this.ptStart.y, this.ptEnd.x, this.ptEnd.y)
+ ' Normalize the rect
+ If rc.Left > rc.Right then swap rc.Right, rc.Left
+ If rc.Top > rc.Bottom then swap rc.Top, rc.Bottom
+ return rc
+end function
+
+function clsLasso.SetStartPoint( byval x as long, byval y as Long ) as Long
+ this.ptStart.x = x
+ this.ptStart.y = y
+ function = 0
+end function
+
+function clsLasso.SetEndPoint( byval x as long, byval y as Long ) as Long
+ this.ptEnd.x = x
+ this.ptEnd.y = y
+ function = 0
+end function
+
+function clsLasso.GetStartPoint() as POINT
+ return this.ptStart
+end function
+
+function clsLasso.GetEndPoint() as POINT
+ return this.ptEnd
+end function
+
+function clsLasso.Create( byval hWndParent as hwnd ) as boolean
+ dim as boolean bResult = false
+ dim as RECT rc
+
+ this.pWindow = new CWindow
+ if this.pWindow then
+ GetClientRect(hWndParent, @rc)
+ MapWindowPoints(hWndParent, 0, cast( POINT ptr, @rc), 2)
+ this.hWindow = this.pWindow->Create( hWndParent, "", @clsLasso_WndProc, _
+ rc.left, rc.top, rc.right-rc.left, rc.bottom-rc.top, _
+ WS_POPUP or WS_VISIBLE, WS_EX_LAYERED)
+ this.pWindow->ClassStyle = CS_DBLCLKS
+ this.hWndParent = hWndParent
+ this.SetStartPoint(-1,-1)
+ this.SetEndPoint(-1,-1)
+ this.bLasso = true
+ SetFocus(hWndParent)
+ bResult = iif(this.pWindow->hWindow, true, false)
+ end if
+
+ function = bResult
+end function
+
+
+function clsLasso.FillAlpha( byval hBmp as HBITMAP ) as boolean
+ dim as boolean bResult = false
+
+ if (hBmp) then
+ dim as BITMAP bmp
+ GetObject(hBmp, sizeof(BITMAP), @bmp)
+ dim as DWORD dwCount = bmp.bmWidthBytes * bmp.bmHeight
+ if (dwCount >= sizeof(DWORD)) then
+ dim as DWORD ptr pcBitsWords = cast(DWORD ptr, bmp.bmBits)
+ if (pcBitsWords) then
+ dim as DWORD dwIndex = (dwCount / sizeof(DWORD)) - 1
+ dim as DWORD dwUp = bmp.bmWidth
+ dim as DWORD dwDn = dwIndex -dwUp
+ dim as DWORD dwR = bmp.bmWidth -1
+ while dwIndex
+ dim as DWORD dwSides = dwIndex mod bmp.bmWidth
+ if (dwIndex < dwUp) or (dwIndex > dwDn) or (dwSides = 0) or(dwSides = dwR) then
+ pcBitsWords[dwIndex] = &HFF0080FF 'sm_clrPenA; // 0xFF0080FF
+ else
+ pcBitsWords[dwIndex] = &H400020FF 'sm_clrBrushA; // 0x400020FF
+ end if
+ dwIndex = dwIndex - 1
+ wend
+ bResult = true
+ end if
+ end if
+ end if
+ return bResult
+end function
+
+
+function clsLasso.Show() as Long
+ if this.bLasso then
+
+ dim as RECT rcPos = this.GetLassoRect()
+
+ dim as HDC hdcScreen = GetDC(0)
+ dim as HDC hDC = CreateCompatibleDC(hdcScreen)
+ dim as long iWidth = rcPos.right - rcPos.left
+ dim as long iHeight = rcPos.bottom - rcPos.top
+
+ dim as BITMAPINFO sBI
+ sBI.bmiHeader.biSize = sizeof(BITMAPINFOHEADER)
+ sBI.bmiHeader.biWidth = iWidth
+ sBI.bmiHeader.biHeight = iHeight
+ sBI.bmiHeader.biPlanes = 1
+ sBI.bmiHeader.biBitCount = 32
+ sBI.bmiHeader.biCompression = BI_RGB
+
+ dim as HBITMAP hBmp = CreateDIBSection(hDC, @sBI, DIB_RGB_COLORS, null, null, 0)
+ dim as HBITMAP hBmpOld = SelectObject(hDC, hBmp)
+
+ dim as boolean bFillAlphaOK = FillAlpha(hBmp)
+
+ dim as BLENDfunction blend
+ blend.BlendOp = AC_SRC_OVER
+ blend.SourceConstantAlpha = iif(bFillAlphaOK, 160, 64)
+ blend.AlphaFormat = iif(bFillAlphaOK, AC_SRC_ALPHA, 0)
+
+ ' Destination position at the screen
+ ' POINT ptPos = {cIntersectRect.left,
+ ' cIntersectRect.top};
+ dim as RECT rc
+ GetClientRect(this.hWndParent, @rc)
+ MapWindowPoints(this.hWndParent, 0, cast(POINT ptr, @rc), 2)
+ dim as POINT ptPos = (rc.left + rcPos.left, rc.top + rcPos.top)
+
+ ' Source position in source (memory DC)
+ ' POINT ptSrc = {cIntersectRect.left - cMoveRect.left,
+ ' cIntersectRect.top - cMoveRect.top};
+ dim as point ptSrc = (0,0) '(rcPos.left, rcPos.top)
+
+ ' Dimensions of the bits transfer
+ ' SIZE sizeWnd = {cIntersectRect.Width(),
+ ' cIntersectRect.Height()};
+ dim as SIZE sizeWnd = (iWidth, iHeight)
+
+ 'UpdateLayeredWindow(
+ ' __in HWND hWnd, // handle of the layered window
+ ' __in_opt HDC hdcDst, // destination DC (in our case screen DC)
+ ' __in_opt POINT *pptDst, // destination position at the screen
+ ' __in_opt SIZE *psize, // dimensions of window at the screen
+ ' __in_opt HDC hdcSrc, // source (memory) DC of prepainting
+ ' __in_opt POINT *pptSrc, // source position for the surface bits transfer
+ ' __in COLORREF crKey, // color to be fully transparent (not our case)
+ ' __in_opt BLENDfunction *pblend, // blending parameters
+ ' __in DWORD dwFlags); // kind of the transfer
+ ' // (in our case ULW_ALPHA - for alpha blending)
+ UpdateLayeredWindow(this.hWindow, hdcScreen, @ptPos, @sizeWnd, hDC, @ptSrc, 0, @blend, ULW_ALPHA)
+
+ SelectObject(hDC, hBmpOld)
+ DeleteObject(hBmp)
+ DeleteDC(hDC)
+ ReleaseDC(0, hdcScreen)
+
+ end if
+
+ function = 0
+end function
+
+
+function clsLasso.Destroy() as boolean
+ if this.pWindow then
+ this.bLasso = false
+ DestroyWindow( pWindow->hWindow)
+ delete this.pWindow
+ this.pWindow = 0
+ end if
+ function = true
+end function
+
+
+
+
diff --git a/src/clsMenuItem.bi b/src/clsMenuItem.bi
index 6b1585f1..efea99d0 100644
--- a/src/clsMenuItem.bi
+++ b/src/clsMenuItem.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsMenuItem.bi.bak b/src/clsMenuItem.bi.bak
new file mode 100644
index 00000000..6b1585f1
--- /dev/null
+++ b/src/clsMenuItem.bi.bak
@@ -0,0 +1,30 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+type clsMenuItem
+ private:
+
+ public:
+ wszName as CWSTR
+ wszCaption as CWSTR
+ wszShortcut as CWSTR
+ nIndent as long
+ chkAlt as long
+ chkShift as long
+ chkCtrl as long
+ chkChecked as long
+ chkGrayed as long
+end type
+
diff --git a/src/clsPanelItem.bi b/src/clsPanelItem.bi
index 45cd0675..9dfc4d25 100644
--- a/src/clsPanelItem.bi
+++ b/src/clsPanelItem.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsPanelItem.bi.bak b/src/clsPanelItem.bi.bak
new file mode 100644
index 00000000..45cd0675
--- /dev/null
+++ b/src/clsPanelItem.bi.bak
@@ -0,0 +1,44 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#include once "clsControl.bi"
+
+type clsPanelItem
+ private:
+
+ public:
+ wszName as CWSTR
+ wszText as CWSTR
+ wszTooltip as CWSTR
+ wszAlignment as CWSTR = wstr("StatusBarPanelAlignment.Left")
+ ' BorderStyle is deprecated as of v2.0.4 as it has not effect
+ ' in WinFBE programs where Windows Themes are enabled.
+ 'wszBorderStyle as CWSTR = wstr("StatusBarPanelBorderStyle.Sunken")
+ wszAutosize as CWSTR = wstr("StatusBarPanelAutoSize.None")
+ wszWidth as CWSTR = wstr("100")
+ wszMinWidth as CWSTR = wstr("100")
+ wszBackColor as CWSTR = "SYSTEM|Control"
+ wszBackColorHot as CWSTR = "SYSTEM|Control"
+ wszForeColor as CWSTR = "SYSTEM|ControlText"
+ wszForeColorHot as CWSTR = "SYSTEM|ControlText"
+ pProp as clsProperty ' for the panel image
+ pPropColor as clsProperty ' for passing to color picker (see GetActivePropertyPtr)
+ idColorCombo as long ' ctrl id of combobox that the pPropColor relates to.
+end type
+
+' Temporary PanelItem array to hold items while they are being
+' edited in the StatusBar Editor.
+dim shared gPanelItems(any) as clsPanelItem
+
diff --git a/src/clsToolBarItem.bi b/src/clsToolBarItem.bi
index cdc6926b..d1f03e2c 100644
--- a/src/clsToolBarItem.bi
+++ b/src/clsToolBarItem.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsToolBarItem.bi.bak b/src/clsToolBarItem.bi.bak
new file mode 100644
index 00000000..cdc6926b
--- /dev/null
+++ b/src/clsToolBarItem.bi.bak
@@ -0,0 +1,31 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#include once "clsControl.bi"
+
+
+type clsToolBarItem
+ private:
+
+ public:
+ wszName as CWSTR
+ wszButtonType as CWSTR = wstr("ToolBarButton.Button")
+ wszToolTip as CWSTR
+ pPropNormalImage as clsProperty
+ pPropHotImage as clsProperty
+ pPropDisabledImage as clsProperty
+
+end type
+
diff --git a/src/clsTopTabCtl.bi b/src/clsTopTabCtl.bi
index 39a8cb4d..b6f88cb1 100644
--- a/src/clsTopTabCtl.bi
+++ b/src/clsTopTabCtl.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsTopTabCtl.bi.bak b/src/clsTopTabCtl.bi.bak
new file mode 100644
index 00000000..39a8cb4d
--- /dev/null
+++ b/src/clsTopTabCtl.bi.bak
@@ -0,0 +1,60 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+' Forward references
+Type clsDocument_ As clsDocument
+TYPE TOPTABS_TYPE
+ pDoc as clsDocument_ ptr
+ wszText as CWSTR
+ rcTab as RECT ' client coordinates
+ rcIcon as RECT ' client coordinates
+ rcText as RECT ' client coordinates
+ rcClose as RECT ' client coordinates
+ isHot as boolean
+end type
+
+
+Type clsTopTabCtl
+ Private:
+
+ Public:
+ hWindow as HWnd
+ ClientRightEdge as long ' the right edge (client right - action Panel)
+ CurSel as long = -1
+ FirstDisplayTab as long = 0
+ rcActionPanel as RECT
+ rcActionButton as RECT
+ rcPrevTabs as RECT
+ rcNextTabs as RECT
+ rcSplitEditor as RECT
+ tabs(any) as TOPTABS_TYPE
+
+ declare function IsSafeIndex( byval idx as long ) as boolean
+ declare function GetItemCount() as long
+ declare function RemoveElement( byval idx as long ) as long
+ Declare Function AddTab( ByVal pDoc As clsDocument Ptr ) As Long
+ Declare Function GetTabIndexFromFilename( Byref wszName As WString ) As Long
+ declare Function GetTabIndexByDocumentPtr( ByVal pDocIn As clsDocument Ptr ) As Long
+ Declare Function SetTabIndexByDocumentPtr( ByVal pDocIn As clsDocument Ptr ) As Long
+ Declare Function SetFocusTab( ByVal idx As Long ) As Long
+ Declare Function GetActiveDocumentPtr() As clsDocument Ptr
+ Declare Function GetDocumentPtr( ByVal idx As Long ) As clsDocument Ptr
+ Declare Function DisplayScintilla( ByVal idx As Long, ByVal bShow As BOOLEAN ) As Long
+ Declare Function SetTabText( ByVal idx As Long ) As Long
+ Declare Function NextTab() As Long
+ Declare Function PrevTab() As Long
+ Declare Function CloseTab( ByVal idx As Long = -1 ) As Long
+
+End Type
+
diff --git a/src/clsTopTabCtl.inc b/src/clsTopTabCtl.inc
index c8e032fa..b6d694fa 100644
--- a/src/clsTopTabCtl.inc
+++ b/src/clsTopTabCtl.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/clsTopTabCtl.inc.bak b/src/clsTopTabCtl.inc.bak
new file mode 100644
index 00000000..c8e032fa
--- /dev/null
+++ b/src/clsTopTabCtl.inc.bak
@@ -0,0 +1,281 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "clsTopTabCtl.bi"
+
+''
+''
+function clsTopTabCtl.IsSafeIndex( byval idx as long ) as boolean
+ ' test to see if the incoming idx is valid based on the boundaries
+ ' of the global tab array
+ if (idx >= lbound(this.tabs)) andalso (idx <= ubound(this.tabs)) then
+ return true
+ else
+ return false
+ end if
+end function
+
+''
+''
+function clsTopTabCtl.GetItemCount() as long
+ ' get the number tabs in the global tab array
+ return ubound(this.tabs) - lbound(this.tabs) + 1
+end function
+
+''
+''
+Function clsTopTabCtl.AddTab( ByVal pDoc As clsDocument Ptr ) As Long
+ ' Return the index of the added tab. we attempt to add it immediately
+ ' after the current active tab.
+ Dim idx As Long
+ redim preserve this.tabs(ubound(this.tabs) + 1) as TOPTABS_TYPE
+
+ if (this.CurSel = -1) orelse (this.CurSel = this.GetItemCount - 1) then
+ ' add the tab at the end of the array
+ idx = ubound(this.tabs)
+ else
+ ' insert the tab after the current tab
+ for i as long = ubound(this.tabs) to this.CurSel + 1 step -1
+ this.tabs(i) = this.tabs(i - 1)
+ next
+ idx = this.CurSel + 1
+ end if
+
+ this.tabs(idx).pDoc = pDoc
+ this.SetTabText(idx)
+
+ Function = idx
+End Function
+
+''
+''
+function clsTopTabCtl.RemoveElement( byval idx as long ) as long
+ ' remove an element from the this.tabs array
+ if this.IsSafeIndex(idx) = false then exit function
+ ' if this is the last element being removed then we need
+ ' to erase the global array
+ if this.GetItemCount() = 1 then
+ erase this.tabs
+ else
+ for i as long = idx to ubound(this.tabs) - 1
+ this.tabs(i) = this.tabs(i+1)
+ next
+ redim preserve this.tabs(ubound(this.tabs)-1)
+ end if
+ function = 0
+end function
+
+
+''
+''
+Function clsTopTabCtl.GetTabIndexFromFilename( Byref wszName As WString ) As Long
+ ' Get the index of tab that holds the incoming filename. This is used
+ ' mostly for positioning the editor to the correct document when an
+ ' error occurs during compiling.
+ ' Returns -1 if not found, otherwise zero based index of tab.
+
+ Dim As Long nCount = this.GetItemCount()
+ If nCount = 0 Then Return -1
+ If len(wszName) = 0 Then Return -1
+
+ for i as long = 0 To nCount - 1
+ if this.tabs(i).pDoc then
+ If Ucase(this.tabs(i).pDoc->DiskFilename) = Ucase(wszName) Then Return i
+ end if
+ Next
+
+ Function = -1 ' if not found
+End Function
+
+
+''
+''
+Function clsTopTabCtl.GetTabIndexByDocumentPtr( ByVal pDocIn As clsDocument Ptr ) As Long
+
+ Dim As Long nCount = this.GetItemCount()
+ If nCount = 0 Then Return -1
+ If pDocIn = 0 Then Return -1
+
+ for i as long = 0 To nCount - 1
+ if this.tabs(i).pDoc then
+ If this.tabs(i).pDoc = pDocIn Then Return i
+ end if
+ next
+
+ Function = -1 ' if not found
+End Function
+
+
+''
+''
+Function clsTopTabCtl.SetTabIndexByDocumentPtr( ByVal pDocIn As clsDocument Ptr ) As Long
+ Dim As Long nCount = this.GetItemCount()
+ If nCount = 0 Then Return -1
+ If pDocIn = 0 Then Return -1
+ for i as long = 0 To nCount - 1
+ If this.tabs(i).pDoc = pDocIn Then
+ function = this.SetFocusTab(i)
+ Exit Function
+ end if
+ next
+ Function = -1 ' if not found
+End Function
+
+
+''
+''
+Function clsTopTabCtl.SetFocusTab( ByVal idx As Long ) As Long
+
+ Dim As Long nCount = this.GetItemCount()
+ If nCount = 0 Then Return -1
+ if idx < 0 then idx = nCount - 1
+ if this.IsSafeIndex(idx) = false then exit function
+ if this.CurSel <> idx then
+ ' Send a user message to accomplish the same thing as TCN_SELCHANGING and TCN_SELCHANGE
+ SendMessage( HWND_FRMMAIN, MSG_USER_TOPTABS_CHANGING, 0, 0 )
+ this.CurSel = idx
+ SendMessage( HWND_FRMMAIN, MSG_USER_TOPTABS_CHANGED, 0, 0 )
+
+ ' V3.0.0 Disable the highlighting of searches when a user switches tabs? Report
+ ' from user that such action disrupts the user's train of thought because the spot
+ ' is lost within the file. Other users may feel differently?
+ if IsWindowVisible(HWND_FRMFINDREPLACE) then
+ frmFindReplace_HighlightSearches( false )
+ end if
+
+ ' Highlight the selected tab file in the Explorer listbox
+ frmExplorer_SelectItemData( this.tabs(idx).pDoc )
+ ' Highlight the selected tab file in the Function List listbox
+ frmFunctions_SelectItemData( this.tabs(idx).pDoc )
+ end if
+
+ function = this.CurSel
+End Function
+
+
+''
+''
+Function clsTopTabCtl.NextTab() As Long
+ ' Invoked by Ctl+TAB
+ ' Set the tab with focus (this sends the TCN_SELCHANGING and TCN_SELCHANGE
+ ' notification codes to its parent window).
+ Dim As Long nCount = this.GetItemCount
+ Dim As Long idx = this.CurSel
+ If nCount = 0 Then Exit Function
+ idx += 1
+ If idx > nCount - 1 Then idx = 0
+ Function = this.SetFocusTab(idx)
+End Function
+
+''
+''
+Function clsTopTabCtl.PrevTab() As Long
+ ' Invoked by Ctl+Shift+TAB
+ ' Set the tab with focus (this sends the TCN_SELCHANGING and TCN_SELCHANGE
+ ' notification codes to its parent window).
+ Dim As Long nCount = this.GetItemCount
+ Dim As Long idx = this.CurSel
+ If nCount = 0 Then Exit Function
+ idx -= 1
+ If idx < 0 Then idx = nCount - 1
+ Function = this.SetFocusTab(idx)
+End Function
+
+''
+''
+Function clsTopTabCtl.CloseTab( byval nTabIdx as long = -1) As Long
+ ' Invoked by clicking "X" on tab
+ OnCommand_FileClose( HWND_FRMMAIN, EFC_CLOSECURRENT, nTabIdx )
+ Function = 0
+End Function
+
+
+''
+''
+Function clsTopTabCtl.GetActiveDocumentPtr() As clsDocument Ptr
+ ' Return pointer to clsDocument class for the current active tab
+ If this.GetItemCount() = 0 Then Return 0
+ if this.IsSafeIndex(this.CurSel) = false then exit function
+ function = this.tabs(this.CurSel).pDoc
+End Function
+
+''
+''
+Function clsTopTabCtl.GetDocumentPtr( ByVal idx As Long ) As clsDocument Ptr
+ ' Return pointer to clsDocument class for the current active tab
+ if this.IsSafeIndex(idx) = false then exit function
+ function = this.tabs(idx).pDoc
+End Function
+
+''
+''
+Function clsTopTabCtl.DisplayScintilla( ByVal idx As Long, ByVal bShow As BOOLEAN ) As Long
+ ' Show/Hide the Scintilla editing window (or visual designer window) for the incoming tab index
+ Dim pDocShow As clsDocument Ptr
+
+ if this.IsSafeIndex(idx) = false then exit function
+ pDocShow = this.tabs(idx).pDoc
+ If pDocShow = 0 Then exit function
+
+ ' Hide all documents and their associated scrollbars
+ Dim pDoc As clsDocument Ptr = gApp.pDocList
+
+ do until pDoc = 0
+ ' Scintilla windows and scrollbars
+ ShowWindow(pDoc->hWindow(0), SW_HIDE)
+ ShowWindow(pDoc->hWindow(1), SW_HIDE)
+ if pDoc->IsDesigner THEN
+ ShowWindow(pDoc->hWndDesigner, SW_HIDE)
+ END IF
+ pDoc = pDoc->pDocNext
+ loop
+
+ if (pDocShow->IsDesigner) andalso (IsDesignerView(pDocShow)) THEN
+ ShowWindow(pDocShow->hWndDesigner, Iif(bShow, SW_SHOWNORMAL, SW_HIDE))
+ ShowWindow(HWND_FRMVDTOOLBOX, Iif(bShow, SW_SHOWNORMAL, SW_HIDE))
+ else
+ ' Show/Hide our current active Scintilla window and scrollbar
+ ShowWindow(pDocShow->hWindow(0), Iif(bShow, SW_SHOWNORMAL, SW_HIDE))
+ ShowWindow(pDocShow->hWindow(1), Iif(bShow, SW_SHOWNORMAL, SW_HIDE))
+ end if
+
+ Function = 0
+End Function
+
+''
+''
+Function clsTopTabCtl.SetTabText( ByVal idx As Long ) As Long
+ ' Set the text for the incoming tab index. If the index
+ ' is -1 then set the text of the current tab.
+ Dim wszText As WString * MAX_PATH
+ Dim wszTemp As WString * MAX_PATH
+ Dim pDoc As clsDocument Ptr
+
+ If idx = -1 Then idx = gTTabCtl.CurSel
+ if this.IsSafeIndex(idx) = false then exit function
+
+ pDoc = this.tabs(idx).pDoc
+ If pDoc Then
+ ' Set the text that displays on the tab
+ wszText = AfxStrPathname( "NAMEX", pDoc->DiskFilename )
+
+ ' We only update the text if it has changed in order to prevent flicker.
+ If wszText <> this.tabs(idx).wszText Then
+ this.tabs(idx).wszText = wszText
+ frmTopTabs_PositionWindows()
+ End If
+ End If
+
+ function = idx
+End Function
+
diff --git a/src/frmAbout.bi b/src/frmAbout.bi
index 28359c48..44eba6e5 100644
--- a/src/frmAbout.bi
+++ b/src/frmAbout.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmAbout.bi.bak b/src/frmAbout.bi.bak
new file mode 100644
index 00000000..28359c48
--- /dev/null
+++ b/src/frmAbout.bi.bak
@@ -0,0 +1,23 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMABOUT_LBLAPPNAME 1000
+#Define IDC_FRMABOUT_LBLAPPVERSION 1001
+#Define IDC_FRMABOUT_LBLAPPCOPYRIGHT 1002
+#Define IDC_FRMABOUT_CMDUPDATES 1003
+#Define IDC_FRMABOUT_IMAGE1 1004
+#Define IDC_FRMABOUT_LBLJOSE 1005
+
+declare Function frmAbout_Show( ByVal hWndParent As HWnd ) as LRESULT
diff --git a/src/frmAbout.inc b/src/frmAbout.inc
index a283ee27..c969e909 100644
--- a/src/frmAbout.inc
+++ b/src/frmAbout.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmAbout.inc.bak b/src/frmAbout.inc.bak
new file mode 100644
index 00000000..a283ee27
--- /dev/null
+++ b/src/frmAbout.inc.bak
@@ -0,0 +1,148 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmAbout.bi"
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmAbout
+' ========================================================================================
+Function frmAbout_OnCreate( _
+ ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmAbout
+' ========================================================================================
+Function frmAbout_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+ Case IDC_FRMABOUT_CMDUPDATES
+ If codeNotify = BN_CLICKED Then
+ DoCheckForUpdates( hwnd, false )
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmAbout
+' ========================================================================================
+Function frmAbout_OnClose( byval HWnd As HWnd) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow HWnd
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmAbout
+' ========================================================================================
+Function frmAbout_OnDestroy( byval HWnd As HWnd) As LRESULT
+ Dim As HFONT hFont = AfxGetWindowFont(GetDlgItem(HWnd, IDC_FRMABOUT_LBLAPPNAME))
+ DeleteFont(hFont)
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmAbout Window procedure
+' ========================================================================================
+Function frmAbout_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmAbout_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmAbout_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmAbout_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmAbout_OnCommand)
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmAbout_Show
+' ========================================================================================
+Function frmAbout_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+
+ pWindow->Create( hWndParent, L(74,"About"), @frmAbout_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT )
+ pWindow->SetClientSize(580, 280)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ ' Add an image control
+ DIM pImageCtx AS CImageCtx = CImageCtx(pWindow, IDC_FRMABOUT_IMAGE1, , 60, 50, 100, 100)
+ pImageCtx.LoadImageFromResource( pWindow->InstanceHandle, "IMAGE_WINFBE" )
+
+ Dim As HWnd hLabel = _
+ pWindow->AddControl("LABEL", , IDC_FRMABOUT_LBLAPPNAME, APPNAME, 200, 40, 400, 30, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_CENTERIMAGE Or SS_NOTIFY, WS_EX_LEFT Or WS_EX_LTRREADING)
+ Dim As HFONT hFont = pWindow->CreateFont("", 12, FW_BOLD)
+ AfxSetWindowFont hLabel, hFont, True
+
+ pWindow->AddControl("LABEL", , IDC_FRMABOUT_LBLAPPVERSION, "Version " & APPVERSION & APPBITS, 200, 71, 200, 20, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY, WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("LABEL", , IDC_FRMABOUT_LBLAPPCOPYRIGHT, APPCOPYRIGHT, 200, 115, 370, 20, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY, WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("LABEL", , IDC_FRMABOUT_LBLJOSE, "Special thanks to: José Roca (WinFBX Framework)", _
+ 200, 131, 300, 20, WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY, WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMABOUT_CMDUPDATES, L(91,"Check for Updates"), 200, 180, 200, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the frmAbout CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
+
diff --git a/src/frmBookmarks.bi b/src/frmBookmarks.bi
index 57794bd9..92e4476c 100644
--- a/src/frmBookmarks.bi
+++ b/src/frmBookmarks.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmBookmarks.bi.bak b/src/frmBookmarks.bi.bak
new file mode 100644
index 00000000..57794bd9
--- /dev/null
+++ b/src/frmBookmarks.bi.bak
@@ -0,0 +1,19 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#define IDC_FRMBOOKMARKS_LISTBOX 1000
+
+declare function frmBookmarks_Show( byval hWndParent as HWnd ) as LRESULT
+declare function LoadBookmarksFiles() as long
diff --git a/src/frmBookmarks.inc b/src/frmBookmarks.inc
index 800763cf..5a481765 100644
--- a/src/frmBookmarks.inc
+++ b/src/frmBookmarks.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmBookmarks.inc.bak b/src/frmBookmarks.inc.bak
new file mode 100644
index 00000000..800763cf
--- /dev/null
+++ b/src/frmBookmarks.inc.bak
@@ -0,0 +1,611 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+''
+'' frmBookmarks.inc
+''
+
+#include once "frmBookmarks.bi"
+
+' ========================================================================================
+' Get the Bookmarks line number from the Listbox line
+' ========================================================================================
+function getBookmarksLineNumber( byval wszCaption as CWSTR ) as long
+ ' do not use Parse for this because line may contain embedded % in description
+ dim as long nLineNum
+ dim as long f1
+ f1 = instr(wszCaption, "%")
+ if f1 then nLineNum = val(left(wszCaption, f1-1))
+ function = nLineNum
+end function
+
+' ========================================================================================
+' Get the Bookmarks description from the Listbox line
+' ========================================================================================
+function getBookmarksDescription( byval wszCaption as CWSTR ) as CWSTR
+ ' do not use Parse for this because line may contain embedded % in description
+ dim as CWSTR wszTemp = "Error retrieving bookmark"
+ dim as long f1
+ f1 = instr(wszCaption, "%")
+ if f1 then wszTemp = mid(wszCaption, f1 + 1)
+ function = wszTemp
+end function
+
+
+' ========================================================================================
+' Expand/Collapse all Bookmark Nodes
+' ========================================================================================
+function frmBookmarks_ExpandAll() as long
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ pDoc->bBookmarkExpanded = true
+ pDoc = pDoc->pDocNext
+ loop
+ LoadBookmarksFiles()
+ function = 0
+end function
+
+function frmBookmarks_CollapseAll() as long
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ pDoc->bBookmarkExpanded = false
+ pDoc = pDoc->pDocNext
+ loop
+ LoadBookmarksFiles()
+ function = 0
+end function
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+function frmBookmarks_PositionWindows() as LRESULT
+
+ ' Get the entire client area
+ dim as Rect rc
+ GetClientRect( HWND_FRMBOOKMARKS, @rc )
+
+ SetWindowPos( HWND_FRMBOOKMARKS_LISTBOX, 0, _
+ rc.left, rc.top, rc.right-rc.left, rc.bottom-rc.top, _
+ SWP_NOZORDER )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmBookmarks
+' ========================================================================================
+function frmBookmarks_OnSize( _
+ byval HWnd as HWnd, _
+ byval state as UINT, _
+ byval cx as long, _
+ byval cy as long _
+ ) as LRESULT
+ if state <> SIZE_MINIMIZED then
+ ' Position all of the child windows
+ frmBookmarks_PositionWindows
+ end if
+ function = 0
+end function
+
+' ========================================================================================
+' Process WM_PAINT message for window/dialog: frmBookmarks
+' ========================================================================================
+function frmBookmarks_OnPaint( byval HWnd as HWnd ) as LRESULT
+
+ dim as PAINTSTRUCT ps
+ dim as HDC hDc
+
+ hDC = BeginPaint(hWnd, @ps)
+
+ SaveDC( hDC )
+ FillRect( hDC, @ps.rcPaint, ghPanel.hPanelBrush )
+ RestoreDC( hDC, -1 )
+ EndPaint( hWnd, @ps )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_MEASUREITEM message for window/dialog: frmBookmarks
+' ========================================================================================
+function frmBookmarks_OnMeasureItem( _
+ byval HWnd as HWnd, _
+ byval lpmis as MEASUREITEMSTRUCT ptr _
+ ) as long
+ ' Set the height of the list box items.
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWnd)
+ lpmis->itemHeight = pWindow->ScaleY(EXPLORERITEM_HEIGHT)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_DRAWITEM message for window/dialog: frmBookmarks
+' ========================================================================================
+function frmBookmarks_OnDrawItem( _
+ byval HWnd as HWnd, _
+ byval lpdis as const DRAWITEMSTRUCT ptr _
+ ) as long
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ if pWindow = 0 then exit function
+
+ if lpdis = 0 then exit function
+
+ if ( lpdis->itemAction = ODA_DRAWENTIRE ) orelse _
+ ( lpdis->itemAction = ODA_SELECT ) orelse _
+ ( lpdis->itemAction = ODA_FOCUS ) then
+
+ dim as RECT rc = lpdis->rcItem
+ dim as long nWidth = rc.right-rc.left
+ dim as long nHeight = rc.bottom-rc.top
+
+ SaveDC(lpdis->hDC)
+
+ dim memDC as HDC ' Double buffering
+ dim hbit as HBITMAP ' Double buffering
+
+ memDC = CreateCompatibleDC( lpdis->hDC )
+ hbit = CreateCompatibleBitmap( lpdis->hDC, nWidth, nHeight )
+ if hbit then hbit = SelectObject( memDC, hbit )
+
+ SelectObject( memDC, ghMenuBar.hFontMenuBar )
+
+ ' Default to using normal
+ dim as HBRUSH hBrush = ghPanel.hBackBrush
+ dim as COLORREF foreclr = ghPanel.ForeColor
+ dim as COLORREF backclr = ghPanel.BackColor
+
+ dim as boolean IsHot = false
+ dim as boolean isNodeHeader = false
+ dim as boolean isIconDown = false
+
+ dim as POINT pt
+ GetCursorPos( @pt )
+ MapWindowPoints( lpdis->hwndItem, HWND_DESKTOP, cast( POINT ptr, @rc ), 2 )
+ if PtInRect( @rc, pt ) then IsHot = true
+
+ ' if mouse is over VScrollBar then reset hot
+ if isMouseOverWindow( HWND_FRMPANEL_VSCROLLBAR ) then IsHot = false
+
+ if ListBox_GetCurSel(lpdis->hwndItem) = lpdis->itemID then IsHot = true
+
+ hBrush = iif( IsHot, ghPanel.hBackBrushHot, ghPanel.hBackBrush)
+ backclr = iif( IsHot, ghPanel.BackColorHot, ghPanel.BackColor)
+ foreclr = iif( IsHot, ghPanel.ForeColorHot, ghPanel.ForeColor)
+
+ dim as CWSTR wszCaption = AfxGetListBoxText(lpdis->hwndItem, lpdis->ItemID)
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, lpdis->itemData)
+
+ ' if this is a "node" header
+ if left(wszCaption, 4) = "true" then
+ isNodeHeader = true
+ isIconDown = true
+ if pDoc then wszCaption = AfxStrPathName( "NAMEX", pDoc->DiskFilename )
+ elseif left(wszCaption, 5) = "false" then
+ isNodeHeader = true
+ isIconDown = false
+ if pDoc then wszCaption = AfxStrPathName( "NAMEX", pDoc->DiskFilename )
+ else
+ ' must be a bookmark line
+ wszCaption = getBookmarksDescription( wszCaption )
+ end if
+
+ ' Paint the entire background
+ ' Create our rect that works with the entire line
+ SetRect( @rc, 0, 0, nWidth, nHeight )
+ FillRect( memDC, @rc, hBrush )
+
+ SetBkColor( memDC, backclr )
+ SetTextColor( memDC, foreclr )
+
+ dim as RECT rcText = rc
+ dim as RECT rcBitmap = rc
+
+ dim as long wsStyle
+
+ ' indent the text based on its type
+ if isNodeHeader then
+ rcBitmap.right = rcBitmap.left + pWindow->ScaleX(20)
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_TOP or DT_SINGLELINE
+ if isIconDown then
+ DrawText( memDC, wszChevronDown, -1, cast(lpRect, @rcBitmap), wsStyle )
+ else
+ DrawText( memDC, wszChevronRight, -1, cast(lpRect, @rcBitmap), wsStyle )
+ end if
+ wszCaption = wszCaption
+ rcText.left = rcBitmap.right
+ SelectObject( memDC, ghMenuBar.hFontMenuBar )
+ wsStyle = DT_NOPREFIX or DT_LEFT or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszCaption.sptr, -1, cast(lpRect, @rcText), wsStyle )
+ else
+ ' This would be a regular file.
+ rcBitmap.left = rcText.left + pWindow->ScaleX(20)
+ rcBitmap.right = rcBitmap.left + pWindow->ScaleX(20)
+
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_TOP or DT_SINGLELINE
+ DrawText( memDC, wszDocumentIcon, -1, cast(lpRect, @rcBitmap), wsStyle )
+
+ rcText.left = rcBitmap.right
+ SelectObject( memDC, ghMenuBar.hFontMenuBar )
+ wsStyle = DT_NOPREFIX or DT_LEFT or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszCaption.sptr, -1, cast(lpRect, @rcText), wsStyle )
+ end if
+
+ BitBlt( lpdis->hDC, lpdis->rcItem.left, lpdis->rcItem.top, _
+ nWidth, nHeight, memDC, 0, 0, SRCCOPY )
+
+ ' Cleanup
+ if hbit then DeleteObject SelectObject(memDC, hbit)
+ if memDC then DeleteDC memDC
+ RestoreDC(lpdis->hDC, -1)
+ end if
+
+ function = true
+
+end function
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmBookmarks
+' ========================================================================================
+function frmBookmarks_OnCommand( _
+ byval HWnd as HWnd, _
+ byval id as long, _
+ byval hwndCtl as HWnd, _
+ byval codeNotify as UINT _
+ ) as LRESULT
+
+ select case codeNotify
+ case LBN_SELCHANGE
+ ' update the highlighting of the current line
+ AfxRedrawWindow(hwndCtl)
+ ' update the scrollbar position if necessary
+ frmBookmarks_PositionWindows()
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmBookmarks Window procedure
+' ========================================================================================
+function frmBookmarks_WndProc( _
+ byval HWnd as HWnd, _
+ byval uMsg as UINT, _
+ byval wParam as WPARAM, _
+ byval lParam as LPARAM _
+ ) as LRESULT
+
+ static hTooltip as HWND
+
+ select case uMsg
+ HANDLE_MSG (HWnd, WM_SIZE, frmBookmarks_OnSize)
+ HANDLE_MSG (HWnd, WM_PAINT, frmBookmarks_OnPaint)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmBookmarks_OnCommand)
+ HANDLE_MSG (HWnd, WM_MEASUREITEM, frmBookmarks_OnMeasureItem)
+ HANDLE_MSG (HWnd, WM_DRAWITEM, frmBookmarks_OnDrawItem)
+
+ case WM_ERASEBKGND
+ return true
+
+ end select
+
+ ' for messages that we don't deal with
+ function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+end function
+
+' ========================================================================================
+' frmBookmarksListBox_SubclassProc
+' ========================================================================================
+function frmBookmarksListBox_SubclassProc ( _
+ byval hWin as HWnd, _ ' // Control window handle
+ byval uMsg as UINT, _ ' // Type of message
+ byval _wParam as WPARAM, _ ' // First message parameter
+ byval _lParam as LPARAM, _ ' // Second message parameter
+ byval uIdSubclass as UINT_PTR, _ ' // The subclass ID
+ byval dwRefData as DWORD_PTR _ ' // Pointer to reference data
+ ) as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMBOOKMARKS)
+ static as long accumDelta
+ static as HWND hTooltip
+
+ ' keep track of last index we were over so that we only issue a
+ ' repaint if the cursor has moved off of the line
+ static as long nLastIdx = -1
+
+ select case uMsg
+ case MSG_USER_LOAD_BOOKMARKSFILES
+ LoadBookmarksFiles()
+
+ Case WM_MOUSEWHEEL
+ ' accumulate delta until scroll one line (up +120, down -120).
+ ' 120 is the Microsoft default delta
+ dim as long zDelta = GET_WHEEL_DELTA_WPARAM( _wParam )
+ dim as long nTopIndex = SendMessage( hWin, LB_GETTOPINDEX, 0, 0 )
+ accumDelta = accumDelta + zDelta
+ if accumDelta >= 120 then ' scroll up 3 lines
+ nTopIndex = nTopIndex - 3
+ nTopIndex = max( 0, nTopIndex )
+ SendMessage( hWin, LB_SETTOPINDEX, nTopIndex, 0 )
+ accumDelta = 0
+ frmPanelVScroll_PositionWindows( SW_SHOWNA )
+ elseif accumDelta <= -120 then ' scroll down 3 lines
+ nTopIndex = nTopIndex + 3
+ SendMessage( hWin, LB_SETTOPINDEX, nTopIndex, 0 )
+ accumDelta = 0
+ frmPanelVScroll_PositionWindows( SW_SHOWNA )
+ end if
+
+ Case WM_MOUSEMOVE
+ ' Track that we are over the control in order to catch the
+ ' eventual WM_MOUSEHOVER and WM_MOUSELEAVE events
+ dim tme as TrackMouseEvent
+ tme.cbSize = sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER or TME_LEAVE
+ tme.hwndTrack = hWin
+ TrackMouseEvent(@tme)
+
+ ' get the item rect that the mouse is over and only invalidate
+ ' that instead of the entire listbox
+ dim as RECT rc
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ if idx <> nLastIdx then
+ ListBox_GetItemRect( hWin, idx, @rc )
+ InvalidateRect( hWin, @rc, true )
+ ListBox_GetItemRect( hWin, nLastIdx, @rc )
+ InvalidateRect( hWin, @rc, true )
+ nLastIdx = idx
+ end if
+ end if
+
+ case WM_MOUSEHOVER
+ dim as CWSTR wszTooltip
+ if IsWindow(hTooltip) = 0 then hTooltip = AfxAddTooltip( hWin, "", false, false )
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ dim as CWSTR wszCaption = AfxGetListBoxText( hWin, idx )
+ if (left(wszCaption, 4) = "true") orelse (left(wszCaption, 5) = "false") then
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, ListBox_GetItemData( hWin, idx ))
+ if pDoc then wszTooltip = pDoc->DiskFilename
+ ' Display the tooltip
+ AfxSetTooltipText( hTooltip, hWin, wszTooltip )
+ AfxRedrawWindow( hWin )
+ end if
+ end if
+
+ case WM_MOUSELEAVE
+ nLastIdx = -1
+ AfxRedrawWindow(hWin)
+
+ case WM_RBUTTONDOWN
+ ' Create the popup menu
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, ListBox_GetItemData( hWin, idx ))
+ if pDoc then
+ dim as HMENU hPopupMenu
+ dim as CWSTR wszCaption = AfxGetListBoxText( hWin, idx )
+ if (left(wszCaption, 4) = "true") orelse (left(wszCaption, 5) = "false") then
+ hPopupMenu = CreateBookmarksHeaderNodeContextMenu()
+ else
+ hPopupMenu = CreateBookmarksBookmarkNodeContextMenu()
+ end if
+ dim as POINT pt: GetCursorPos( @pt )
+ dim as long id = TrackPopupMenu(hPopUpMenu, TPM_RETURNCMD, pt.x, pt.y, 0, HWND_FRMMAIN, byval null)
+ select case id
+ case IDM_CLEARALLBOOKMARKNODE
+ SciExec( pDoc->hWindow(0), SCI_MARKERDELETEALL, -1, 0 )
+ case IDM_REMOVEBOOKMARKNODE
+ dim as long nLineNum = val(AfxStrParse(wszCaption, 1, "%"))
+ pDoc->ToggleBookmark( nLineNum )
+ end select
+ LoadBookmarksFiles()
+ DestroyMenu( hPopUpMenu )
+ Return true ' prevent further processing that leads to WM_CONTEXTMENU
+ end if
+ end if
+
+ case WM_LBUTTONUP
+ ' determine if we clicked on a regular file or a node header
+ dim as RECT rc
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, ListBox_GetItemData( hWin, idx ))
+ dim as CWSTR wszCaption = AfxGetListBoxText( hWin, idx )
+ if (left(wszCaption, 4) = "true") orelse (left(wszCaption, 5) = "false") then
+ ' Toggle the show/hide of bookmarks under this node
+ if pDoc then pDoc->bBookmarkExpanded = not pDoc->bBookmarkExpanded
+ ' allow listbox click event to fully process before loading new bookmarks
+ PostMessage( hWin, MSG_USER_LOAD_BOOKMARKSFILES, 0, 0 )
+ else
+ ' Attempt to show the bookmark
+ dim as long nLineNum = getBookmarksLinenumber( wszCaption )
+ dim as CWSTR wszDiskFilename
+ if pDoc then wszDiskFilename = pDoc->DiskFilename
+ OpenSelectedDocument( wszDiskFilename, "", nLineNum )
+ end if
+ end if
+
+ case WM_ERASEBKGND
+ ' if the number of lines in the listbox maybe less than the number per page then
+ ' calculate from last item to bottom of listbox, otherwise calculate based on
+ ' the mod of the lineheight to listbox height so we can color the partial line
+ ' that won't be displayed at the bottom of the list.
+ dim as RECT rc: GetClientRect( hWin, @rc )
+
+ dim as RECT rcItem
+ SendMessage( hWin, LB_GETITEMRECT, 0, cast(LPARAM, @rcItem) )
+ dim as long itemHeight = rcItem.bottom - rcItem.top
+ dim as long NumItems = ListBox_GetCount(hWin)
+ dim as long nTopIndex = SendMessage( hWin, LB_GETTOPINDEX, 0, 0 )
+ dim as long visible_rows = 0
+ dim as long ItemsPerPage = 0
+ dim as long bottom_index = 0
+
+ if NumItems > 0 then
+ ItemsPerPage = (rc.bottom - rc.top) / itemHeight
+ bottom_index = (nTopIndex + ItemsPerPage)
+ if bottom_index >= NumItems then bottom_index = NumItems - 1
+ visible_rows = (bottom_index - nTopIndex) + 1
+ rc.top = visible_rows * itemHeight
+ end if
+
+ if rc.top < rc.bottom then
+ dim as HDC _hDC = cast(HDC, _wParam)
+ FillRect( _hDC, @rc, ghPanel.hPanelBrush )
+ end if
+
+ ValidateRect( hWin, @rc )
+ return true
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hWin, @frmBookmarksListBox_SubclassProc, uIdSubclass )
+ end select
+
+ ' For messages that we don't deal with
+ function = DefSubclassProc( hWin, uMsg, _wParam, _lParam )
+
+end function
+
+
+' ========================================================================================
+' frmBookmarks_Show
+' ========================================================================================
+function frmBookmarks_Show( byval hWndParent as HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ dim pWindow as CWindow ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMBOOKMARKS = pWindow->Create( hWndParent, "Bookmarks Window", @frmBookmarks_WndProc, _
+ 0, 0, 0, 0, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT or WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR)
+
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ HWND_FRMBOOKMARKS_LISTBOX = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMBOOKMARKS_LISTBOX, "", 0, 0, 0, 0, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_TABSTOP or _
+ LBS_NOINTEGRALHEIGHT or LBS_OWNERDRAWFIXED or LBS_HASSTRINGS or LBS_NOTIFY, _
+ WS_EX_LEFT or WS_EX_RIGHTSCROLLBAR, , _
+ cast(SUBCLASSPROC, @frmBookmarksListBox_SubclassProc), _
+ IDC_FRMBOOKMARKS_LISTBOX, cast(DWORD_PTR, @pWindow))
+
+ function = 0
+
+end function
+
+
+' ========================================================================================
+' LoadBookmarksFiles
+' This will clear the current list of files in the listbox and repopulate it
+' with the latest list of filenames that are stored in the hidden FunctionList treeview.
+' ========================================================================================
+function LoadBookmarksFiles() as long
+ dim as HWND hList = GetDlgItem(HWND_FRMBOOKMARKS, IDC_FRMBOOKMARKS_LISTBOX)
+
+ ' Hide the listbox while it is loading so that we don't get the unpainted
+ ' white background from the empty listbox
+ ShowWindow( hList, SW_HIDE )
+
+ ' Save the topindex because we will restore it after filling the new contents
+ dim as long nTopIndex = SendMessage( hList, LB_GETTOPINDEX, 0, 0 )
+
+ ' Clear all content from the listbox
+ ListBox_ResetContent(hList)
+
+ dim wszText as wstring * MAX_PATH
+
+ ' Iterate all pDoc in the project/files list
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ ' Filename node line format. The drawing routine will parse this string to determine
+ ' what glyph to display as well as the filename only portion of the diskfilename.
+ ' true ' expanded node
+ ' false ' collapsed node
+ ' Bookmark node line format.
+ ' 231%Select Case nCount ' bookmark on line 231 of the specified file
+
+ ' Test if the pDoc has active bookmarks
+ dim as long idx, nLineNum, nCount
+ dim as string sBookmarks
+
+ ' Search documents that have been loaded and have valid Scintilla window.
+ if pDoc->hWindow(0) <> null then
+ sBookmarks = pDoc->GetBookmarks()
+ end if
+
+ if len(sBookmarks) then
+ wszText = wstr(pDoc->bBookmarkExpanded)
+ idx = Listbox_AddString( hList, @wszText )
+ ListBox_SetItemData( hList, idx, pDoc )
+
+ if pDoc->bBookmarkExpanded then
+ nCount = AfxStrParseCount( sBookmarks, "," )
+ for i as long = 1 to nCount
+ nLineNum = val( AfxStrParse( sBookmarks, i, "," ) )
+ wszText = wstr(nLineNum) & _
+ "%" & ltrim(pDoc->GetLine(nLineNum))
+ idx = Listbox_AddString( hList, @wszText )
+ ListBox_SetItemData( hList, idx, pDoc )
+ next
+ end if
+ end if
+
+ pDoc = pDoc->pDocNext
+ loop
+
+ ' Restore the top index so the list displays like it did before being reset
+ SendMessage( hList, LB_SETTOPINDEX, nTopIndex, 0 )
+
+ ' Ensure that Listbox is now properly sized and then show
+ ' the listbox now that it is fully populated (only if it contains any
+ ' items because zero items can produce white background).
+ if ListBox_GetCount( hList ) then ShowWindow( hList, SW_SHOW )
+ frmBookmarks_PositionWindows()
+
+ AfxRedrawWindow( hList )
+
+ ' Determine if the VScroll bar has changed size or is now hidden/shown
+ frmPanelVScroll_PositionWindows( SW_HIDE )
+
+ function = 0
+end function
+
+
diff --git a/src/frmBuildConfig.bi b/src/frmBuildConfig.bi
index dedc2278..7802523a 100644
--- a/src/frmBuildConfig.bi
+++ b/src/frmBuildConfig.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmBuildConfig.bi.bak b/src/frmBuildConfig.bi.bak
new file mode 100644
index 00000000..dedc2278
--- /dev/null
+++ b/src/frmBuildConfig.bi.bak
@@ -0,0 +1,37 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+#DEFINE IDC_FRMBUILDCONFIG_LIST1 1000
+#DEFINE IDC_FRMBUILDCONFIG_LABEL1 1001
+#DEFINE IDC_FRMBUILDCONFIG_TXTDESCRIPTION 1002
+#DEFINE IDC_FRMBUILDCONFIG_LABEL2 1003
+#DEFINE IDC_FRMBUILDCONFIG_TXTOPTIONS 1004
+#DEFINE IDC_FRMBUILDCONFIG_CMDUP 1005
+#DEFINE IDC_FRMBUILDCONFIG_CMDDOWN 1006
+#DEFINE IDC_FRMBUILDCONFIG_CMDINSERT 1007
+#DEFINE IDC_FRMBUILDCONFIG_CMDDELETE 1008
+#DEFINE IDC_FRMBUILDCONFIG_OPT32 1009
+#DEFINE IDC_FRMBUILDCONFIG_OPT64 1010
+#Define IDC_FRMBUILDCONFIG_LSTOPTIONS 1011
+#Define IDC_FRMBUILDCONFIG_CHKISDEFAULT 1012
+
+#define FRMBUILDCONFIG_LISTBOX_LINEHEIGHT 20
+
+declare function frmBuildConfig_getActiveBuildIndex() as long
+declare function frmBuildConfig_GetSelectedBuildDescription() as CWSTR
+declare function frmBuildConfig_GetSelectedBuildGUID() as String
+declare Function frmBuildConfig_Show( ByVal hWndParent As HWnd ) As LRESULT
+
diff --git a/src/frmBuildConfig.inc b/src/frmBuildConfig.inc
index efbc325b..d687d03c 100644
--- a/src/frmBuildConfig.inc
+++ b/src/frmBuildConfig.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmBuildConfig.inc.bak b/src/frmBuildConfig.inc.bak
new file mode 100644
index 00000000..efbc325b
--- /dev/null
+++ b/src/frmBuildConfig.inc.bak
@@ -0,0 +1,777 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmBuildConfig.bi"
+#include once "clsConfig.bi"
+#include once "clsTopTabCtl.bi"
+#include once "clsDocument.bi"
+
+' Create an array that holds all options in the Build compiler options listbox. The
+' description contains a parenthesis enclosed action.
+Dim shared gBuildOptions(...) as CWSTR => _
+ { "Language compatibility FreeBasic (-lang fb)", _
+ "Language compatibility FreeBasic Lite (-lang fblite)", _
+ "Language compatibility QuickBasic (-lang qb)", _
+ "Subsystem to console (-s console)", _
+ "Subsystem to GUI (-s gui)", _
+ "Compiler 32-bit assembler backend (-gen gas)", _
+ "Compiler 64-bit assembler backend (-gen gas64)", _
+ "Compiler GCC backend (-gen gcc)", _
+ "Compiler LLVM backend (-gen llvm)", _
+ "Create DLL and import library (-dll)", _
+ "Create static library (-lib)", _
+ "Add error checking (-e)", _
+ "Add error checking with RESUME support (-ex)", _
+ "Same as -ex with array bounds and null pointer (-exx)", _
+ "Add debug information (-g)", _
+ "Compile only, do not link (-c)", _
+ "Do not delete the object files (-C)", _
+ "Emit preprocessed output, do not compile (-pp)" _
+ }
+
+' ========================================================================================
+' Load all of the build descriptions into the listbox
+' ========================================================================================
+private function frmBuildConfig_LoadBuildListBox( byval hParent as hwnd ) as Long
+ dim hList1 as hwnd = GetDlgItem(hParent, IDC_FRMBUILDCONFIG_LIST1)
+
+ ListBox_ResetContent(hList1)
+ for i as long = lbound(gConfig.BuildsTemp) to ubound(gConfig.BuildsTemp)
+ ListBox_AddString(hList1, gConfig.BuildsTemp(i).wszDescription.sptr)
+ NEXT
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Determine the current active build index
+' ========================================================================================
+public function frmBuildConfig_getActiveBuildIndex() as long
+ ' determine the default build in case no other build overrides it
+ dim as long nDefault
+ for i as long = lbound(gConfig.Builds) to ubound(gConfig.Builds)
+ if gConfig.Builds(i).IsDefault then
+ nDefault = i: exit for
+ end if
+ next
+
+ ' determine if a project or previous config selection overrides the default
+ dim as long idx = -1
+ for i as long = lbound(gConfig.Builds) to ubound(gConfig.Builds)
+ if gApp.IsProjectActive then
+ if gConfig.Builds(i).id = gApp.ProjectBuild then
+ idx = i: exit for
+ end if
+ else
+ if gConfig.CompilerBuild = gConfig.Builds(i).id then
+ idx = i: exit for
+ end if
+ end if
+ next
+
+ if idx = -1 then idx = nDefault
+ function = idx
+end function
+
+
+' ========================================================================================
+' Return the string description of the currently selected build configuration
+' ========================================================================================
+public function frmBuildConfig_GetSelectedBuildDescription() as CWSTR
+ dim as long nCurSel = frmBuildConfig_getActiveBuildIndex()
+ if nCurSel > -1 THEN
+ function = gConfig.Builds(nCurSel).wszDescription
+ END IF
+end function
+
+
+' ========================================================================================
+' Return the string GUID of the currently selected build configuration
+' ========================================================================================
+public function frmBuildConfig_GetSelectedBuildGUID() as String
+ dim as long nCurSel = frmBuildConfig_getActiveBuildIndex()
+ if nCurSel > -1 THEN
+ function = gConfig.Builds(nCurSel).Id
+ END IF
+end function
+
+
+' ========================================================================================
+' Return the string GUID of the default (if any) build configuration
+' ========================================================================================
+private function frmBuildConfig_GetDefaultBuildGUID() as String
+ for i as long = lbound(gConfig.Builds) to ubound(gConfig.Builds)
+ if gConfig.Builds(i).IsDefault then
+ return gConfig.Builds(i).Id
+ end if
+ NEXT
+ function = ""
+end function
+
+
+' ========================================================================================
+' Swap two entries in the build Listbox
+' ========================================================================================
+private function frmBuildConfig_SwapListBoxItems( byval Item1 as long, _
+ Byval Item2 as long _
+ ) as Long
+ dim as hwnd hList1 = GetDlgItem( HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_LIST1)
+
+ ' Swap the array values
+ swap gConfig.BuildsTemp(Item1), gConfig.BuildsTemp(Item2)
+
+ ListBox_ReplaceString(hList1, Item1, gConfig.BuildsTemp(Item1).wszDescription)
+ ListBox_ReplaceString(hList1, Item2, gConfig.BuildsTemp(Item2).wszDescription)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Set the build description and compiler options depending on what listbox entry is selected
+' ========================================================================================
+private function frmBuildConfig_SetBuildConfigTextboxes() as long
+ dim as hwnd hList1 = GetDlgItem( HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_LIST1)
+ dim as hwnd hList2 = GetDlgItem( HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_LSTOPTIONS)
+ dim as hwnd hCheck = GetDlgItem( HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_CHKISDEFAULT)
+ dim as hwnd hText1 = GetDlgItem( HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_TXTDESCRIPTION)
+ dim as hwnd hText2 = GetDlgItem( HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_TXTOPTIONS)
+ dim as hwnd hOpt32 = GetDlgItem( HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_OPT32)
+ dim as hwnd hOpt64 = GetDlgItem( HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_OPT64)
+
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+ if nCurSel < 0 THEN
+ AfxSetWindowText( hText1, "")
+ AfxSetWindowText( hText2, "")
+ Button_SetCheck( hCheck, 0)
+ CheckRadioButton(HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_OPT32, IDC_FRMBUILDCONFIG_OPT64, IDC_FRMBUILDCONFIG_OPT32)
+ EnableWindow(hText1, false)
+ EnableWindow(hText2, false)
+ EnableWindow(hCheck, false)
+ EnableWindow(hOpt32, false)
+ EnableWindow(hOpt64, false)
+ EnableWindow(hList2, false)
+ else
+ AfxSetWindowText( hText1, gConfig.BuildsTemp(nCurSel).wszDescription)
+ AfxSetWindowText( hText2, gConfig.BuildsTemp(nCurSel).wszOptions)
+ Button_SetCheck( hCheck, gConfig.BuildsTemp(nCurSel).IsDefault)
+ if gConfig.BuildsTemp(nCurSel).Is32bit THEN
+ CheckRadioButton(HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_OPT32, IDC_FRMBUILDCONFIG_OPT64, IDC_FRMBUILDCONFIG_OPT32)
+ else
+ CheckRadioButton(HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_OPT32, IDC_FRMBUILDCONFIG_OPT64, IDC_FRMBUILDCONFIG_OPT64)
+ END IF
+ EnableWindow(hText1, true)
+ EnableWindow(hText2, true)
+ EnableWindow(hCheck, true)
+ EnableWindow(hOpt32, true)
+ EnableWindow(hOpt64, true)
+ EnableWindow(hList2, true)
+ end if
+
+ ' Set the checkmarks in the OptionList Listbox by redrawing the Listbox
+ AfxRedrawWindow(hList2)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_MEASUREITEM message for window/dialog: frmBuildConfig
+' ========================================================================================
+private Function frmBuildConfig_OnMeasureItem( ByVal HWnd As HWnd, _
+ ByVal lpmis As MEASUREITEMSTRUCT Ptr _
+ ) As Long
+ ' Set the height of the List box items.
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ lpmis->itemHeight = pWindow->ScaleY(FRMBUILDCONFIG_LISTBOX_LINEHEIGHT)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DRAWITEM message for window/dialog: frmBuildConfig
+' ========================================================================================
+private Function frmBuildConfig_OnDrawItem( ByVal HWnd As HWnd, _
+ ByVal lpdis As Const DRAWITEMSTRUCT Ptr _
+ ) As Long
+
+ Dim memDC as HDC ' Double buffering
+ Dim hbit As HBITMAP ' Double buffering
+
+ Dim As HBRUSH hBrush
+ dim as HICON hCheckBox
+ Dim As RECT rc, rc2
+ dim as long nWidth, nHeight
+ dim as CWSTR wszText, wszOptions, wszAction
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ if pWindow = 0 THEN exit function
+
+ If lpdis->itemID = -1 Then Exit Function
+
+ Select Case lpdis->itemAction
+ Case ODA_DRAWENTIRE, ODA_SELECT
+
+ SaveDC(lpdis->hDC)
+
+ if lpdis->CtlID = IDC_FRMBUILDCONFIG_LIST1 then
+ wszText = gConfig.BuildsTemp(lpdis->itemID).wszDescription
+ hCheckBox = 0
+ elseif lpdis->CtlID = IDC_FRMBUILDCONFIG_LSTOPTIONS then
+ wszText = gBuildOptions(lpdis->itemID)
+ ' Get the selected item in the Builds listbox and then look at the OptionList for
+ ' that build for each of the individual OptionList build options.
+ dim as long nSelBuild = ListBox_GetCurSel(GetDlgItem(hwnd, IDC_FRMBUILDCONFIG_LIST1))
+ if nSelBuild > -1 then
+ wszOptions = " " & gConfig.BuildsTemp(nSelBuild).wszOptions & " "
+ wszAction = " " & AfxStrExtract(gBuildOptions(lpdis->itemID), "(", ")") & " "
+ hCheckBox = iif( instr(wszOptions, wszAction), ghIconTick, ghIconNoTick)
+ end if
+ end if
+
+ nWidth = lpdis->rcItem.right-lpdis->rcItem.left
+ nHeight = lpdis->rcItem.bottom-lpdis->rcItem.top
+
+ memDC = CreateCompatibleDC( lpdis->hDC )
+ hbit = CreateCompatibleBitmap( lpdis->hDC, nWidth, nHeight )
+
+ If hbit Then hbit = SelectObject( memDC, hbit )
+
+ ' Create our rect that works with the entire line
+ SetRect(@rc, 0, 0, nWidth, nHeight)
+ FillRect(memDC, @rc, GetSysColorBrush(COLOR_WINDOW))
+
+ ' Draw the tick/untick image
+ ' The line height is FRMBUILDCONFIG_LISTBOX_LINEHEIGHT so center the 16x16 icon vertically and horizontally
+ rc2 = rc
+ if hCheckBox then
+ DrawIconEx( memDC, _
+ rc.Left + pWindow->ScaleX(2), _
+ rc.Top + pWindow->ScaleY(2), _
+ hCheckBox, _
+ pWindow->ScaleX(16), pWindow->ScaleY(16), 0, 0, DI_NORMAL)
+ rc2.Left = pWindow->ScaleX(20)
+ end if
+
+ ' DETERMINE TEXT BACKGROUND
+ If (lpdis->itemState And ODS_SELECTED) Then
+ SetBkColor(memDC, GetSysColor(COLOR_HIGHLIGHT))
+ SetTextColor(memDC, GetSysColor(COLOR_HIGHLIGHTTEXT))
+ hBrush = GetSysColorBrush(COLOR_HIGHLIGHT)
+ else
+ SetBkColor(memDC, GetSysColor(COLOR_WINDOW))
+ SetTextColor(memDC, GetSysColor(COLOR_WINDOWTEXT))
+ hBrush = GetSysColorBrush(COLOR_WINDOW)
+ end if
+
+ ' Output the text
+ SelectObject(memDC, AfxGetWindowFont(lpdis->hwndItem))
+ SelectObject(memDC, hBrush)
+ FillRect(memDC, @rc2, hBrush)
+
+ rc2.Left = rc2.Left + pWindow->ScaleX(4)
+ DrawText( memDC, wszText, _
+ -1, Cast(lpRect, @rc2), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER )
+
+ ' Draw the border edges
+ SetBkMode(memDC, TRANSPARENT)
+ DrawEdge( memDC, @rc, EDGE_SUNKEN, BF_BOTTOMRIGHT)
+
+ ' Copy the entire memory bitmap over to the visual display
+ BitBlt lpdis->hDC, lpdis->rcItem.left, lpdis->rcItem.top, nWidth, nHeight, memDC, 0, 0, SRCCOPY
+
+ ' Cleanup
+ If hbit Then DeleteObject SelectObject(memDC, hbit)
+ If memDC Then DeleteDC memDC
+
+ RestoreDC(lpdis->hDC, -1)
+
+
+ Function = True : Exit Function
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed ListBox window.
+' ========================================================================================
+private function frmBuildConfig_ProcessListboxClick( byval hwnd as HWND, _
+ byval nCurSel as long _
+ ) as long
+ if nCurSel = -1 then exit function
+
+ ' Get the action text for this listbox item. If it exists in the Options
+ ' textbox then remove it
+ dim as CWSTR wszText = " " & AfxGetWindowText( GetDlgItem(HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_TXTOPTIONS)) & " "
+ dim as CWSTR wszAction = " " & AfxStrExtract(gBuildOptions(nCurSel), "(", ")") & " "
+ ' If the action exists, remove it. If it does not exist then add it.
+ if instr(wszText, wszAction) then
+ wszText = trim(AfxStrRemove(wszText, wszAction))
+ else
+ wszText = trim(wszText) & " " & trim(wszAction)
+ end if
+ AfxSetWindowText( GetDlgItem(HWND_FRMBUILDCONFIG, IDC_FRMBUILDCONFIG_TXTOPTIONS), wszText)
+
+ function = 0
+
+end function
+
+
+' ========================================================================================
+' Processes messages for the subclassed ListBox window.
+' ========================================================================================
+private Function frmBuildConfig_ListBox_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+
+ Select Case uMsg
+
+ case WM_ERASEBKGND
+ ' Only erase the bottom portion of the listbox that extends from the last item
+ ' to the bottom edge of the listbox. All other lines are already drawn. This helps
+ ' reduce screen flicker.
+ dim as RECT rc = GetListBoxEmptyClientArea( HWND, FRMBUILDCONFIG_LISTBOX_LINEHEIGHT )
+ if rc.top < rc.bottom then
+ dim as HDC hDC = cast(HDC, wParam)
+ FillRect(hDC, @rc, GetSysColorBrush(COLOR_WINDOW))
+ end if
+ return TRUE
+
+
+ Case WM_GETDLGCODE
+ ' All keyboard input
+ Function = DLGC_WANTALLKEYS
+ Exit Function
+
+ Case WM_KEYUP
+ Select Case Loword(wParam)
+ Case VK_SPACE
+ dim as long nCurSel = ListBox_GetCurSel(hwnd)
+ frmBuildConfig_ProcessListboxClick(hwnd, nCurSel)
+ Exit Function
+ case VK_ESCAPE
+ PostMessage( GetParent(HWnd), WM_CLOSE, 0, 0 )
+ Exit Function
+ End Select
+
+ case WM_MOUSEMOVE
+ case WM_LBUTTONDOWN
+
+ case WM_LBUTTONUP
+ ' Handle if the checkbox is clicked
+ dim as long nCurSel = ListBox_GetCurSel(hwnd)
+ if nCurSel = -1 then exit function
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(GetParent(HWnd))
+ if pWindow = 0 THEN exit function
+ dim as RECT rc: SendMessage(hwnd, LB_GETITEMRECT, nCurSel, cast(LPARAM, @rc))
+ ' The checkbox is the first 20x20 area (16x16 icon)
+ rc.Left = rc.Left + pWindow->ScaleX(2)
+ rc.Top = rc.Top + pWindow->ScaleY(2)
+ rc.Right = rc.Left + pWindow->ScaleX(16)
+ rc.Bottom = rc.Top + pWindow->ScaleY(16)
+ dim as POINT pt = (loword(lParam), Hiword(lParam))
+ if PtInRect(@rc, pt) then
+ frmBuildConfig_ProcessListboxClick(hwnd, nCurSel)
+ InvalidateRect(hwnd, @rc, true): UpdateWindow(hwnd)
+ END IF
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass HWnd, @frmBuildConfig_ListBox_SubclassProc, uIdSubclass
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmBuildConfig
+' ========================================================================================
+private Function frmBuildConfig_OnCreate( ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmBuildConfig
+' ========================================================================================
+private Function frmBuildConfig_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim as hwnd hList1 = GetDlgItem( HWND, IDC_FRMBUILDCONFIG_LIST1)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+
+ ' Convert a ListBox DoubleClick into pressing OK button action
+ if (id = IDC_FRMBUILDCONFIG_LIST1) AndAlso (codeNotify = LBN_DBLCLK) THEN
+ id = IDOK: codeNotify = BN_CLICKED
+ END IF
+
+ Select Case id
+ case IDC_FRMBUILDCONFIG_LIST1
+ if codeNotify = LBN_SELCHANGE THEN
+ frmBuildConfig_SetBuildConfigTextboxes()
+ END IF
+
+ case IDC_FRMBUILDCONFIG_TXTDESCRIPTION
+ if codeNotify = EN_CHANGE THEN
+ ' Update the temp array and the Listbox
+ if nCurSel > -1 THEN
+ gConfig.BuildsTemp(nCurSel).wszDescription = AfxGetWindowText(hwndCtl)
+ ListBox_ReplaceString(hList1, nCurSel, gConfig.BuildsTemp(nCurSel).wszDescription)
+ END IF
+ end if
+
+ CASE IDC_FRMBUILDCONFIG_TXTOPTIONS
+ if codeNotify = EN_CHANGE THEN
+ ' Update the temp array
+ if nCurSel > -1 THEN
+ gConfig.BuildsTemp(nCurSel).wszOptions = AfxGetWindowText(hwndCtl)
+ ' Refresh the Options listbox so any manually entered options will
+ ' now be checked in the listbox.
+ AfxRedrawWindow(GetDlgItem(hwnd, IDC_FRMBUILDCONFIG_LSTOPTIONS))
+ END IF
+ end if
+
+ case IDC_FRMBUILDCONFIG_OPT32
+ if codeNotify = BN_CLICKED THEN
+ ' Update the temp array
+ if nCurSel > -1 THEN
+ if Button_GetCheck(hwndCtl) THEN
+ gConfig.BuildsTemp(nCurSel).Is32bit = 1
+ gConfig.BuildsTemp(nCurSel).Is64bit = 0
+ else
+ gConfig.BuildsTemp(nCurSel).Is32bit = 0
+ gConfig.BuildsTemp(nCurSel).Is64bit = 1
+ END IF
+ END IF
+ end if
+
+ case IDC_FRMBUILDCONFIG_OPT64
+ if codeNotify = BN_CLICKED THEN
+ ' Update the temp array
+ if nCurSel > -1 THEN
+ if Button_GetCheck(hwndCtl) THEN
+ gConfig.BuildsTemp(nCurSel).Is32bit = 0
+ gConfig.BuildsTemp(nCurSel).Is64bit = 1
+ else
+ gConfig.BuildsTemp(nCurSel).Is32bit = 1
+ gConfig.BuildsTemp(nCurSel).Is64bit = 0
+ END IF
+ END IF
+ end if
+
+ case IDC_FRMBUILDCONFIG_CHKISDEFAULT
+ if codeNotify = BN_CLICKED THEN
+ ' Update the temp array
+ if nCurSel > -1 THEN
+ gConfig.BuildsTemp(nCurSel).IsDefault = Button_GetCheck(hwndCtl)
+ ' Can only have 1 entry as the default so ensure all others are reset
+ if Button_GetCheck(hwndCtl) THEN
+ for i as long = lbound(gConfig.BuildsTemp) to ubound(gConfig.BuildsTemp)
+ if i <> nCurSel THEN gConfig.BuildsTemp(i).IsDefault = 0
+ NEXT
+ END IF
+ END IF
+ end if
+
+ case IDC_FRMBUILDCONFIG_CMDUP
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > 0 THEN
+ frmBuildConfig_SwapListboxItems(nCurSel, nCurSel-1)
+ END IF
+ end if
+
+ case IDC_FRMBUILDCONFIG_CMDDOWN
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel < ListBox_GetCount(hList1)-1 THEN
+ frmBuildConfig_SwapListboxItems(nCurSel, nCurSel+1)
+ END IF
+ end if
+
+ case IDC_FRMBUILDCONFIG_CMDINSERT
+ if codeNotify = BN_CLICKED THEN
+ if ubound(gConfig.BuildsTemp) = -1 THEN
+ redim gConfig.BuildsTemp(0)
+ nCurSel = 0
+ Else
+ redim preserve gConfig.BuildsTemp(ubound(gConfig.BuildsTemp)+1)
+ if nCurSel = -1 THEN nCurSel = 0
+ ' insert the item above current entry in the internal array
+ for i as long = ubound(gConfig.BuildsTemp) to nCurSel + 1 step -1
+ gConfig.BuildsTemp(i) = gConfig.BuildsTemp(i-1)
+ NEXT
+ END IF
+ gConfig.BuildsTemp(nCurSel).Id = AfxGuidText(AfxGuid())
+ gConfig.BuildsTemp(nCurSel).wszDescription = ""
+ gConfig.BuildsTemp(nCurSel).wszOptions = ""
+ gConfig.BuildsTemp(nCurSel).IsDefault = 0
+ gConfig.BuildsTemp(nCurSel).Is32bit = 1
+ gConfig.BuildsTemp(nCurSel).Is64bit = 0
+ ' reload the listbox
+ frmBuildConfig_LoadBuildListBox(HWND)
+ nCurSel = Min(nCurSel, ubound(gConfig.BuildsTemp))
+ ListBox_SetCurSel(hList1, nCurSel)
+ frmBuildConfig_SetBuildConfigTextboxes()
+ SetFocus hList1
+ end if
+
+ case IDC_FRMBUILDCONFIG_CMDDELETE
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN
+ if MessageBox( HWND, L(287, "Are you sure you want to delete this build configuration?"), L(276,"Confirm"), _
+ MB_YESNOCANCEL Or MB_ICONINFORMATION Or MB_DEFBUTTON1 ) = IDYES then
+ if ubound(gConfig.BuildsTemp) = 0 THEN
+ erase gConfig.BuildsTemp
+ nCurSel = -1
+ else
+ ' remove the item from the internal array
+ for i as long = nCurSel to ubound(gConfig.BuildsTemp) - 1
+ gConfig.BuildsTemp(i) = gConfig.BuildsTemp(i+1)
+ NEXT
+ redim preserve gConfig.BuildsTemp(ubound(gConfig.BuildsTemp)-1)
+ END IF
+ ' reload the listbox
+ frmBuildConfig_LoadBuildListBox(HWND)
+ nCurSel = Min(nCurSel, ubound(gConfig.BuildsTemp))
+ ListBox_SetCurSel(hList1, nCurSel)
+ frmBuildConfig_SetBuildConfigTextboxes()
+ SetFocus hList1
+ end if
+ END IF
+ end if
+
+ Case IDOK
+ If codeNotify = BN_CLICKED Then
+ ' Copy the temporary items to the main array
+ redim gConfig.Builds(ubound(gConfig.BuildsTemp))
+ for i as long = lbound(gConfig.BuildsTemp) to ubound(gConfig.BuildsTemp)
+ gConfig.Builds(i) = gConfig.BuildsTemp(i)
+ NEXT
+ erase gConfig.BuildsTemp
+
+ ' Set the active project or the active document to the selected build
+ if nCurSel > -1 THEN
+ If gApp.IsProjectActive Then
+ gApp.ProjectBuild = gConfig.Builds(nCurSel).Id
+ Else
+ Dim pDocMain As clsDocument Ptr
+ pDocMain = gTTabCtl.GetActiveDocumentPtr()
+ If pDocMain Then pDocMain->DocumentBuild = gConfig.Builds(nCurSel).Id
+ gConfig.CompilerBuild = gConfig.Builds(nCurSel).Id
+ end if
+ frmMain_SetStatusbar
+ end if
+
+ gConfig.SaveConfigFile
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ end if
+
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmBuildConfig
+' ========================================================================================
+private Function frmBuildConfig_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow( HWnd )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmBuildConfig
+' ========================================================================================
+private Function frmBuildConfig_OnDestroy( byval HWnd As HWnd) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmBuildConfig Window procedure
+' ========================================================================================
+private Function frmBuildConfig_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmBuildConfig_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmBuildConfig_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmBuildConfig_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmBuildConfig_OnCommand)
+ HANDLE_MSG (HWnd, WM_MEASUREITEM, frmBuildConfig_OnMeasureItem)
+ HANDLE_MSG (HWnd, WM_DRAWITEM, frmBuildConfig_OnDrawItem)
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmBuildConfig_Show
+' ========================================================================================
+public Function frmBuildConfig_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ DIM hBitmap AS HBITMAP
+ dim hCtrl as HWnd
+ dim wszImage as wstring * 100
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ Dim As HWnd hForm = _
+ pWindow->Create(hWndParent, L(277,"Build Configurations"), _
+ @frmBuildConfig_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT )
+ pWindow->SetClientSize(622, 436)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ pWindow->AddControl("LISTBOX", , IDC_FRMBUILDCONFIG_LIST1, "", 10, 10, 218, 362, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or _
+ LBS_NOINTEGRALHEIGHT OR LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmBuildConfig_ListBox_SubclassProc), IDC_FRMBUILDCONFIG_LIST1, Cast(DWORD_PTR, @pWindow))
+
+ pWindow->AddControl("LABEL", , IDC_FRMBUILDCONFIG_LABEL1, L(278,"Description") & ":", 240, 11, 91, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMBUILDCONFIG_CHKISDEFAULT, L(280,"Set as default"), 380, 10, 240, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMBUILDCONFIG_TXTDESCRIPTION, "", 240, 32, 372, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("RADIOBUTTON", , IDC_FRMBUILDCONFIG_OPT32, "FBC 32-bit", 240, 54, 100, 20, _
+ WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER or WS_GROUP, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("RADIOBUTTON", , IDC_FRMBUILDCONFIG_OPT64, "FBC 64-bit", 342, 54, 100, 20, _
+ WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMBUILDCONFIG_LABEL2, L(279,"Compiler Options") & ":", 240, 82, 136, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMBUILDCONFIG_TXTOPTIONS, "", 240, 103, 372, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("LISTBOX", , IDC_FRMBUILDCONFIG_LSTOPTIONS, "", 240, 129, 372, 243, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or _
+ LBS_NOINTEGRALHEIGHT OR LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmBuildConfig_ListBox_SubclassProc), IDC_FRMBUILDCONFIG_LSTOPTIONS, Cast(DWORD_PTR, @pWindow))
+
+
+ pWindow->AddControl("BUTTON", , IDC_FRMBUILDCONFIG_CMDINSERT, L(281, "Insert"), 8, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMBUILDCONFIG_CMDDELETE, L(282, "Delete"), 87, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ hCtrl = _
+ pWindow->AddControl("BUTTON", , IDC_FRMBUILDCONFIG_CMDUP, wszTriangleUp, 166, 388, 28, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghMenuBar.hFontSymbolLargeBold, false )
+
+ hCtrl = _
+ pWindow->AddControl("BUTTON", , IDC_FRMBUILDCONFIG_CMDDOWN, wszTriangleDown, 199, 388, 28, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghMenuBar.hFontSymbolLargeBold, false )
+
+ pWindow->AddControl("BUTTON", , IDOK, L(0,"OK"), 454, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(1,"Cancel"), 536, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ HWND_FRMBUILDCONFIG = hForm
+
+ ' Copy all of the Builds to the BuildsTemp array because we will work with
+ ' temporary copies until the user hits OK.
+ redim gConfig.BuildsTemp(ubound(gConfig.Builds))
+ for i as long = lbound(gConfig.Builds) to ubound(gConfig.Builds)
+ gConfig.BuildsTemp(i) = gConfig.Builds(i)
+ NEXT
+ frmBuildConfig_LoadBuildListBox(hForm)
+
+ ' Load the Compiler Options Listbox
+ hCtrl = GetDlgItem(hForm, IDC_FRMBUILDCONFIG_LSTOPTIONS)
+ for i as long = lbound(gBuildOptions) to ubound(gBuildOptions)
+ ListBox_AddString(hCtrl, gBuildOptions(i).sptr)
+ next
+
+
+ ' Set the current build selection
+ dim as long nCurSel = frmBuildConfig_getActiveBuildIndex()
+ dim hList as hwnd = GetDlgItem(hForm, IDC_FRMBUILDCONFIG_LIST1)
+ if nCurSel = -1 then nCurSel = 0
+ ListBox_SetCurSel(hList, nCurSel)
+ frmBuildConfig_SetBuildConfigTextboxes()
+
+ SetFocus GetDlgItem(hForm, IDC_FRMBUILDCONFIG_LIST1)
+
+ ' Process Windows messages(modal)
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the frmBuildConfig CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
diff --git a/src/frmCategories.bi b/src/frmCategories.bi
index b8478a38..879d3bfd 100644
--- a/src/frmCategories.bi
+++ b/src/frmCategories.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmCategories.bi.bak b/src/frmCategories.bi.bak
new file mode 100644
index 00000000..b8478a38
--- /dev/null
+++ b/src/frmCategories.bi.bak
@@ -0,0 +1,30 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+#DEFINE IDC_FRMCATEGORIES_LIST1 1000
+#DEFINE IDC_FRMCATEGORIES_TXTDESCRIPTION 1001
+#DEFINE IDC_FRMCATEGORIES_CMDUP 1002
+#DEFINE IDC_FRMCATEGORIES_CMDDOWN 1003
+#DEFINE IDC_FRMCATEGORIES_CMDADD 1004
+#DEFINE IDC_FRMCATEGORIES_CMDEDIT 1005
+#DEFINE IDC_FRMCATEGORIES_CMDDELETE 1006
+#DEFINE IDC_FRMCATEGORIES_CMDOK 1007
+#DEFINE IDC_FRMCATEGORIES_CMDCANCEL 1008
+
+#define FRMCATEGORIES_LISTBOX_LINEHEIGHT 20
+
+declare Function frmCategories_Show( ByVal hWndParent As HWnd ) As LRESULT
+
diff --git a/src/frmCategories.inc b/src/frmCategories.inc
index 98011730..151a3c7c 100644
--- a/src/frmCategories.inc
+++ b/src/frmCategories.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmCategories.inc.bak b/src/frmCategories.inc.bak
new file mode 100644
index 00000000..98011730
--- /dev/null
+++ b/src/frmCategories.inc.bak
@@ -0,0 +1,627 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmCategories.bi"
+#include once "clsConfig.bi"
+
+
+' ========================================================================================
+' Enable/disable controls based on current selected listbox line
+' ========================================================================================
+function frmCategories_UpdateControlStates() as long
+ dim as hwnd hList = GetDlgItem( HWND_FRMCATEGORIES, IDC_FRMCATEGORIES_LIST1)
+ dim as long nCurSel = ListBox_GetCurSel(hList)
+ dim as long idx = ListBox_GetItemData(hList, nCurSel)
+
+ dim as hwnd hAdd = GetDlgItem( HWND_FRMCATEGORIES, IDC_FRMCATEGORIES_CMDADD)
+ dim as hwnd hEdit = GetDlgItem( HWND_FRMCATEGORIES, IDC_FRMCATEGORIES_CMDEDIT)
+ dim as hwnd hDelete = GetDlgItem( HWND_FRMCATEGORIES, IDC_FRMCATEGORIES_CMDDELETE)
+
+ ' Always allow Add
+ EnableWindow( hAdd, true )
+
+ if idx <> -1 then
+ ' Allow Edit, Delete
+ EnableWindow( hEdit, true )
+ EnableWindow( hDelete, true )
+ else
+ ' do not allow edit, delete for default items or headers
+ EnableWindow( hEdit, false )
+ EnableWindow( hDelete, false )
+ end if
+ function = 0
+end function
+
+
+' ========================================================================================
+' Move the description textbox into place
+' ========================================================================================
+function frmCategories_StartEdit( byval nCurSel as long ) as long
+ ' Move the description textbox into place
+ if nCurSel = -1 then exit function
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMCATEGORIES)
+ if pWindow = 0 THEN exit function
+
+ dim as hwnd hList = GetDlgItem( HWND_FRMCATEGORIES, IDC_FRMCATEGORIES_LIST1)
+
+ dim as long idx = ListBox_GetItemData( hList, nCurSel )
+ if idx <> -1 then
+ dim as RECT rc: ListBox_GetItemRect( hList, nCurSel, @rc )
+ rc.left = rc.left + pWindow->ScaleX(17)
+ rc.top = rc.top + pWindow->ScaleY(2)
+ MapWindowPoints( hList, HWND_FRMCATEGORIES, cast(POINT ptr, @rc), 2 )
+ dim as HWND hCtrl = GetDlgItem( HWND_FRMCATEGORIES, IDC_FRMCATEGORIES_TXTDESCRIPTION )
+ dim as CWSTR wszText = AfxGetListBoxText( hList, nCurSel )
+ AfxSetWindowText( hCtrl, wszText )
+ SetWindowPos( hCtrl, HWND_TOP, rc.left, rc.top, rc.right-rc.left, rc.bottom-rc.top, SWP_SHOWWINDOW )
+ SetFocus( hCtrl )
+ end if
+ function = 0
+end function
+
+
+' ========================================================================================
+' Load all of the build descriptions into the listbox
+' ========================================================================================
+function frmCategories_LoadBuildListBox( byval hParent as hwnd ) as Long
+ dim hList1 as hwnd = GetDlgItem(hParent, IDC_FRMCATEGORIES_LIST1)
+
+ dim as CWSTR wszText
+ dim as long idx
+
+ ListBox_ResetContent(hList1)
+
+ ' Default system nodes
+ wszText = "%%" & L(438, "Default Explorer Categories")
+ idx = ListBox_AddString( hList1, wszText.sptr )
+ ListBox_SetItemData( hList1, idx, -1 )
+ for i as long = lbound(gConfig.CatTemp) to ubound(gConfig.CatTemp)
+ if left(gConfig.CatTemp(i).idFileType, 1) <> "{" then
+ idx = ListBox_AddString( hList1, gConfig.CatTemp(i).wszDescription.sptr )
+ ListBox_SetItemData( hList1, idx, -1 )
+ end if
+ next
+
+ wszText = "%%" & L(439, "User Defined Explorer Categories")
+ idx = ListBox_AddString( hList1, wszText.sptr )
+ ListBox_SetItemData( hList1, idx, -1 )
+ for i as long = lbound(gConfig.CatTemp) to ubound(gConfig.CatTemp)
+ ' User defined categories will have an GUID id. Starts with an {
+ if left(gConfig.CatTemp(i).idFileType, 1) = "{" then
+ idx = ListBox_AddString( hList1, gConfig.CatTemp(i).wszDescription.sptr )
+ ListBox_SetItemData( hList1, idx, i )
+ end if
+ next
+
+ dim as HWND hCtrl = GetDlgItem( HWND_FRMCATEGORIES, IDC_FRMCATEGORIES_TXTDESCRIPTION )
+ if IsWindowVisible( hCtrl ) then
+ SetWindowPos( hCtrl, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE )
+ end if
+
+ frmCategories_UpdateControlStates()
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Swap two entries in the Listbox
+' ========================================================================================
+function frmCategories_SwapListBoxItems( _
+ byval Item1 as long, _
+ Byval Item2 as long _
+ ) as Long
+ dim as hwnd hList1 = GetDlgItem( HWND_FRMCATEGORIES, IDC_FRMCATEGORIES_LIST1)
+
+ dim as long idx1 = ListBox_GetItemData( hList1, Item1 )
+ dim as long idx2 = ListBox_GetItemData( hList1, Item2 )
+ if idx1 = -1 then exit function
+ if idx2 = -1 then exit function
+
+ ' We can not swap with an item that is a header (starts with %%)
+ if left(gConfig.CatTemp(idx1).wszDescription, 2) = "%%" then exit function
+ if left(gConfig.CatTemp(idx2).wszDescription, 2) = "%%" then exit function
+
+ ' Swap the array values
+ swap gConfig.CatTemp(idx1), gConfig.CatTemp(idx2)
+
+ ListBox_ReplaceString( hList1, Item1, gConfig.CatTemp(idx1).wszDescription, idx1 )
+ ListBox_ReplaceString( hList1, Item2, gConfig.CatTemp(idx2).wszDescription, idx2 )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_MEASUREITEM message for window/dialog: frmCategories
+' ========================================================================================
+Function frmCategories_OnMeasureItem( _
+ ByVal HWnd As HWnd, _
+ ByVal lpmis As MEASUREITEMSTRUCT Ptr _
+ ) As Long
+ ' Set the height of the List box items.
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ lpmis->itemHeight = pWindow->ScaleY( FRMCATEGORIES_LISTBOX_LINEHEIGHT )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DRAWITEM message for window/dialog: frmCategories
+' ========================================================================================
+Function frmCategories_OnDrawItem( _
+ ByVal HWnd As HWnd, _
+ ByVal lpdis As Const DRAWITEMSTRUCT Ptr _
+ ) As Long
+
+ Dim memDC as HDC ' Double buffering
+ Dim hbit As HBITMAP ' Double buffering
+
+ Dim As HBRUSH hBrush
+ Dim As RECT rc
+ dim as long nWidth, nHeight
+ dim as CWSTR wszText
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ if pWindow = 0 THEN exit function
+
+ If lpdis->itemID = -1 Then Exit Function
+
+ Select Case lpdis->itemAction
+ Case ODA_DRAWENTIRE, ODA_SELECT
+
+ SaveDC( lpdis->hDC )
+
+ wszText = AfxGetListBoxText( lpdis->hwndItem, lpdis->itemID)
+
+ nWidth = lpdis->rcItem.right - lpdis->rcItem.left
+ nHeight = lpdis->rcItem.bottom - lpdis->rcItem.top
+
+ memDC = CreateCompatibleDC( lpdis->hDC )
+ hbit = CreateCompatibleBitmap( lpdis->hDC, nWidth, nHeight )
+
+ If hbit Then hbit = SelectObject( memDC, hbit )
+
+ ' Create our rect that works with the entire line
+ SetRect( @rc, 0, 0, nWidth, nHeight )
+ FillRect( memDC, @rc, GetSysColorBrush(COLOR_WINDOW) )
+
+ ' DETERMINE TEXT BACKGROUND
+ If (lpdis->itemState And ODS_SELECTED) and _
+ IsWindowVisible( GetDlgItem(HWnd, IDC_FRMCATEGORIES_TXTDESCRIPTION)) = false Then
+ SetBkColor( memDC, GetSysColor(COLOR_HIGHLIGHT) )
+ SetTextColor( memDC, GetSysColor(COLOR_HIGHLIGHTTEXT) )
+ hBrush = GetSysColorBrush( COLOR_HIGHLIGHT )
+ else
+ SetBkColor( memDC, GetSysColor(COLOR_WINDOW) )
+ SetTextColor( memDC, GetSysColor(COLOR_WINDOWTEXT) )
+ hBrush = GetSysColorBrush( COLOR_WINDOW )
+ end if
+
+ ' Output the text
+ SelectObject( memDC, AfxGetWindowFont(lpdis->hwndItem) )
+ SelectObject( memDC, hBrush )
+ FillRect( memDC, @rc, hBrush )
+
+ dim as RECT rcText = rc
+
+ if left(wszText, 2) = "%%" then
+ SelectObject( memDC, ghStatusBar.hFontStatusBarBold )
+ wszText = mid(wszText, 3)
+ rcText.Left = rcText.Left + pWindow->ScaleX(4)
+ DrawText( memDC, wszText, -1, Cast(lpRect, @rcText), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER )
+ else
+ if IsWindowVisible( GetDlgItem(HWnd, IDC_FRMCATEGORIES_TXTDESCRIPTION)) Then
+ if lpdis->itemID = ListBox_GetCurSel( lpdis->hwndItem ) then
+ SelectObject( memDC, ghMenuBar.hFontSymbolSmall )
+ DrawText( memDC, wszChevronRight, -1, Cast(lpRect, @rcText), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER )
+ end if
+ end if
+ SelectObject( memDC, ghStatusBar.hFontStatusBar )
+ rcText.Left = rcText.Left + pWindow->ScaleX(20)
+ DrawText( memDC, wszText, -1, Cast(lpRect, @rcText), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER )
+ end if
+
+ ' Draw the border edges
+ SetBkMode( memDC, TRANSPARENT )
+ DrawEdge( memDC, @rc, EDGE_SUNKEN, BF_BOTTOMRIGHT )
+
+ ' Copy the entire memory bitmap over to the visual display
+ BitBlt( lpdis->hDC, lpdis->rcItem.left, lpdis->rcItem.top, nWidth, nHeight, memDC, 0, 0, SRCCOPY )
+
+ ' Cleanup
+ If hbit Then DeleteObject( SelectObject(memDC, hbit) )
+ If memDC Then DeleteDC( memDC )
+
+ RestoreDC( lpdis->hDC, -1 )
+
+ Function = True : Exit Function
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed ListBox window.
+' ========================================================================================
+Function frmCategories_ListBox_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ Select Case uMsg
+
+ case WM_ERASEBKGND
+ ' Only erase the bottom portion of the listbox that extends from the last item
+ ' to the bottom edge of the listbox. All other lines are already drawn. This helps
+ ' reduce screen flicker.
+ dim as RECT rc = GetListBoxEmptyClientArea( HWND, FRMCATEGORIES_LISTBOX_LINEHEIGHT )
+ if rc.top < rc.bottom then
+ dim as HDC hDC = cast(HDC, wParam)
+ FillRect( hDC, @rc, GetSysColorBrush(COLOR_WINDOW) )
+ end if
+ return true
+
+ Case WM_GETDLGCODE
+ ' All keyboard input
+ Function = DLGC_WANTALLKEYS
+ Exit Function
+
+ Case WM_KEYUP
+ Select Case Loword(wParam)
+ Case VK_SPACE, VK_RETURN
+ dim as long nCurSel = ListBox_GetCurSel(hwnd)
+ frmCategories_StartEdit( nCurSel )
+ Exit Function
+ case VK_ESCAPE
+ PostMessage( GetParent(HWnd), WM_CLOSE, 0, 0 )
+ Exit Function
+ End Select
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( HWnd, @frmCategories_ListBox_SubclassProc, uIdSubclass )
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc( HWnd, uMsg, wParam, lParam )
+
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed TextBox window.
+' ========================================================================================
+Function frmCategories_Textbox_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ Select Case uMsg
+
+ Case WM_GETDLGCODE
+ ' All keyboard input
+ Function = DLGC_WANTALLKEYS
+ Exit Function
+
+ Case WM_KEYUP
+ Select Case Loword(wParam)
+ Case VK_RETURN, VK_ESCAPE
+ ShowWindow( HWnd, SW_HIDE )
+ SetFocus( GetDlgItem( HWND_FRMCATEGORIES, IDC_FRMCATEGORIES_LIST1) )
+ Exit Function
+ End Select
+
+ case WM_CHAR
+ ' prevent beep on Enter/Esc
+ if wParam = 13 then return 0
+ if wParam = 27 then return 0
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( HWnd, @frmCategories_Textbox_SubclassProc, uIdSubclass )
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc( HWnd, uMsg, wParam, lParam )
+
+End Function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmCategories
+' ========================================================================================
+Function frmCategories_OnCreate( _
+ ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmCategories
+' ========================================================================================
+Function frmCategories_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim as hwnd hList1 = GetDlgItem( HWND, IDC_FRMCATEGORIES_LIST1)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+
+
+ Select Case id
+ case IDC_FRMCATEGORIES_LIST1
+ if codeNotify = LBN_SELCHANGE then
+ frmCategories_UpdateControlStates()
+ elseif codeNotify = LBN_DBLCLK then
+ frmCategories_StartEdit( nCurSel )
+ end if
+
+ case IDC_FRMCATEGORIES_TXTDESCRIPTION
+ if codeNotify = EN_CHANGE then
+ ' Update the temp array and the Listbox
+ if nCurSel > -1 then
+ dim as long idx = ListBox_GetItemData( hList1, nCurSel )
+ if idx <> -1 then
+ gConfig.CatTemp(idx).wszDescription = AfxGetWindowText(hwndCtl)
+ ListBox_ReplaceString( hList1, nCurSel, gConfig.CatTemp(idx).wszDescription, idx )
+ end if
+ end if
+ elseif codeNotify = EN_KILLFOCUS then
+ ShowWindow( hwndCtl, SW_HIDE )
+ end if
+
+ case IDC_FRMCATEGORIES_CMDUP
+ if codeNotify = BN_CLICKED then
+ if nCurSel > 0 then
+ frmCategories_SwapListboxItems( nCurSel, nCurSel - 1 )
+ end if
+ end if
+
+ case IDC_FRMCATEGORIES_CMDDOWN
+ if codeNotify = BN_CLICKED then
+ if nCurSel < ListBox_GetCount( hList1 ) - 1 then
+ frmCategories_SwapListboxItems( nCurSel, nCurSel + 1 )
+ end if
+ end if
+
+ case IDC_FRMCATEGORIES_CMDADD
+ if codeNotify = BN_CLICKED THEN
+ dim as long ub = ubound(gConfig.CatTemp) + 1
+ redim preserve gConfig.CatTemp(ub)
+ gConfig.CatTemp(ub).idFileType = AfxGuidText(AfxGuid())
+ gConfig.CatTemp(ub).wszDescription = ""
+ ' reload the listbox
+ frmCategories_LoadBuildListBox(HWND)
+ nCurSel = ListBox_GetCount(hList1) - 1
+ ListBox_SetCurSel( hList1, nCurSel )
+ frmCategories_StartEdit( nCurSel )
+ end if
+
+ case IDC_FRMCATEGORIES_CMDEDIT
+ if codeNotify = BN_CLICKED THEN
+ ListBox_SetCurSel( hList1, nCurSel )
+ frmCategories_StartEdit( nCurSel )
+ end if
+
+ case IDC_FRMCATEGORIES_CMDDELETE
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN
+ if MessageBox( HWND, L(437, "Are you sure you want to delete this Explorer Category?"), L(276,"Confirm"), _
+ MB_YESNOCANCEL Or MB_ICONINFORMATION Or MB_DEFBUTTON1 ) = IDYES then
+ if ubound(gConfig.CatTemp) = 0 THEN
+ erase gConfig.CatTemp
+ nCurSel = -1
+ else
+ ' remove the item from the internal array
+ for i as long = nCurSel to ubound(gConfig.CatTemp) - 1
+ dim as long idx = ListBox_GetItemData( hList1, i )
+ if idx <> 1 then
+ gConfig.CatTemp(idx) = gConfig.CatTemp(idx+1)
+ end if
+ NEXT
+ redim preserve gConfig.CatTemp(ubound(gConfig.CatTemp)-1)
+ END IF
+ ' reload the listbox
+ frmCategories_LoadBuildListBox(HWND)
+ nCurSel = Min(nCurSel, ubound(gConfig.CatTemp))
+ ListBox_SetCurSel( hList1, nCurSel )
+ SetFocus( hList1 )
+ end if
+ end if
+ end if
+
+ Case IDC_FRMCATEGORIES_CMDOK
+ If codeNotify = BN_CLICKED Then
+ ' Copy the temporary items to the main array
+ redim gConfig.Cat(ubound(gConfig.CatTemp))
+ for i as long = lbound(gConfig.CatTemp) to ubound(gConfig.CatTemp)
+ gConfig.Cat(i) = gConfig.CatTemp(i)
+ NEXT
+ erase gConfig.CatTemp
+ gConfig.SaveConfigFile
+ LoadExplorerFiles()
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ end if
+
+ Case IDC_FRMCATEGORIES_CMDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmCategories
+' ========================================================================================
+Function frmCategories_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow( HWnd )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmCategories
+' ========================================================================================
+Function frmCategories_OnDestroy( byval HWnd As HWnd) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmCategories Window procedure
+' ========================================================================================
+Function frmCategories_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmCategories_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmCategories_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmCategories_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmCategories_OnCommand)
+ HANDLE_MSG (HWnd, WM_MEASUREITEM, frmCategories_OnMeasureItem)
+ HANDLE_MSG (HWnd, WM_DRAWITEM, frmCategories_OnDrawItem)
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+End Function
+
+
+' ========================================================================================
+' frmCategories_Show
+' ========================================================================================
+Function frmCategories_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ dim as HWND hCtrl, hList
+ dim wszImage as wstring * 100
+ dim hBitmap as HANDLE
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ HWND_FRMCATEGORIES = _
+ pWindow->Create(hWndParent, L(436,"Explorer Categories"), _
+ @frmCategories_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT )
+ pWindow->SetClientSize(510, 436)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ hList = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMCATEGORIES_LIST1, "", 10, 10, 490, 362, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or _
+ LBS_NOINTEGRALHEIGHT OR LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmCategories_ListBox_SubclassProc), IDC_FRMCATEGORIES_LIST1, Cast(DWORD_PTR, @pWindow))
+
+ hCtrl = _
+ pWindow->AddControl("TEXTBOX", , IDC_FRMCATEGORIES_TXTDESCRIPTION, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmCategories_Textbox_SubclassProc), IDC_FRMCATEGORIES_TXTDESCRIPTION, Cast(DWORD_PTR, @pWindow))
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, false )
+
+ pWindow->AddControl("BUTTON", , IDC_FRMCATEGORIES_CMDADD, L(380, "Add"), 8, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMCATEGORIES_CMDEDIT, L(14, "Edit"), 87, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMCATEGORIES_CMDDELETE, L(282, "Delete"), 166, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ hCtrl = _
+ pWindow->AddControl("BUTTON", , IDC_FRMCATEGORIES_CMDUP, wszTriangleUp, 245, 388, 28, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghMenuBar.hFontSymbolLargeBold, false )
+
+ hCtrl = _
+ pWindow->AddControl("BUTTON", , IDC_FRMCATEGORIES_CMDDOWN, wszTriangleDown, 278, 388, 28, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghMenuBar.hFontSymbolLargeBold, false )
+
+ pWindow->AddControl("BUTTON", , IDC_FRMCATEGORIES_CMDOK, L(0,"OK"), 346, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMCATEGORIES_CMDCANCEL, L(1,"Cancel"), 425, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ ' Copy all of the Categories to the temp array because we will work with
+ ' temporary copies until the user hits OK.
+ redim gConfig.CatTemp(ubound(gConfig.Cat))
+ for i as long = lbound(gConfig.Cat) to ubound(gConfig.Cat)
+ gConfig.CatTemp(i) = gConfig.Cat(i)
+ NEXT
+ frmCategories_LoadBuildListBox( HWND_FRMCATEGORIES )
+
+ dim as long nCurSel = ListBox_GetCount(hList) - 1
+ ListBox_SetCurSel( hList, nCurSel )
+ frmCategories_UpdateControlStates()
+ SetFocus( hList )
+
+ ' Process Windows messages(modal)
+ Function = pWindow->DoEvents( SW_SHOW )
+
+ ' Delete the CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
diff --git a/src/frmCommandLine.bi b/src/frmCommandLine.bi
index 003d4257..78f78bc5 100644
--- a/src/frmCommandLine.bi
+++ b/src/frmCommandLine.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmCommandLine.bi.bak b/src/frmCommandLine.bi.bak
new file mode 100644
index 00000000..003d4257
--- /dev/null
+++ b/src/frmCommandLine.bi.bak
@@ -0,0 +1,19 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMCOMMANDLINE_LABEL1 1000
+#Define IDC_FRMCOMMANDLINE_TEXTBOX1 1001
+
+declare Function frmCommandLine_Show( ByVal hWndParent As HWnd ) as LRESULT
diff --git a/src/frmCommandLine.inc b/src/frmCommandLine.inc
index 0d0f9f59..933a8a00 100644
--- a/src/frmCommandLine.inc
+++ b/src/frmCommandLine.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmCommandLine.inc.bak b/src/frmCommandLine.inc.bak
new file mode 100644
index 00000000..0d0f9f59
--- /dev/null
+++ b/src/frmCommandLine.inc.bak
@@ -0,0 +1,156 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmCommandLine.bi"
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmCommandLine
+' ========================================================================================
+private Function frmCommandLine_OnCreate( ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmCommandLine
+' ========================================================================================
+private Function frmCommandLine_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+ Case IDOK
+ If codeNotify = BN_CLICKED Then
+ ' A commandline parameter is not saved for non-project files. These are
+ ' set at the time when the user opens the file. For project related files the
+ ' command line is saved to the project file.
+ if gApp.IsProjectActive then
+ gApp.ProjectCommandLine = AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMCOMMANDLINE_TEXTBOX1) )
+ else
+ gApp.wszCommandLine = AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMCOMMANDLINE_TEXTBOX1) )
+ end if
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmCommandLine
+' ========================================================================================
+private Function frmCommandLine_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow HWnd
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmCommandLine
+' ========================================================================================
+private Function frmCommandLine_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmCommandLine Window procedure
+' ========================================================================================
+private Function frmCommandLine_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmCommandLine_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmCommandLine_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmCommandLine_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmCommandLine_OnCommand)
+ End Select
+
+ Function = DefWindowProcW(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmCommandLine_Show
+' ========================================================================================
+public Function frmCommandLine_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ pWindow->Create( hWndParent, L(178,"Command Line"), @frmCommandLine_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT)
+ pWindow->SetClientSize(420, 100)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ pWindow->AddControl("LABEL", , IDC_FRMCOMMANDLINE_LABEL1, L(179,"Enter command line arguments:"), 10, 10, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT, WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ Dim As HWnd hTextBox = _
+ pWindow->AddControl("TEXTBOX", , IDC_FRMCOMMANDLINE_TEXTBOX1, "", 10, 33, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("BUTTON", , IDOK, L(0,"&OK"), 252, 63, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_DEFPUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(1,"&Cancel"), 336, 63, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ if gApp.IsProjectActive then
+ AfxSetWindowText( hTextBox, gApp.ProjectCommandLine )
+ else
+ AfxSetWindowText( hTextBox, gApp.wszCommandLine )
+ end if
+
+ SetFocus hTextBox
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the frmCommandLine CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
diff --git a/src/frmDesignTabs.bi b/src/frmDesignTabs.bi
index e44e1035..27e34458 100644
--- a/src/frmDesignTabs.bi
+++ b/src/frmDesignTabs.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmDesignTabs.bi.bak b/src/frmDesignTabs.bi.bak
new file mode 100644
index 00000000..e44e1035
--- /dev/null
+++ b/src/frmDesignTabs.bi.bak
@@ -0,0 +1,23 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+type DESIGNTABS_TYPE
+ wszText as CWSTR
+ rcTab as RECT ' client coordinates
+ rcText as RECT ' client coordinates
+ isHot as boolean
+end type
+dim shared gDesignTabs(1) as DESIGNTABS_TYPE
+
+declare function frmDesignTabs_PositionWindows() as LRESULT
+
diff --git a/src/frmDesignTabs.inc b/src/frmDesignTabs.inc
index 0bd187a7..76b7891b 100644
--- a/src/frmDesignTabs.inc
+++ b/src/frmDesignTabs.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmDesignTabs.inc.bak b/src/frmDesignTabs.inc.bak
new file mode 100644
index 00000000..0bd187a7
--- /dev/null
+++ b/src/frmDesignTabs.inc.bak
@@ -0,0 +1,248 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmDesignTabs.bi"
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+function frmDesignTabs_PositionWindows() As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN_DESIGNTABS)
+ If pWindow = 0 Then Exit Function
+
+ ' Get the entire client area
+ Dim As Rect rc: GetClientRect( HWND_FRMMAIN_DESIGNTABS, @rc )
+
+ ' Calculate the RECT positions for all of the top tabs
+ dim as long nTextWidth = 0
+ dim as long nLeft = rc.left
+ dim as long TabHeight = DESIGNTABS_HEIGHT
+ dim as long rightBorderWidth = 2
+ dim as long hmargin = 3
+
+ for i as long = lbound(gDesignTabs) to ubound(gDesignTabs)
+ ' Determine the length of the text
+ nTextWidth = getTextWidth( HWND_FRMMAIN_DESIGNTABS, gDesignTabs(0).wszText, ghMenuBar.hFontMenuBar, 0 )
+ ' calculate the various tab dimensions
+ gDesignTabs(i).rcTab = rc
+ gDesignTabs(i).rcTab.Left = nLeft
+ gDesignTabs(i).rcTab.Right = nLeft + pWindow->ScaleX(hmargin + nTextWidth + hmargin + rightBorderWidth)
+
+ gDesignTabs(i).rcText = gDesignTabs(i).rcTab
+ gDesignTabs(i).rcText.Left = gDesignTabs(i).rcText.Left + hmargin
+ gDesignTabs(i).rcText.Right = gDesignTabs(i).rcText.Left + pWindow->ScaleX(nTextWidth)
+
+ gDesignTabs(i).isHot = false
+ nLeft = gDesignTabs(i).rcTab.Right
+ next
+
+ AfxRedrawWindow( HWND_FRMMAIN_DESIGNTABS )
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmTopTabs
+' ========================================================================================
+Function frmDesignTabs_OnSize( _
+ ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+
+ If state <> SIZE_MINIMIZED Then
+ frmDesignTabs_PositionWindows()
+ End If
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Do hit test to determine what tab is currently under the mouse cursor
+' ========================================================================================
+function getHotDesignTabsHitTest( byval hWin as HWnd ) as long
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ dim as long hotTab = -1
+ for i as long = lbound(gDesignTabs) to ubound(gDesignTabs)
+ if PtInRect( @gDesignTabs(i).rcTab, pt ) then
+ hotTab = i
+ gDesignTabs(i).isHot = true
+ else
+ gDesignTabs(i).isHot = false
+ end if
+ next
+ function = hotTab
+end function
+
+' ========================================================================================
+' frmDesignTabs Window procedure
+' ========================================================================================
+Function frmDesignTabs_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ static as long curr_idxHot = -1
+
+ Select Case uMsg
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_MOUSEMOVE
+ Dim tme As TrackMouseEvent
+ tme.cbSize = Sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER Or TME_LEAVE
+ tme.hwndTrack = HWnd
+ TrackMouseEvent(@tme)
+
+ curr_idxHot = getHotDesignTabsHitTest( HWnd )
+ AfxRedrawWindow( HWnd )
+
+ case WM_MOUSELEAVE
+ ' this will reset all tabs isHot to -1 and curr_idxHot to -1
+ curr_idxHot = getHotDesignTabsHitTest( HWnd )
+ AfxRedrawWindow( HWnd )
+
+ case WM_LBUTTONDOWN
+ SetCapture( hWnd )
+
+ case WM_LBUTTONUP
+ ' Reset the mouse pointer
+ ReleaseCapture
+ curr_idxHot = getHotDesignTabsHitTest( HWnd )
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ if (curr_idxHot = 0) orelse (curr_idxHot = 1) then
+ pDoc->DesignTabsCurSel = curr_idxHot
+ frmMain_PositionWindows()
+ PostMessage( HWND_FRMMAIN, MSG_USER_GENERATECODE, 0, 0 )
+ end if
+ end if
+
+
+ case WM_PAINT
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDc
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN_DESIGNTABS)
+ If pWindow = 0 Then Exit Function
+
+ hDC = BeginPaint( hWnd, @ps )
+
+ SaveDC(hDC)
+ dim as long nWidth = ps.rcPaint.right - ps.rcPaint.left
+ dim as long nHeight = ps.rcPaint.bottom - ps.rcPaint.top
+
+ Dim memDC as HDC ' Double buffering
+ Dim hbit As HBITMAP ' Double buffering
+
+ memDC = CreateCompatibleDC( hDC )
+ hbit = CreateCompatibleBitmap( hDC, nWidth, nHeight )
+ If hbit Then hbit = SelectObject( memDC, hbit )
+
+ ' Fill in the entire back panel width across the top of the screen
+ FillRect( memDC, @ps.rcPaint, ghTopTabs.hPanelBrush )
+
+ ' Create a black pen that acts as the divider for each tab
+ dim as long penWidth = pWindow->ScaleX(1)
+ dim as HPEN hPenSolid = CreatePen( PS_SOLID, penWidth, ghTopTabs.Divider )
+ SelectObject( memDC, hPenSolid)
+
+ dim as HPEN hPenNull = CreatePen( PS_NULL, 1, 0 ) ' null/invisible pen
+
+ dim as POINT pt: GetCursorPos( @pt )
+ dim as RECT rc
+
+ dim as long nCurSel = -1
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then nCurSel = pDoc->DesignTabsCurSel
+
+ ' All of the rc calculations have already been done in frmTopTabs_PostionWindows
+ for i as long = lbound(gDesignTabs) to ubound(gDesignTabs)
+ ' paint this tab based on active/inactive status
+ if i = nCurSel then
+ SetBkColor( memDC, ghTopTabs.BackColorHot )
+ SetTextColor( memDC, ghTopTabs.ForeColorHot )
+ FillRect( memDC, @gDesignTabs(i).rcTab, ghTopTabs.hBackBrushHot )
+ else
+ SetBkColor( memDC, ghTopTabs.BackColor )
+ SetTextColor( memDC, ghTopTabs.ForeColor )
+ FillRect( memDC, @gDesignTabs(i).rcTab, ghTopTabs.hBackBrush )
+ end if
+
+ ' display the tab text
+ dim as long wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER or DT_SINGLELINE
+ SelectObject(memDC, ghMenuBar.hFontMenuBar)
+ DrawText( memDC, gDesignTabs(i).wszText.sptr, -1, Cast(lpRect, @gDesignTabs(i).rcText), wsStyle )
+
+ ' Draw the righthand side black divider
+ SelectPen( memDC, hPenSolid )
+ MoveToEx( memDC, gDesignTabs(i).rcTab.Right - penWidth, gDesignTabs(i).rcTab.top, null )
+ LineTo( memDC, gDesignTabs(i).rcTab.Right - penWidth, gDesignTabs(i).rcTab.bottom )
+
+ next
+
+ BitBlt( hDC, 0, 0, nWidth, nHeight, memDC, 0, 0, SRCCOPY )
+
+ ' Cleanup
+ if hPenSolid then DeleteObject( hPenSolid )
+ if hPenNull then DeleteObject( hPenNull )
+ if hbit then DeleteObject( SelectObject(memDC, hbit) )
+ if memDC then DeleteDC( memDC )
+ RestoreDC( hDC, -1 )
+
+ EndPaint( hWnd, @ps )
+
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+
+' ========================================================================================
+' frmDesignTabs_Show
+' ========================================================================================
+Function frmDesignTabs_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMMAIN_DESIGNTABS = pWindow->Create( hWndParent, "", @frmDesignTabs_WndProc, _
+ 0, 0, 0, DESIGNTABS_HEIGHT, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ ' Add the two tabs. Design and Code views.
+ gDesignTabs(0).wszText = L(327, "Design")
+ gDesignTabs(1).wszText = L(328, "Code")
+
+ frmDesignTabs_PositionWindows()
+
+ Function = 0
+End Function
+
diff --git a/src/frmEditorHScroll.bi b/src/frmEditorHScroll.bi
index 2320e2ea..de76bfeb 100644
--- a/src/frmEditorHScroll.bi
+++ b/src/frmEditorHScroll.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmEditorHScroll.bi.bak b/src/frmEditorHScroll.bi.bak
new file mode 100644
index 00000000..2320e2ea
--- /dev/null
+++ b/src/frmEditorHScroll.bi.bak
@@ -0,0 +1,21 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+type EDITOR_HSCROLL_TYPE
+ lineLength as long
+ thumbWidth as long
+ rc as RECT
+end type
+dim shared gEditorHScroll(1) as EDITOR_HSCROLL_TYPE
+
diff --git a/src/frmEditorHScroll.inc b/src/frmEditorHScroll.inc
index fd4d08ef..f6e84aae 100644
--- a/src/frmEditorHScroll.inc
+++ b/src/frmEditorHScroll.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmEditorHScroll.inc.bak b/src/frmEditorHScroll.inc.bak
new file mode 100644
index 00000000..fd4d08ef
--- /dev/null
+++ b/src/frmEditorHScroll.inc.bak
@@ -0,0 +1,208 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+''
+'' frmEditorHScroll.inc
+''
+
+#include once "frmEditorHScroll.bi"
+
+
+' ========================================================================================
+' frmEditorHScroll Window procedure
+' ========================================================================================
+function frmEditorHScroll_WndProc( _
+ ByVal HWnd as HWnd, _
+ ByVal uMsg as UINT, _
+ ByVal wParam as WPARAM, _
+ ByVal lParam as LPARAM _
+ ) as LRESULT
+
+ static as POINT prev_pt ' screen pt.y cursor position
+ static as long prev_xOffset
+ dim as long idxWindow = iif( HWnd = HWND_FRMEDITOR_HSCROLLBAR(0), 0, 1 )
+
+ Select Case uMsg
+ case WM_DESTROY
+ if HWnd = HWND_FRMEDITOR_HSCROLLBAR(0) then HWND_FRMEDITOR_HSCROLLBAR(0) = 0
+ if HWnd = HWND_FRMEDITOR_HSCROLLBAR(1) then HWND_FRMEDITOR_HSCROLLBAR(1) = 0
+
+ case WM_LBUTTONDOWN
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ gApp.SuppressNotify = true ' prevent SCN_UPDATEUI
+ dim as long delta = 0
+ dim as POINT pt: GetCursorPos( @pt )
+ dim as RECT rc = gEditorHScroll(idxWindow).rc ' covert copy to screen coordinates
+ MapWindowPoints( HWND_FRMEDITOR_HSCROLLBAR(idxWindow), HWND_DESKTOP, cast(POINT ptr, @rc), 2)
+ if PtInRect( @rc, pt ) then
+ prev_pt = pt
+ gApp.bDragActive = true
+ SetCapture( HWnd )
+ elseif pt.x < rc.left then
+ delta = -(rc.left - pt.x)
+ elseif pt.x > rc.right then
+ delta = pt.x - rc.right
+ end if
+
+ ' The client area was clicked
+ if delta <> 0 then
+ dim as RECT rc: GetClientRect( HWND_FRMEDITOR_HSCROLLBAR(idxWindow), @rc )
+ dim as long xOffset = SciExec( pDoc->hWindow(idxWindow), SCI_GETXOFFSET, 0, 0 )
+ gEditorHScroll(idxWindow).rc = rc
+ gEditorHScroll(idxWindow).rc.left = xOffset
+ gEditorHScroll(idxWindow).rc.right = xOffset + ((rc.right / gEditorHScroll(idxWindow).lineLength) * rc.right)
+
+ if gEditorHScroll(idxWindow).rc.right + delta < rc.right then
+ xOffset = xOffset + delta
+ xOffset = max( 0, xOffset )
+ if xOffset <> prev_xOffset then
+ SendMessage( pDoc->hWindow(idxWindow), SCI_SETXOFFSET, xOffset, 0)
+ prev_xOffset = xOffset
+ AfxRedrawWindow( HWND_FRMEDITOR_HSCROLLBAR(idxWindow) )
+ end if
+ end if
+ end if
+ end if
+
+ case WM_MOUSEMOVE
+ if gApp.bDragActive then
+ dim as POINT pt: GetCursorPos( @pt )
+ if pt.x <> prev_pt.x then
+ dim as long delta = pt.x - prev_pt.x
+
+ prev_pt = pt
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ dim as RECT rc: GetClientRect( HWND_FRMEDITOR_HSCROLLBAR(idxWindow), @rc )
+ dim as long xOffset = SciExec( pDoc->hWindow(idxWindow), SCI_GETXOFFSET, 0, 0 )
+ gEditorHScroll(idxWindow).rc = rc
+ gEditorHScroll(idxWindow).rc.left = xOffset
+ gEditorHScroll(idxWindow).rc.right = xOffset + ((rc.right / gEditorHScroll(idxWindow).lineLength) * rc.right)
+
+ if gEditorHScroll(idxWindow).rc.right + delta < rc.right then
+ xOffset = xOffset + delta
+ xOffset = max( 0, xOffset )
+ if xOffset <> prev_xOffset then
+ SendMessage( pDoc->hWindow(idxWindow), SCI_SETXOFFSET, xOffset, 0)
+ prev_xOffset = xOffset
+ AfxRedrawWindow( HWND_FRMEDITOR_HSCROLLBAR(idxWindow) )
+ end if
+ end if
+ end if
+ end if
+ end if
+
+ case WM_LBUTTONUP
+ gApp.SuppressNotify = false ' allow SCN_UPDATEUI
+ gApp.bDragActive = false
+ prev_pt.x = 0
+ prev_pt.y = 0
+ ReleaseCapture
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_PAINT
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDc
+ hDC = BeginPaint( hWnd, @ps )
+ SaveDC( hDC )
+ FillRect( hDC, @ps.rcPaint, ghEditor.hBackBrushScrollBar )
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ dim as RECT rc: GetClientRect( HWND_FRMEDITOR_HSCROLLBAR(idxWindow), @rc )
+ dim as long GetXOffset = SciExec( pDoc->hWindow(idxWindow), SCI_GETXOFFSET, 0, 0 )
+ gEditorHScroll(idxWindow).rc = rc
+ gEditorHScroll(idxWindow).rc.left = GetXOffset
+ gEditorHScroll(idxWindow).rc.right = GetXOffset + ((rc.right / gEditorHScroll(idxWindow).lineLength) * rc.right)
+ FillRect( hDC, @gEditorHScroll(idxWindow).rc, ghEditor.hBackBrushThumb )
+ end if
+
+ EndPaint( hWnd, @ps )
+ RestoreDC( hDC, -1 )
+
+ end Select
+
+ ' for messages that we don't deal with
+ function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+end function
+
+
+' ========================================================================================
+' frmEditorHScroll_Show
+' ========================================================================================
+function frmEditorHScroll_Show( ByVal hWndParent as HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ dim pWindow as CWindow ptr
+
+ for i as long = 0 to 1
+ pWindow = new CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+ HWND_FRMEDITOR_HSCROLLBAR(i) = pWindow->Create( hWndParent, _
+ "", @frmEditorHScroll_WndProc, 0, 0, 0, SCROLLBAR_HEIGHT, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, WS_EX_NOACTIVATE )
+ next
+
+ function = 0
+
+end function
+
+
+' ========================================================================================
+' frmEditorHScroll_NeedScrollBar
+' Determine based on visible line lengths if a scrollbar should be displayed
+' ========================================================================================
+function frmEditorHScroll_NeedScrollBar( _
+ byval pDoc as clsDocument ptr, _
+ byval idxWindow as long _
+ ) as long
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ if pWindow = 0 Then exit function
+
+ dim as RECT rc = AfxGetWindowRect( pDoc->hWindow(idxWindow) )
+ MapWindowPoints( HWND_DESKTOP, HWND_FRMMAIN, cast(POINT ptr, @rc), 2 )
+
+ ' We have to use PositionFromPoint calculations because the LinesOnScreen message does
+ ' not take into account extra ascent and descent values.
+ dim as long GetFirstVisiblePos, GetLastVisiblePos, GetFirstVisibleLine, GetLastVisibleLine
+ dim as long ClientWidth = (rc.right - rc.left)
+ dim as long ClientHeight = (rc.bottom - rc.top)
+ GetFirstVisiblePos = SciExec( pDoc->hWindow(idxWindow), SCI_POSITIONFROMPOINT, 0, 0 )
+ GetLastVisiblePos = SciExec( pDoc->hWindow(idxWindow), SCI_POSITIONFROMPOINT, ClientWidth, ClientHeight )
+ GetFirstVisibleLine = SciExec( pDoc->hWindow(idxWindow), SCI_LINEFROMPOSITION, GetFirstVisiblePos, 0 )
+ GetLastVisibleLine = SciExec( pDoc->hWindow(idxWindow), SCI_LINEFROMPOSITION, GetLastVisiblePos, 0 )
+
+ dim as long GetXOffset, GetLineEndPosition, endPos
+ dim as boolean needHSB = false
+ for i as long = GetFirstVisibleLine to GetLastVisibleLine
+ dim as long GetXOffset = SciExec( pDoc->hWindow(idxWindow), SCI_GETXOFFSET, 0, 0 )
+ GetLineEndPosition = SciExec( pDoc->hWindow(idxWindow), SCI_GETLINEENDPOSITION, i, 0 )
+ endPos = SciExec( pDoc->hWindow(idxWindow), SCI_POINTXFROMPOSITION, 0, GetLineEndPosition )
+ if (endPos > ClientWidth) orelse (GetXOffset <> 0) then
+ needHSB = true
+ end if
+ dim as long lineLength = GetXOffset + endPos + pWindow->ScaleX(200)
+ if lineLength > gEditorHScroll(idxWindow).lineLength then
+ gEditorHScroll(idxWindow).lineLength = lineLength
+ end if
+ if needHSB then exit for
+ next
+ function = iif( needHSB, SW_SHOWNA, SW_HIDE )
+end function
+
diff --git a/src/frmEditorVScroll.bi b/src/frmEditorVScroll.bi
index 93dbbcbd..1d681df1 100644
--- a/src/frmEditorVScroll.bi
+++ b/src/frmEditorVScroll.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmEditorVScroll.bi.bak b/src/frmEditorVScroll.bi.bak
new file mode 100644
index 00000000..93dbbcbd
--- /dev/null
+++ b/src/frmEditorVScroll.bi.bak
@@ -0,0 +1,24 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+type EDITOR_VSCROLL_TYPE
+ numLines as long
+ linesPerPage as long
+ thumbHeight as long
+ thumbRatio as single
+ rc as RECT
+end type
+dim shared gEditorVScroll(1) as EDITOR_VSCROLL_TYPE
+
+declare function frmEditorVScroll_calcVThumbRect( byval pDoc as clsDocument ptr ) as boolean
diff --git a/src/frmEditorVScroll.inc b/src/frmEditorVScroll.inc
index 3cfce21d..6383541c 100644
--- a/src/frmEditorVScroll.inc
+++ b/src/frmEditorVScroll.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmEditorVScroll.inc.bak b/src/frmEditorVScroll.inc.bak
new file mode 100644
index 00000000..3cfce21d
--- /dev/null
+++ b/src/frmEditorVScroll.inc.bak
@@ -0,0 +1,192 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+''
+'' frmEditorVScroll.inc
+''
+
+#include once "frmEditorVScroll.bi"
+
+' ========================================================================================
+' Calculate the RECT that holds the client coordinates of the scrollbar's vertical thumb
+' Returns True if RECT is not empty
+' ========================================================================================
+function frmEditorVScroll_calcVThumbRect( byval pDoc as clsDocument ptr ) as boolean
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ if pWindow = 0 Then exit function
+ if pDoc = 0 then exit function
+ dim as RECT rc
+
+ ' calculate the vertical scrollbars in client coordinates
+ for i as long = lbound(pDoc->hWindow) to ubound(pDoc->hWindow)
+ rc = AfxGetWindowRect(pDoc->hWindow(i))
+ MapWindowPoints( HWND_DESKTOP, HWND_FRMMAIN, cast(POINT ptr, @rc), 2 )
+ dim as long clientHeight = rc.bottom - rc.top
+ if clientHeight = 0 then continue for
+ dim as long firstVisibleLine = SciExec( pDoc->hWindow(i), SCI_GETFIRSTVISIBLELINE, 0, 0 )
+ dim as long iScrollbarWidth = AfxGetWindowWidth(HWND_FRMEDITOR_VSCROLLBAR(i))
+ dim as long minThumbHeight = pWindow->ScaleY(SCROLLBAR_MINTHUMBSIZE)
+ SetRectEmpty( @gEditorVScroll(i).rc )
+ with gEditorVScroll(i)
+ .linesPerPage = pDoc->linesPerPage(i)
+ .numLines = pDoc->GetLineCount + 1
+ .thumbHeight = (.linesPerPage / .numLines) * clientHeight
+ ' If the thumb height is less than the minimum default then adjust parameters so
+ ' that the viewport can compensate for the adjustments.
+ .thumbRatio = 1
+ 'if .thumbHeight < minThumbHeight then
+ ' .thumbRatio = 1 + (minThumbHeight-.thumbHeight) /.thumbHeight
+ ' .thumbHeight = minThumbHeight
+ 'end if
+ .rc.left = 0
+ .rc.right = .rc.left + iScrollbarWidth
+ .rc.top = ((firstVisibleLine / .numLines) * clientHeight)
+ .rc.bottom = .rc.top + .thumbHeight
+ end with
+ next
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmEditorVScroll Window procedure
+' ========================================================================================
+function frmEditorVScroll_WndProc( _
+ ByVal HWnd as HWnd, _
+ ByVal uMsg as UINT, _
+ ByVal wParam as WPARAM, _
+ ByVal lParam as LPARAM _
+ ) as LRESULT
+
+ static as POINT prev_pt ' screen pt.y cursor position
+
+ dim as long idxWindow = iif( HWnd = HWND_FRMEDITOR_VSCROLLBAR(0), 0, 1 )
+
+ Select Case uMsg
+ case WM_DESTROY
+ if HWnd = HWND_FRMEDITOR_VSCROLLBAR(0) then HWND_FRMEDITOR_VSCROLLBAR(0) = 0
+ if HWnd = HWND_FRMEDITOR_VSCROLLBAR(1) then HWND_FRMEDITOR_VSCROLLBAR(1) = 0
+
+ case WM_LBUTTONDOWN
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ gApp.SuppressNotify = true ' prevent SCN_UPDATEUI
+ dim as POINT pt: GetCursorPos( @pt )
+ frmEditorVScroll_calcVThumbRect(pDoc) ' in client coordinates
+ dim as RECT rc = gEditorVScroll(idxWindow).rc ' covert copy to screen coordinates
+ MapWindowPoints( HWND_FRMEDITOR_VSCROLLBAR(idxWindow), HWND_DESKTOP, cast(POINT ptr, @rc), 2)
+ if PtInRect( @rc, pt ) then
+ prev_pt = pt
+ gApp.bDragActive = true
+ SetCapture( HWnd )
+ else
+ ' we have clicked on a PageUp or PageDn
+ dim as long nTopIndex = SendMessage( pDoc->hWindow(idxWindow), SCI_GETFIRSTVISIBLELINE, 0, 0 )
+ if pt.y < rc.top then
+ nTopIndex = max( nTopIndex - gEditorVScroll(idxWindow).linesPerPage, 0 )
+ SendMessage( pDoc->hWindow(idxWindow), SCI_SETFIRSTVISIBLELINE, nTopIndex, 0 )
+ frmEditorVScroll_calcVThumbRect(pDoc) ' in client coordinates
+ AfxRedrawWindow( HWND_FRMEDITOR_VSCROLLBAR(idxWindow) )
+ elseif pt.y > rc.bottom then
+ dim as long nMaxTopIndex = gEditorVScroll(idxWindow).numLines - gEditorVScroll(idxWindow).linesPerPage
+ nTopIndex = min( nTopIndex + gEditorVScroll(idxWindow).linesPerPage, nMaxTopIndex )
+ SendMessage( pDoc->hWindow(idxWindow), SCI_SETFIRSTVISIBLELINE, nTopIndex, 0 )
+ frmEditorVScroll_calcVThumbRect(pDoc) ' in client coordinates
+ AfxRedrawWindow( HWND_FRMEDITOR_VSCROLLBAR(idxWindow) )
+ end if
+ end if
+ end if
+
+ case WM_MOUSEMOVE
+ if gApp.bDragActive then
+ dim as POINT pt: GetCursorPos( @pt )
+ if pt.y <> prev_pt.y then
+ dim as long delta = pt.y - prev_pt.y
+ ' convert to client coordinates for ease of use
+ dim as RECT rc: GetClientRect( HWND_FRMEDITOR_VSCROLLBAR(idxWindow), @rc )
+ rc.bottom = rc.bottom * gEditorVScroll(idxWindow).thumbRatio
+ gEditorVScroll(idxWindow).rc.top = max(0, gEditorVScroll(idxWindow).rc.top + delta)
+ gEditorVScroll(idxWindow).rc.top = min(gEditorVScroll(idxWindow).rc.top, rc.bottom - gEditorVScroll(idxWindow).thumbHeight)
+ gEditorVScroll(idxWindow).rc.bottom = gEditorVScroll(idxWindow).rc.top + gEditorVScroll(idxWindow).thumbHeight
+
+ prev_pt = pt
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ dim as long nPrevTopLine = SendMessage( pDoc->hWindow(idxWindow), SCI_GETFIRSTVISIBLELINE, 0, 0 )
+ dim as long nTopLine = (gEditorVScroll(idxWindow).rc.top / rc.bottom) * gEditorVScroll(idxWindow).numLines
+ if nTopLine <> nPrevTopLine then
+ SendMessage( pDoc->hWindow(idxWindow), SCI_SETFIRSTVISIBLELINE, nTopLine, 0 )
+ end if
+ end if
+ AfxRedrawWindow( HWND_FRMEDITOR_VSCROLLBAR(idxWindow) )
+ end if
+ end if
+
+ case WM_LBUTTONUP
+ gApp.SuppressNotify = false ' allow SCN_UPDATEUI
+ gApp.bDragActive = false
+ prev_pt.x = 0
+ prev_pt.y = 0
+ ReleaseCapture
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_PAINT
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDc
+
+ hDC = BeginPaint( hWnd, @ps )
+ SaveDC( hDC )
+ FillRect( hDC, @ps.rcPaint, ghEditor.hBackBrushScrollBar )
+ dim as long penWidth = pWindow->ScaleX(1)
+ dim as HPEN hPenSolid = CreatePen( PS_SOLID, penWidth, ghEditor.Divider )
+ SelectPen( hDC, hPenSolid )
+ MoveToEx( hDC, ps.rcPaint.left, ps.rcPaint.top, null )
+ LineTo( hDC, ps.rcPaint.left, ps.rcPaint.bottom )
+ FillRect( hDC, @gEditorVScroll(idxWindow).rc, ghEditor.hBackBrushThumb )
+ EndPaint( hWnd, @ps )
+ RestoreDC( hDC, -1 )
+ DeletePen( hPenSolid )
+
+ end Select
+
+ ' for messages that we don't deal with
+ function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+end function
+
+
+' ========================================================================================
+' frmEditorVScroll_Show
+' ========================================================================================
+function frmEditorVScroll_Show( ByVal hWndParent as HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ dim pWindow as CWindow ptr
+
+ for i as long = 0 to 1
+ pWindow = new CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+ HWND_FRMEDITOR_VSCROLLBAR(i) = pWindow->Create( hWndParent, _
+ "", @frmEditorVScroll_WndProc, 0, 0, SCROLLBAR_WIDTH_EDITOR + 1, 0, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, WS_EX_NOACTIVATE )
+ next
+
+ function = 0
+
+end function
+
diff --git a/src/frmExplorer.bi b/src/frmExplorer.bi
index 5feb47c8..8eab3374 100644
--- a/src/frmExplorer.bi
+++ b/src/frmExplorer.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmExplorer.bi.bak b/src/frmExplorer.bi.bak
new file mode 100644
index 00000000..5feb47c8
--- /dev/null
+++ b/src/frmExplorer.bi.bak
@@ -0,0 +1,21 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+#define IDC_FRMEXPLORER_LISTBOX 1000
+
+declare function frmExplorer_Show( byval hWndParent as HWnd ) as LRESULT
+declare function LoadExplorerFiles() as long
+declare function frmExplorer_SelectItemData( byval pDoc as clsDocument ptr ) as boolean
diff --git a/src/frmExplorer.inc b/src/frmExplorer.inc
index 8b4dcc21..03c01f87 100644
--- a/src/frmExplorer.inc
+++ b/src/frmExplorer.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmExplorer.inc.bak b/src/frmExplorer.inc.bak
new file mode 100644
index 00000000..8b4dcc21
--- /dev/null
+++ b/src/frmExplorer.inc.bak
@@ -0,0 +1,763 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+''
+'' frmExplorer.inc
+''
+
+#include once "frmExplorer.bi"
+#include once "frmFunctions.bi"
+#include once "clsDB2.bi"
+
+#define NODE_INDEX_SIZE 5 ' size of field holding array index into gConfig.Cat()
+#define NODE_STATE_SIZE 1 ' size of field holding 0 collapsed, 1 expanded
+
+function getExplorerNodeHeaderIndex( byval wszCaption as CWSTR ) as long
+ ' wszCaption will be in this formt:
+ ' %NODE_INDEX_SIZE%NODE_STATE_SIZE%Description
+ ' % 0%1%Files
+ ' % 1%1%Main
+ ' % 2%1%Resource
+ ' % 3%0%Header
+ ' % 4%0%Module
+ ' % 5%1%Normal
+ dim as long idx = val(mid(wszCaption, 2, NODE_INDEX_SIZE))
+ ' Make sure array index is valid
+ if (idx < lbound(gConfig.Cat)) orelse (idx > ubound(gConfig.Cat)) then
+ return -1
+ else
+ return idx
+ end if
+end function
+
+function getExplorerNodeHeaderState( byval wszCaption as CWSTR ) as long
+ ' wszCaption will be in this formt:
+ ' %NODE_INDEX_SIZE%NODE_STATE_SIZE%Description
+ ' % 0%1%Files
+ ' % 1%1%Main
+ ' % 2%1%Resource
+ ' % 3%0%Header
+ ' % 4%0%Module
+ ' % 5%1%Normal
+ dim as long nState = val(mid(wszCaption, 2 + NODE_INDEX_SIZE + 1, NODE_STATE_SIZE))
+ ' nState will be 0 collapsed, or 1 expanded
+ return nState
+end function
+
+function getExplorerNodeHeaderDescription( byval wszCaption as CWSTR ) as CWSTR
+ ' wszCaption will be in this formt:
+ ' %NODE_INDEX_SIZE%NODE_STATE_SIZE%Description
+ ' % 0%1%Files
+ ' % 1%1%Main
+ ' % 2%1%Resource
+ ' % 3%0%Header
+ ' % 4%0%Module
+ ' % 5%1%Normal
+ return mid(wszCaption, 4 + NODE_INDEX_SIZE + NODE_STATE_SIZE)
+end function
+
+' ========================================================================================
+' Expand/Collapse all Explorer Nodes
+' ========================================================================================
+function frmExplorer_ExpandAll() as long
+ for i as long = lbound(gConfig.Cat) to ubound(gConfig.Cat)
+ gConfig.Cat(i).bShow = true
+ next
+ LoadExplorerFiles()
+ function = 0
+end function
+
+function frmExplorer_CollapseAll() as long
+ for i as long = lbound(gConfig.Cat) to ubound(gConfig.Cat)
+ gConfig.Cat(i).bShow = false
+ next
+ LoadExplorerFiles()
+ function = 0
+end function
+
+
+' ========================================================================================
+' Unselect all items in the multiselect listbox and reset it to the currently
+' active top tab (if any)
+' ========================================================================================
+function frmExplorer_UnSelectListBox() as long
+ for i as long = 0 to ListBox_GetCount( HWND_FRMEXPLORER_LISTBOX ) - 1
+ ListBox_SetSel( HWND_FRMEXPLORER_LISTBOX, false, i )
+ next
+ ' force a listbox selection for the currently active tab
+ dim as long idx = gTTabCtl.CurSel: gTTabCtl.CurSel = -1
+ gTTabCtl.SetFocusTab(idx)
+ function = 0
+end function
+
+' ========================================================================================
+' Select the listbox item that matches the incoming pDoc item. Do not open nodes to
+' find a possible hidden document because the user may have purposely closed a node
+' and we should not re-open it automatically.
+' ========================================================================================
+function frmExplorer_SelectItemData( byval pDoc as clsDocument ptr ) as boolean
+ ' Select the Explorer listbox item where the ItemData holds the pDoc handle.
+ ' Reset any other single or multiple selections. Process entire listbox.
+ dim as long idx = -1
+ for i as long = 0 to ListBox_GetCount( HWND_FRMEXPLORER_LISTBOX ) - 1
+ ListBox_SetSel( HWND_FRMEXPLORER_LISTBOX, false, i )
+ if ListBox_GetItemData(HWND_FRMEXPLORER_LISTBOX, i) = pDoc then
+ idx = i
+ end if
+ next
+
+ if idx <> -1 then
+ ListBox_SetSel( HWND_FRMEXPLORER_LISTBOX, true, idx )
+ AfxRedrawWindow( HWND_FRMEXPLORER_LISTBOX )
+ end if
+
+ if idx >= 0 then function = true
+end function
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+function frmExplorer_PositionWindows() as LRESULT
+
+ ' Get the entire client area
+ dim as Rect rc
+ GetClientRect( HWND_FRMEXPLORER, @rc )
+
+ SetWindowPos( HWND_FRMEXPLORER_LISTBOX, 0, _
+ rc.left, rc.top, rc.right-rc.left, rc.bottom-rc.top, _
+ SWP_NOZORDER )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmExplorer
+' ========================================================================================
+function frmExplorer_OnSize( _
+ byval HWnd as HWnd, _
+ byval state as UINT, _
+ byval cx as long, _
+ byval cy as long _
+ ) as LRESULT
+ if state <> SIZE_MINIMIZED then
+ ' Position all of the child windows
+ frmExplorer_PositionWindows
+ end if
+ function = 0
+end function
+
+' ========================================================================================
+' Process WM_PAINT message for window/dialog: frmExplorer
+' ========================================================================================
+function frmExplorer_OnPaint( byval HWnd as HWnd ) as LRESULT
+
+ dim as PAINTSTRUCT ps
+ dim as HDC hDc
+
+ hDC = BeginPaint(hWnd, @ps)
+
+ SaveDC( hDC )
+ FillRect( hDC, @ps.rcPaint, ghPanel.hPanelBrush )
+ RestoreDC( hDC, -1 )
+ EndPaint( hWnd, @ps )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_MEASUREITEM message for window/dialog: frmExplorer
+' ========================================================================================
+function frmExplorer_OnMeasureItem( _
+ byval HWnd as HWnd, _
+ byval lpmis as MEASUREITEMSTRUCT ptr _
+ ) as long
+ ' Set the height of the list box items.
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWnd)
+ lpmis->itemHeight = pWindow->ScaleY(EXPLORERITEM_HEIGHT)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_DRAWITEM message for window/dialog: frmExplorer
+' ========================================================================================
+function frmExplorer_OnDrawItem( _
+ byval HWnd as HWnd, _
+ byval lpdis as const DRAWITEMSTRUCT ptr _
+ ) as long
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ if pWindow = 0 then exit function
+
+ if lpdis = 0 then exit function
+
+ if ( lpdis->itemAction = ODA_DRAWENTIRE ) orelse _
+ ( lpdis->itemAction = ODA_SELECT ) orelse _
+ ( lpdis->itemAction = ODA_FOCUS ) then
+
+ dim as RECT rc = lpdis->rcItem
+ dim as long nWidth = rc.right-rc.left
+ dim as long nHeight = rc.bottom-rc.top
+
+ SaveDC(lpdis->hDC)
+
+ dim memDC as HDC ' Double buffering
+ dim hbit as HBITMAP ' Double buffering
+
+ memDC = CreateCompatibleDC( lpdis->hDC )
+ hbit = CreateCompatibleBitmap( lpdis->hDC, nWidth, nHeight )
+ if hbit then hbit = SelectObject( memDC, hbit )
+
+ SelectObject( memDC, ghMenuBar.hFontMenuBar )
+
+ ' Default to using normal
+ dim as HBRUSH hBrush = ghPanel.hBackBrush
+ dim as COLORREF foreclr = ghPanel.ForeColor
+ dim as COLORREF backclr = ghPanel.BackColor
+
+ dim as boolean IsHot = false
+ dim as boolean isNodeHeader = false
+ dim as boolean isIconDown = false
+
+ dim as POINT pt
+ GetCursorPos( @pt )
+ MapWindowPoints( lpdis->hwndItem, HWND_DESKTOP, cast( POINT ptr, @rc ), 2 )
+ if PtInRect( @rc, pt ) then IsHot = true
+
+ ' if mouse is over VScrollBar then reset hot
+ if isMouseOverWindow( HWND_FRMPANEL_VSCROLLBAR ) then IsHot = false
+
+ if ListBox_GetSel(lpdis->hwndItem, lpdis->itemID) then IsHot = true
+
+ hBrush = iif( IsHot, ghPanel.hBackBrushHot, ghPanel.hBackBrush)
+ backclr = iif( IsHot, ghPanel.BackColorHot, ghPanel.BackColor)
+ foreclr = iif( IsHot, ghPanel.ForeColorHot, ghPanel.ForeColor)
+
+ dim as CWSTR wszCaption = AfxGetListBoxText(lpdis->hwndItem, lpdis->ItemID)
+
+ ' if this is a "node" header then use those colors
+ if left(wszCaption, 1) = "%" then isNodeHeader = true
+ if getExplorerNodeHeaderState(wszCaption) = 1 then isIconDown = true
+
+ ' Paint the entire background
+ ' Create our rect that works with the entire line
+ SetRect( @rc, 0, 0, nWidth, nHeight )
+ FillRect( memDC, @rc, hBrush )
+
+ SetBkColor( memDC, backclr )
+ SetTextColor( memDC, foreclr )
+
+ dim as RECT rcText = rc
+ dim as RECT rcBitmap = rc
+
+ dim as long wsStyle
+
+ ' indent the text based on its type
+ if isNodeHeader then
+ rcBitmap.right = rcBitmap.left + pWindow->ScaleX(20)
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_TOP or DT_SINGLELINE
+ if isIconDown then
+ DrawText( memDC, wszChevronDown, -1, cast(lpRect, @rcBitmap), wsStyle )
+ else
+ DrawText( memDC, wszChevronRight, -1, cast(lpRect, @rcBitmap), wsStyle )
+ end if
+ wszCaption = getExplorerNodeHeaderDescription(wszCaption)
+ rcText.left = rcBitmap.right
+ SelectObject( memDC, ghMenuBar.hFontMenuBar )
+ wsStyle = DT_NOPREFIX or DT_LEFT or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszCaption.sptr, -1, cast(lpRect, @rcText), wsStyle )
+ else
+ ' This would be a regular file.
+ rcBitmap.left = rcText.left + pWindow->ScaleX(20)
+ rcBitmap.right = rcBitmap.left + pWindow->ScaleX(20)
+
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_TOP or DT_SINGLELINE
+ DrawText( memDC, wszDocumentIcon, -1, cast(lpRect, @rcBitmap), wsStyle )
+
+ rcText.left = rcBitmap.right
+ SelectObject( memDC, ghMenuBar.hFontMenuBar )
+ wsStyle = DT_NOPREFIX or DT_LEFT or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszCaption.sptr, -1, cast(lpRect, @rcText), wsStyle )
+ end if
+
+ BitBlt( lpdis->hDC, lpdis->rcItem.left, lpdis->rcItem.top, _
+ nWidth, nHeight, memDC, 0, 0, SRCCOPY )
+
+ ' Cleanup
+ if hbit then DeleteObject SelectObject(memDC, hbit)
+ if memDC then DeleteDC memDC
+ RestoreDC(lpdis->hDC, -1)
+ end if
+
+ function = true
+
+end function
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmExplorer
+' ========================================================================================
+function frmExplorer_OnCommand( _
+ byval HWnd as HWnd, _
+ byval id as long, _
+ byval hwndCtl as HWnd, _
+ byval codeNotify as UINT _
+ ) as LRESULT
+
+ select case codeNotify
+ case LBN_SELCHANGE
+ ' update the highlighting of the current line
+ AfxRedrawWindow(hwndCtl)
+ ' update the scrollbar position if necessary
+ frmExplorer_PositionWindows()
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmExplorer Window procedure
+' ========================================================================================
+function frmExplorer_WndProc( _
+ byval HWnd as HWnd, _
+ byval uMsg as UINT, _
+ byval wParam as WPARAM, _
+ byval lParam as LPARAM _
+ ) as LRESULT
+
+ static hTooltip as HWND
+
+ select case uMsg
+ HANDLE_MSG (HWnd, WM_SIZE, frmExplorer_OnSize)
+ HANDLE_MSG (HWnd, WM_PAINT, frmExplorer_OnPaint)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmExplorer_OnCommand)
+ HANDLE_MSG (HWnd, WM_MEASUREITEM, frmExplorer_OnMeasureItem)
+ HANDLE_MSG (HWnd, WM_DRAWITEM, frmExplorer_OnDrawItem)
+
+ case WM_ERASEBKGND
+ return true
+
+ end select
+
+ ' for messages that we don't deal with
+ function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+end function
+
+' ========================================================================================
+' frmExplorerListBox_SubclassProc
+' ========================================================================================
+function frmExplorerListBox_SubclassProc ( _
+ byval hWin as HWnd, _ ' // Control window handle
+ byval uMsg as UINT, _ ' // Type of message
+ byval _wParam as WPARAM, _ ' // First message parameter
+ byval _lParam as LPARAM, _ ' // Second message parameter
+ byval uIdSubclass as UINT_PTR, _ ' // The subclass ID
+ byval dwRefData as DWORD_PTR _ ' // Pointer to reference data
+ ) as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMEXPLORER)
+ static as long accumDelta
+ static as HWND hTooltip
+
+ ' keep track of last index we were over so that we only issue a
+ ' repaint if the cursor has moved off of the line
+ static as long nLastIdx = -1
+
+ select case uMsg
+ case MSG_USER_LOAD_EXPLORERFILES
+ LoadExplorerFiles()
+
+ Case WM_MOUSEWHEEL
+ ' accumulate delta until scroll one line (up +120, down -120).
+ ' 120 is the Microsoft default delta
+ dim as long zDelta = GET_WHEEL_DELTA_WPARAM( _wParam )
+ dim as long nTopIndex = SendMessage( hWin, LB_GETTOPINDEX, 0, 0 )
+ accumDelta = accumDelta + zDelta
+ if accumDelta >= 120 then ' scroll up 3 lines
+ nTopIndex = nTopIndex - 3
+ nTopIndex = max( 0, nTopIndex )
+ SendMessage( hWin, LB_SETTOPINDEX, nTopIndex, 0 )
+ accumDelta = 0
+ frmPanelVScroll_PositionWindows( SW_SHOWNA )
+ elseif accumDelta <= -120 then ' scroll down 3 lines
+ nTopIndex = nTopIndex + 3
+ SendMessage( hWin, LB_SETTOPINDEX, nTopIndex, 0 )
+ accumDelta = 0
+ frmPanelVScroll_PositionWindows( SW_SHOWNA )
+ end if
+
+ Case WM_MOUSEMOVE
+ ' Track that we are over the control in order to catch the
+ ' eventual WM_MOUSEHOVER and WM_MOUSELEAVE events
+ dim tme as TrackMouseEvent
+ tme.cbSize = sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER or TME_LEAVE
+ tme.hwndTrack = hWin
+ TrackMouseEvent(@tme)
+
+ ' get the item rect that the mouse is over and only invalidate
+ ' that instead of the entire listbox
+ dim as RECT rc
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ if idx <> nLastIdx then
+ ListBox_GetItemRect( hWin, idx, @rc )
+ InvalidateRect( hWin, @rc, true )
+ ListBox_GetItemRect( hWin, nLastIdx, @rc )
+ InvalidateRect( hWin, @rc, true )
+ nLastIdx = idx
+ end if
+ end if
+
+ case WM_MOUSEHOVER
+ dim as CWSTR wszTooltip
+ if IsWindow(hTooltip) = 0 then hTooltip = AfxAddTooltip( hWin, "", false, false )
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, ListBox_GetItemData( hWin, idx ))
+ if pDoc then wszTooltip = pDoc->DiskFilename
+ ' Display the tooltip
+ AfxSetTooltipText( hTooltip, hWin, wszTooltip )
+ AfxRedrawWindow( hWin )
+ end if
+
+ case WM_MOUSELEAVE
+ nLastIdx = -1
+ AfxRedrawWindow(hWin)
+
+ case WM_RBUTTONDOWN
+ ' Create the popup menu
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, ListBox_GetItemData( hWin, idx ))
+ if pDoc then
+ ListBox_SetSel( hWin, true, idx )
+ dim as HMENU hPopupMenu = CreateExplorerContextMenu(pDoc)
+ dim as POINT pt: GetCursorPos( @pt )
+ dim as long id = TrackPopupMenu(hPopUpMenu, TPM_RETURNCMD, pt.x, pt.y, 0, HWND_FRMMAIN, byval null)
+ ' process the selected rows. Need to save the current state of selected
+ ' rows prior to processing because as the items are processed some of the
+ ' actions may reset the state of listbox. We save the pDoc's in an array
+ ' rather than index values because the listbox may get reloaded during
+ ' some actions invalidating some indexes.
+ dim as long nSelCount = SendMessage( hWin, LB_GETSELCOUNT, 0, 0 )
+ dim pDocArray(nSelCount-1) as clsDocument ptr
+ dim as long nextIdx = 0
+ for i as long = 0 to ListBox_GetCount( hWin ) - 1
+ if ListBox_GetSel( hWin, i ) then
+ dim as CWSTR wszCaption = AfxGetListBoxText( hWin, i )
+ if left(wszCaption, 1) = "%" then
+ pDocArray(nextIdx) = 0
+ else
+ pDocArray(nextIdx) = cast(clsDocument ptr, ListBox_GetItemData( hWin, i ))
+ end if
+ nextIdx = nextIdx + 1
+ end if
+ next
+ ' Process our array of selected pDoc's.
+ for i as long = lbound(pDocArray) to ubound(pDocArray)
+ if pDocArray(i) = 0 then continue for
+ select case id
+ case IDM_FILEOPEN_EXPLORERLISTBOX, IDM_FILECLOSE_EXPLORERLISTBOX, _
+ IDM_FILESAVE_EXPLORERLISTBOX, IDM_FILESAVEAS_EXPLORERLISTBOX
+ OnCommand_FileExplorerMessage( id, pDocArray(i) )
+ case IDM_REMOVEFILEFROMPROJECT_EXPLORERLISTBOX
+ OnCommand_ProjectRemove( id, pDocArray(i) )
+ case IDM_SETFILEMAIN_EXPLORERTREEVIEW, IDM_SETFILERESOURCE_EXPLORERTREEVIEW, _
+ IDM_SETFILEHEADER_EXPLORERTREEVIEW, IDM_SETFILEMODULE_EXPLORERTREEVIEW, _
+ IDM_SETFILENORMAL_EXPLORERTREEVIEW
+ OnCommand_ProjectSetFileType( id, pDocArray(i) )
+ case is > IDM_SETCATEGORY
+ OnCommand_ProjectSetFileType( id, pDocArray(i) )
+ end select
+ next
+ LoadExplorerFiles()
+ frmExplorer_UnSelectListBox()
+ DestroyMenu( hPopUpMenu )
+ Return true ' prevent further processing that leads to WM_CONTEXTMENU
+ end if
+ end if
+
+ case WM_LBUTTONUP
+ ' Prevent this programmatic selection if Ctrl or Shift is active
+ ' because we want the listbox to select the listbox item rather for
+ ' us to mess with that selection via SetTabIndexByDocumentPtr().
+ dim as boolean isCtrl = (GetAsyncKeyState(VK_CONTROL) and &H8000)
+ dim as boolean isShift = (GetAsyncKeyState(VK_SHIFT) and &H8000)
+ if (isCtrl = false) andalso (isShift = false) then
+ ' determine if we clicked on a regular file or a node header
+ dim as RECT rc
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ dim as CWSTR wszCaption = AfxGetListBoxText( hWin, idx )
+ if left(wszCaption, 1) = "%" then
+ ' Toggle the show/hide of files under this node
+ dim as long idxArray = getExplorerNodeHeaderIndex(wszCaption)
+ if idxArray <> -1 then
+ gConfig.Cat(idxArray).bShow = not gConfig.Cat(idxArray).bShow
+ end if
+ ' allow listbox click event to fully process before loading new explorer files
+ ' so that we can correctly select the current item.
+ PostMessage( hWin, MSG_USER_LOAD_EXPLORERFILES, 0, 0 )
+ else
+ ' if the file is already showing in the Top tabs then switch to that tab.
+ ' We do not open a new tab on single click. Only double click or ENTER will
+ ' open a new tab.
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, ListBox_GetItemData( hWin, idx ))
+ gTTabCtl.SetTabIndexByDocumentPtr( pDoc )
+ end if
+ end if
+ end if
+
+ case WM_LBUTTONDBLCLK
+ ' determine if we clicked on a regular file or a node header. If it is a regular
+ ' file then load it.
+ dim as RECT rc
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ dim as CWSTR wszCaption = AfxGetListBoxText( hWin, idx )
+ if left(wszCaption, 1) <> "%" then
+ dim as CWSTR wszFilename
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, ListBox_GetItemData( hWin, idx ))
+ if pDoc then
+ wszFilename = pDoc->DiskFilename
+ OpenSelectedDocument( wszFilename, "" )
+ end if
+ end if
+ end if
+
+ case WM_ERASEBKGND
+ ' if the number of lines in the listbox maybe less than the number per page then
+ ' calculate from last item to bottom of listbox, otherwise calculate based on
+ ' the mod of the lineheight to listbox height so we can color the partial line
+ ' that won't be displayed at the bottom of the list.
+ dim as RECT rc: GetClientRect( hWin, @rc )
+
+ dim as RECT rcItem
+ SendMessage( hWin, LB_GETITEMRECT, 0, cast(LPARAM, @rcItem) )
+ dim as long itemHeight = rcItem.bottom - rcItem.top
+ dim as long NumItems = ListBox_GetCount(hWin)
+ dim as long nTopIndex = SendMessage( hWin, LB_GETTOPINDEX, 0, 0 )
+ dim as long visible_rows = 0
+ dim as long ItemsPerPage = 0
+ dim as long bottom_index = 0
+
+ if NumItems > 0 then
+ ItemsPerPage = (rc.bottom - rc.top) / itemHeight
+ bottom_index = (nTopIndex + ItemsPerPage)
+ if bottom_index >= NumItems then bottom_index = NumItems - 1
+ visible_rows = (bottom_index - nTopIndex) + 1
+ rc.top = visible_rows * itemHeight
+ end if
+
+ if rc.top < rc.bottom then
+ dim as HDC _hDC = cast(HDC, _wParam)
+ FillRect( _hDC, @rc, ghPanel.hPanelBrush )
+ end if
+
+ ValidateRect( hWin, @rc )
+ return true
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hWin, @frmExplorerListBox_SubclassProc, uIdSubclass )
+ end select
+
+ ' For messages that we don't deal with
+ function = DefSubclassProc( hWin, uMsg, _wParam, _lParam )
+
+end function
+
+
+' ========================================================================================
+' frmExplorer_Show
+' ========================================================================================
+function frmExplorer_Show( byval hWndParent as HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ dim pWindow as CWindow ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMEXPLORER = pWindow->Create( hWndParent, "Explorer Window", @frmExplorer_WndProc, _
+ 0, 0, 0, 0, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT or WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR)
+
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ HWND_FRMEXPLORER_LISTBOX = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMEXPLORER_LISTBOX, "", 0, 0, 0, 0, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_TABSTOP or _
+ LBS_NOINTEGRALHEIGHT or LBS_EXTENDEDSEL or LBS_MULTIPLESEL or _
+ LBS_OWNERDRAWFIXED or LBS_HASSTRINGS or LBS_NOTIFY, _
+ WS_EX_LEFT or WS_EX_RIGHTSCROLLBAR, , _
+ cast(SUBCLASSPROC, @frmExplorerListBox_SubclassProc), _
+ IDC_FRMEXPLORER_LISTBOX, cast(DWORD_PTR, @pWindow))
+
+ function = 0
+
+end function
+
+
+' ========================================================================================
+' LoadExplorerFiles
+' This will clear the current list of files in the Explorer and repopulate it
+' with the latest list of filenames that are stored in the hidden FunctionList treeview.
+' Files are excluded from being added based on the state of the global array gConfig.Cat()
+' ========================================================================================
+function LoadExplorerFiles() as long
+ dim as HWND hList = HWND_FRMEXPLORER_LISTBOX
+ redim pDocs(any) as clsDocument ptr
+
+ ' Hide the listbox while it is loading so that we don't get the unpainted
+ ' white background from the empty listbox
+ ShowWindow( hList, SW_HIDE )
+
+ ' Save the topindex because we will restore it after filling the new contents
+ dim as long nTopIndex = SendMessage( hList, LB_GETTOPINDEX, 0, 0 )
+
+ dim pDocActive as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+
+ dim as long idxRestore = -1
+ dim as long idxCaret = ListBox_GetCaretIndex( hList )
+
+ ' Clear all content from the listbox
+ ListBox_ResetContent(hList)
+
+ ' Add the list of filenames (allow the treeview to sort the data for us)
+ dim as long idx, nStart, nEnd
+ dim wszText as wstring * MAX_PATH
+
+ if gApp.IsProjectActive then
+ nStart = CATINDEX_MAIN
+ nEnd = ubound(gConfig.Cat)
+ else
+ ' no project active so just "files"
+ nStart = CATINDEX_FILES
+ nEnd = CATINDEX_FILES
+ end if
+
+ for ii as long = nStart to nEnd
+ ' The node header description starts with a % in order for the
+ ' drawing routine to know that it is a node header and not a
+ ' regular file.
+ ' e.g.
+ ' % 0%1%Files
+ ' % 1%1%Main
+ ' % 2%1%Resource
+ ' % 3%0%Header
+ ' % 4%0%Module
+ ' % 5%1%Normal
+ ' The value after the % is the array index into gConfig.Cat(i).bShow
+ ' that allows the mouse routines to toggle on/off displaying of
+ ' the files. The value after the second % indicates to the drawing
+ ' routine that files exist ("1") under the node, or ("0") that
+ ' no files exist. This will then dictate what icon to show next
+ ' to the line.
+ wszText = "%" & AfxStrRSet(str(ii), NODE_INDEX_SIZE) & "%"
+ if gConfig.Cat(ii).bShow = false then
+ wszText = wszText & AfxStrRSet("0", NODE_STATE_SIZE) & "%" & gConfig.Cat(ii).wszDescription
+ else
+ wszText = wszText & AfxStrRSet("1", NODE_STATE_SIZE) & "%" & gConfig.Cat(ii).wszDescription
+ end if
+
+ ' Add the header description to the listbox
+ idx = Listbox_AddString( hList, @wszText )
+
+ ' Check to see if these types of files should be loaded into the listbox.
+ if gConfig.Cat(ii).bShow = false then continue for
+
+ ' Iterate all pDoc in the project/files list. Create an array and then
+ ' sort it alphabetically.
+ dim as long ub
+
+ erase pDocs
+
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ if pDoc->ProjectFiletype = gConfig.Cat(ii).idFileType then
+ ub = ubound(pDocs) + 1
+ redim preserve pDocs(ub)
+ pDocs(ub) = pDoc
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+
+ QuickSortpDocs( pDocs(), lbound(pDocs), ubound(pDocs) )
+
+ for i as long = lbound(pDocs) to ubound(pDocs)
+ wszText = AfxStrPathName( "NAMEX", pDocs(i)->DiskFilename )
+ idx = Listbox_AddString( hList, @wszText )
+ ' pDoc item is stored in ListBox ItemData
+ ListBox_SetItemData( hList, idx, pDocs(i) )
+ if pDocActive then
+ if pDocs(i) = pDocActive then idxRestore = idx
+ end if
+ next
+
+ next
+
+ ' Restore the top index so the list displays like it did before being reset
+ SendMessage( hList, LB_SETTOPINDEX, nTopIndex, 0 )
+
+ ' Ensure that Listbox is now properly sized and then show the listbox now that
+ ' it is fully populated (only display the listbox if it contains items because
+ ' zero items can produce white background).
+ if ListBox_GetCount( hList ) then ShowWindow( hList, SW_SHOW )
+ frmExplorer_PositionWindows()
+
+ ' Set current selection to the item that was selected prior
+ ' to us reloading the listbox
+ if idxRestore <> -1 then
+ ListBox_SetSel( hList, true, idxRestore )
+ else
+ ' Most likely a header node was collapsed/expanded so attempt to
+ ' reposition to saved caret index
+ if idxCaret <> -1 then
+ ListBox_SetCaretIndex( hList, idxCaret )
+ ListBox_SetAnchorIndex( hList, idxCaret )
+ ListBox_SetSel( hList, true, idxCaret )
+ end if
+ end if
+ AfxRedrawWindow(hList)
+
+ ' Determine if the VScroll bar has changed size or is now hidden/shown
+ frmPanelVScroll_PositionWindows( SW_HIDE )
+
+ function = 0
+end function
+
+
diff --git a/src/frmFindInFiles.bi b/src/frmFindInFiles.bi
index d7bed4c6..0900b90e 100644
--- a/src/frmFindInFiles.bi
+++ b/src/frmFindInFiles.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmFindInFiles.bi.bak b/src/frmFindInFiles.bi.bak
new file mode 100644
index 00000000..d7bed4c6
--- /dev/null
+++ b/src/frmFindInFiles.bi.bak
@@ -0,0 +1,36 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMFINDINFILES_LBLFINDWHAT 1000
+#Define IDC_FRMFINDINFILES_COMBOFIND 1001
+#Define IDC_FRMFINDINFILES_COMBOFILES 1002
+#Define IDC_FRMFINDINFILES_COMBOFOLDER 1003
+#Define IDC_FRMFINDINFILES_CHKWHOLEWORDS 1004
+#Define IDC_FRMFINDINFILES_CHKMATCHCASE 1005
+#Define IDC_FRMFINDINFILES_FRAMESCOPE 1006
+#Define IDC_FRMFINDINFILES_OPTSCOPE1 1007
+#Define IDC_FRMFINDINFILES_OPTSCOPE2 1008
+#Define IDC_FRMFINDINFILES_OPTSCOPE3 1009
+#Define IDC_FRMFINDINFILES_CHKSUBFOLDERS 1010
+#Define IDC_FRMFINDINFILES_FRAMEOPTIONS 1011
+#Define IDC_FRMFINDINFILES_CMDFILES 1012
+#Define IDC_FRMFINDINFILES_CMDFOLDERS 1013
+#Define IDC_FRMFINDINFILES_LABEL1 1014
+#Define IDC_FRMFINDINFILES_LABEL2 1015
+#Define IDC_FRMFINDINFILES_CHKCURRENTDOC 1016
+#Define IDC_FRMFINDINFILES_CHKALLOPENDOCS 1017
+#Define IDC_FRMFINDINFILES_CHKPROJECT 1018
+
+declare Function frmFindInFiles_Show( ByVal hWndParent As HWnd ) As LRESULT
diff --git a/src/frmFindInFiles.inc b/src/frmFindInFiles.inc
index 4b58e92f..36ef22fd 100644
--- a/src/frmFindInFiles.inc
+++ b/src/frmFindInFiles.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmFindInFiles.inc.bak b/src/frmFindInFiles.inc.bak
new file mode 100644
index 00000000..4b58e92f
--- /dev/null
+++ b/src/frmFindInFiles.inc.bak
@@ -0,0 +1,860 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmFindInFiles.bi"
+#include once "frmOutput.bi"
+#include once "clsDocument.bi"
+
+''
+'' FINDSTRING.BAS
+'' Search for string in one or more files or folders.
+''
+
+#define unicode
+#include once "windows.bi"
+#include once "Afx/CFindFile.inc"
+#include once "Afx/CTextStream.inc"
+
+USING Afx
+
+
+''
+''
+function FindInFiles_ProcessFile( _
+ byref pStreamResults as CTextStream, _
+ byref wszFindText as wstring, _
+ byref wszFilename as wstring, _
+ byval bMatchCase as Boolean, _
+ byval bWholeWords as Boolean _
+ ) as Long
+
+ if AfxFileExists( wszFilename ) = false then exit function
+
+ dim as long nLineNum = 0
+ dim as long nFoundPos, nStartPos
+ dim as Boolean bUnicode = AfxIsFileUnicode( wszFilename )
+ dim as Boolean bReadingForm = false
+
+ dim pStream as CTextStream
+
+ if pStream.Open( wszFilename, IOMODE_FORREADING, false, bUnicode ) = S_OK then
+
+ dim as CWSTR wszLine, wszResult, wszLookLine
+
+ if bMatchCase = false then wszFindText = ucase(wszFindText)
+
+ Do Until pStream.EOS
+ wszLine = pStream.ReadLine
+
+ ' Only unicode files can be Form files. We need to bypass all Form meta data
+ ' and code generation.
+ if (bUnicode = true) and (nLineNum = 0) then
+ if left(wszLine, 13) = "' WINFBE FORM" then
+ bReadingForm = true
+ end if
+ end if
+ if bReadingForm = true then
+ if left(wszLine, 20) = "' WINFBE_CODEGEN_END" then
+ bReadingForm = false
+ continue do
+ end if
+ end if
+
+ if bReadingForm then continue do
+
+ nLineNum = nLineNum + 1
+
+ if len(wszLine) >= len(wszFindText) then
+ wszLookLine = iif(bMatchCase, wszLine, ucase(wszLine))
+
+ nFoundPos = instr( 1, wszLookLine, wszFindText )
+ do until nFoundPos = 0
+ nStartPos = nFoundPos + len(wszFindText)
+ if bWholeWords then
+ ' Only give a positive match if the character before and after the match
+ ' position is not an alphanumeric or space.
+ dim as long chLeftChar = asc(wszLine, nFoundPos - 1)
+ dim as long chRightChar = asc(wszLine, nFoundPos + len(wszFindText))
+
+ ' If word is enclosed by spaces then it is okay.
+ if ( chLeftChar = 32 ) andalso ( chRightChar = 32 ) then
+ ' okay
+ elseif IsCharAlphaNumeric( chLeftChar ) orelse _
+ IsCharAlphaNumeric( chRightChar ) then _
+ nFoundPos = 0
+ end if
+ end if
+
+ ' If we still have a valid result after doing the bWholeWords test then
+ ' output the result to the results text file.
+ if nFoundPos > 0 then
+ wszResult = wszFilename & ":" & nLineNum & ":" & wszLine
+ pStreamResults.WriteLine wszResult
+ ' We have found a match within the line. No need to continue searching
+ ' on this line because we don't want multiple copies outputted to the file.
+ exit do
+ end if
+
+ nFoundPos = instr( nStartPos, wszLookLine, wszFindText )
+ loop
+ end if
+
+ Loop
+ pStream.Close
+
+ else
+ ' ? "ERROR: "; wszFilename, bUnicode, pStream.GetErrorInfo
+ end if
+
+ function = 0
+end function
+
+
+''
+''
+function FindInFiles_RecursiveFileSearch( _
+ byref pStreamResults as CTextStream, _
+ byref wszFindText as wstring, _
+ byref wszFilePath as wstring, _
+ wszFileSpecs() as CWSTR, _
+ byval bSubFolders as Boolean, _
+ byval bMatchCase as Boolean, _
+ byval bWholeWords as Boolean _
+ ) as Long
+
+ DIM pFinder AS CFindFile
+
+ IF pFinder.FindFile( wszFilePath & "\*.*" ) = S_OK THEN
+ DO
+ IF pFinder.IsDots THEN
+ ' skip
+ elseif pFinder.IsFolder then
+ if bSubFolders then
+ FindInFiles_RecursiveFileSearch( _
+ pStreamResults, _
+ wszFindText, _
+ pFinder.FilePath, _
+ wszFileSpecs(), _
+ bSubFolders, _
+ bMatchCase, _
+ bWholeWords _
+ )
+ end if
+ else
+ dim as Boolean bProcessFile = false
+ dim as CWSTR wszExt
+
+ for i as long = lbound(wszFileSpecs) to ubound(wszFileSpecs)
+ bProcessFile = false
+ ' Check if the file spec is a wildcard or a matching filename.
+ if instr( wszFileSpecs(i), "*" ) then
+ wszExt = ucase(ltrim(AfxStrPathName("EXTN", wszFileSpecs(i)), "."))
+ IF (UCASE(pFinder.FileExt) = wszExt) orelse (wszExt = "*") THEN
+ ' bypass know binary files
+ select case UCASE(pFinder.FileExt)
+ case "EXE", "DLL", "GIF", "PNG", "JPG", "JPEG", "BMP", "ICO", _
+ "TIFF", "CHM", "CHW", "CUR", "XLS", "XLSX", "PDF", "ZIP", _
+ "SVG", "RAR"
+ bProcessFile = false
+ case else
+ bProcessFile = true
+ end select
+ end if
+ else
+ ' Check if the filename matches.
+ if ucase(wszFileSpecs(i)) = ucase(pFinder.FilePath) then
+ bProcessFile = true
+ end if
+ end if
+
+ if bProcessFile then
+ FindInFiles_ProcessFile( _
+ pStreamResults, _
+ wszFindText, _
+ pFinder.FilePath, _
+ bMatchCase, _
+ bWholeWords _
+ )
+ exit for
+ END IF
+ next
+
+ END IF
+
+ IF pFinder.FindNext = 0 THEN EXIT DO
+ LOOP
+ END IF
+ pFinder.Close
+
+ function = 0
+end function
+
+
+
+' ========================================================================================
+' Set the states of the various controls
+' ========================================================================================
+Function frmFindInFiles_SetControlStates() As Long
+
+ Button_SetCheck( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKWHOLEWORDS), gFindInFiles.nWholeWord )
+ Button_SetCheck( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKMATCHCASE), gFindInFiles.nMatchCase )
+ Button_SetCheck( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKSUBFOLDERS), gFindInFiles.nSearchSubFolders )
+
+ Button_SetCheck( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKCURRENTDOC), gFindInFiles.nSearchCurrentDoc )
+ Button_SetCheck( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKALLOPENDOCS), gFindInFiles.nSearchAllOpenDocs )
+ Button_SetCheck( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKPROJECT), gFindInFiles.nSearchProject )
+
+ dim as long bEnable = true
+
+ if (gFindInFiles.nSearchCurrentDoc = BST_CHECKED) orelse _
+ (gFindInFiles.nSearchAllOpenDocs = BST_CHECKED) orelse _
+ (gFindInFiles.nSearchProject = BST_CHECKED ) then
+ bEnable = false
+ end if
+
+ EnableWindow( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFILES), bEnable )
+ EnableWindow( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFOLDER), bEnable )
+ EnableWindow( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CMDFILES), bEnable )
+ EnableWindow( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CMDFOLDERS), bEnable )
+ EnableWindow( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKSUBFOLDERS), bEnable )
+
+ EnableWindow( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKCURRENTDOC), _
+ iif( gTTabCtl.GetActiveDocumentPtr, true, false) )
+ EnableWindow( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKALLOPENDOCS), _
+ iif( gTTabCtl.GetItemCount, true, false) )
+ EnableWindow( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_CHKPROJECT), _
+ gApp.IsProjectActive )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Add a string to the Find combobox (ensure no duplicates)
+' ========================================================================================
+Function frmFindInFiles_AddToFindCombo( ByRef wszText As String ) As Long
+ Dim as long i
+ dim as long nFound = -1
+
+ wszText = trim(wszText)
+ if len(wszText) = 0 THEN exit function
+ ' See if the string already exists in the combobox
+ for i = 0 to ubound(gFindInFiles.txtFindCombo)
+ if gFindInFiles.txtFindCombo(i) = wszText THEN
+ nFound = i: exit for
+ END IF
+ NEXT
+ if nFound = -1 THEN ' was not found
+ for i = ubound(gFindInFiles.txtFindCombo) to 1 step -1
+ gFindInFiles.txtFindCombo(i) = gFindInFiles.txtFindCombo(i-1)
+ next
+ gFindInFiles.txtFindCombo(0) = wszText
+ END IF
+ gFindInFiles.txtFind = wszText
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Add a string to the Files combobox (ensure no duplicates)
+' ========================================================================================
+Function frmFindInFiles_AddToFilesCombo( ByRef wszText As wString ) As Long
+ Dim as long i
+ dim as long nFound = -1
+
+ ' Array is current 0 to 10 dimension
+ wszText = trim(wszText)
+ if len(wszText) = 0 THEN exit function
+ ' See if the string already exists in the combobox
+ for i = 0 to ubound(gFindInFiles.txtFilesCombo)
+ if gFindInFiles.txtFilesCombo(i) = wszText THEN
+ nFound = i: exit for
+ END IF
+ NEXT
+ if nFound = -1 THEN ' was not found
+ ' Move all entries down onw and add the text at the beginning of the list.
+ for i = ubound(gFindInFiles.txtFilesCombo) to 1 step -1
+ gFindInFiles.txtFilesCombo(i) = gFindInFiles.txtFilesCombo(i-1)
+ next
+ gFindInFiles.txtFilesCombo(0) = wszText
+ END IF
+ gFindInFiles.txtFiles = wszText
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Add a string to the Folders combobox (ensure no duplicates)
+' ========================================================================================
+Function frmFindInFiles_AddToFolderCombo( ByRef wszText As wString ) As Long
+ Dim as long i
+ dim as long nFound = -1
+
+ wszText = trim(wszText)
+ if len(wszText) = 0 THEN exit function
+ ' See if the string already exists in the combobox
+ for i = 0 to ubound(gFindInFiles.txtFolderCombo)
+ if gFindInFiles.txtFolderCombo(i) = wszText THEN
+ nFound = i: exit for
+ END IF
+ NEXT
+ if nFound = -1 THEN ' was not found
+ for i = ubound(gFindInFiles.txtFolderCombo) to 1 step -1
+ gFindInFiles.txtFolderCombo(i) = gFindInFiles.txtFolderCombo(i-1)
+ next
+ gFindInFiles.txtFolderCombo(0) = wszText
+ END IF
+ gFindInFiles.txtFolder = wszText
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' File search procedure (shell out to builtin Windows "findstr" utility
+' ========================================================================================
+function frmFindInFiles_DoFindInFilesEx() as LONG
+ Dim ShExecInfo As SHELLEXECUTEINFOW
+ dim as CWSTR DQ = wchr(34)
+
+ dim as HCURSOR hCurSave = GetCursor()
+ SetCursor( LoadCursor(0, IDC_WAIT) )
+
+ ' Ensure that the text in the find textbox has been added to the combobox. Need to do
+ ' this to ensure that manually typed in text has been captured.
+ Dim wszFindText As WString * MAX_PATH
+ wszFindText = AfxGetWindowText( GetDlgItem(HWnd_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFIND))
+ if len(wszFindText) = 0 THEN
+ SetFocus( GetDlgItem(HWnd_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFIND) )
+ exit function
+ END IF
+ gFindInFiles.txtFind = wszFindText
+ frmFindInFiles_AddToFindCombo(gFindInFiles.txtFind)
+
+
+ ' What folder to start searching in
+ gFindInFiles.txtFolder = trim(AfxGetWindowText( GetDlgItem(HWND_FRMFINDINFILES,IDC_FRMFINDINFILES_COMBOFOLDER) ))
+ if len(gFindInFiles.txtFolder) = 0 THEN
+ gFindInFiles.txtFolder = AfxGetExePathName
+ AfxSetWindowText( GetDlgItem(HWND_FRMFINDINFILES,IDC_FRMFINDINFILES_COMBOFOLDER), gFindInFiles.txtFolder )
+ end if
+ frmFindInFiles_AddToFolderCombo(gFindInFiles.txtFolder)
+ if right(gFindInFiles.txtFolder,1) <> "\" then gFindInFiles.txtFolder = gFindInFiles.txtFolder & "\"
+ dim wszFolder as CWSTR = gFindInFiles.txtFolder
+
+
+ ' What files are we searching in
+ dim as BOOLEAN bInString
+ dim as long ub
+ dim as CWSTR wszFiles, wszSearchFiles, wszFilename
+
+ wszFiles = trim(AfxGetWindowText( GetDlgItem(HWnd_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFILES)))
+ gFindInFiles.txtFiles = wszFiles
+ frmFindInFiles_AddToFilesCombo( gFindInFiles.txtFiles )
+
+ dim wszFileSpecs(any) as CWSTR
+ ' Examples:
+ ' dim wszFileSpecs(2) as CWSTR
+ ' wszFileSpecs(0) = "*.bas"
+ ' wszFileSpecs(1) = "*.bi"
+ ' wszFileSpecs(2) = "*.inc"
+ '
+ ' dim wszFileSpecs(0) as CWSTR
+ ' wszFileSpecs(0) = "D:\WinFBE_Suite-Editor\sample.bas"
+
+ ' Look at the files to determine if multiple files or file types need to be searched for.
+ if instr( wszFiles, DQ ) THEN
+ ' In order to better parse the string for the filenames, replace any spaces within the
+ ' filenames with special character (Ascii(8)); then parse; and finally replace the special character.
+ for i as long = 0 to len(wszFiles) - 1
+ select case wszFiles[i]
+ case 34 ' double quote
+ bInString = not bInString
+ case 32 ' space
+ if bInString THEN wszFiles[i] = 8
+ end select
+ NEXT
+
+ ' Clean the string to remove any duplicate remaining spaces
+ wszFiles = AfxStrShrink(wszFiles)
+
+ ' This is a list of double quoted filenames to search
+ dim as long nCount = AfxStrParseCount(wszFiles, " ")
+
+ for i as long = 1 to nCount
+ wszFilename = trim( AfxStrParse(wszFiles, i, " "), DQ )
+ ' Put back any special characters to spaces again
+ wszFilename = AfxStrReplace(wszFilename, wchr(8), " " )
+ ' Add it to our list of wszFileSpecs
+ ub = ubound(wszFileSpecs) + 1
+ redim preserve wszFileSpecs( ub )
+ wszFileSpecs(ub) = wszFolder & wszFilename
+ NEXT
+
+ else
+ ' This is a list of patterns to use (*.bas *.bi) etc
+ dim as long nCount = AfxStrParseCount( wszFiles, " " )
+ for i as long = 1 to nCount
+ ub = ubound(wszFileSpecs) + 1
+ redim preserve wszFileSpecs( ub )
+ wszFileSpecs(ub) = wszFolder & AfxStrParse( wszFiles, i, " " )
+ NEXT
+ END IF
+
+
+ ' Create a results file to capture the results
+ dim pStreamResults as CTextStream ' (create)(utf16)
+ dim as CWSTR wszSearchResults = AfxGetExePathName & "_searchresults.txt"
+ if pStreamResults.Create( wszSearchResults, true, true) = S_OK then
+
+ dim as Boolean bWholeWord = iif( gFindInFiles.nWholeWord = BST_CHECKED, true, false )
+ dim as Boolean bMatchCase = iif( gFindInFiles.nMatchCase = BST_CHECKED, true, false )
+ dim as Boolean bSubFolders = iif( gFindInFiles.nSearchSubFolders = BST_CHECKED, true, false )
+
+ if (gFindInFiles.nSearchProject = BST_CHECKED) or _
+ (gFindInFiles.nSearchCurrentDoc = BST_CHECKED) or _
+ (gFindInFiles.nSearchAllOpenDocs = BST_CHECKED) then
+
+ Dim pDoc As clsDocument Ptr = gApp.pDocList
+ do until pDoc = 0
+ wszFilename = ""
+
+ if gFindInFiles.nSearchProject = BST_CHECKED then
+ wszFilename = pDoc->DiskFilename
+ end if
+
+ if gFindInFiles.nSearchAllOpenDocs = BST_CHECKED then
+ if gTTabCtl.GetTabIndexFromFilename( pDoc->DiskFilename ) <> -1 then
+ wszFilename = pDoc->DiskFilename
+ end if
+ end if
+
+ if gFindInFiles.nSearchCurrentDoc = BST_CHECKED then
+ if pDoc = gTTabCtl.GetActiveDocumentPtr() then
+ wszFilename = pDoc->DiskFilename
+ end if
+ end if
+
+ FindInFiles_ProcessFile( _
+ pStreamResults, _
+ gFindInFiles.txtFind, _
+ wszFilename, _
+ bMatchCase, _
+ bWholeWord _
+ )
+
+ pDoc = pDoc->pDocNext
+ loop
+
+ else
+ FindInFiles_RecursiveFileSearch( _
+ pStreamResults, _
+ gFindInFiles.txtFind, _
+ gFindInFiles.txtFolder, _
+ wszFileSpecs(), _
+ bSubFolders, _ ' Search subfolders
+ bMatchCase, _ ' Match case
+ bWholeWord _ ' Whole words
+ )
+ end if
+
+ pStreamResults.Close
+ else
+ ' ? "Error creating _FindResults.txt file."
+ end if
+
+ frmOutput_UpdateSearchListview( wszSearchResults )
+
+ SetCursor( hCurSave )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmFindInFiles
+' ========================================================================================
+Function frmFindInFiles_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+ Case IDOK ' Find Next
+ If codeNotify = BN_CLICKED Then
+ EnableWindow(hwndCtl, False)
+ frmFindInFiles_DoFindInFilesEx()
+ EnableWindow(hwndCtl, true)
+ Exit Function
+ End If
+
+ Case IDCANCEL ' Close
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0)
+ Exit Function
+ End If
+
+ Case IDC_FRMFINDINFILES_COMBOFIND
+ ' Catch the dropdown of the Find combobox so we can populate it
+ If codeNotify = CBN_DROPDOWN Then
+ ' Add any previous search terms to the combobox
+ Dim As Long i
+ Dim wszText As WString * MAX_PATH
+ wszText = AfxGetWindowText(hwndCtl)
+ frmFindInFiles_AddToFindCombo(Str(wszText))
+ ComboBox_ResetContent(hwndCtl)
+ For i = 0 To ubound(gFindInFiles.txtFindCombo)
+ If Len(gFindInFiles.txtFindCombo(i)) Then
+ wszText = gFindInFiles.txtFindCombo(i)
+ ComboBox_AddString( hwndCtl, @wszText )
+ end if
+ Next
+ wszText = gFindInFiles.txtFind
+ i = ComboBox_FindStringExact( hwndCtl, -1, @wszText )
+ ComboBox_SetCurSel(hwndCtl, i)
+ End If
+
+ Case IDC_FRMFINDINFILES_COMBOFILES
+ ' Catch the dropdown of the Files combobox so we can populate it
+ If codeNotify = CBN_DROPDOWN Then
+ ' Add any previous search terms to the combobox
+ Dim As Long i
+ Dim wszText As WString * MAX_PATH
+ wszText = AfxGetWindowText(hwndCtl)
+ frmFindInFiles_AddToFilesCombo(Str(wszText))
+ ComboBox_ResetContent(hwndCtl)
+ For i = 0 To ubound(gFindInFiles.txtFilesCombo)
+ If Len(gFindInFiles.txtFilesCombo(i)) Then
+ wszText = gFindInFiles.txtFilesCombo(i)
+ ComboBox_AddString( hwndCtl, @wszText )
+ end if
+ Next
+ wszText = gFindInFiles.txtFiles
+ i = ComboBox_FindStringExact( hwndCtl, -1, @wszText )
+ ComboBox_SetCurSel(hwndCtl, i)
+ End If
+
+ Case IDC_FRMFINDINFILES_COMBOFOLDER
+ ' Catch the dropdown of the Files combobox so we can populate it
+ If codeNotify = CBN_DROPDOWN Then
+ ' Add any previous search terms to the combobox
+ Dim As Long i
+ Dim wszText As WString * MAX_PATH
+ wszText = AfxGetWindowText(hwndCtl)
+ frmFindInFiles_AddToFolderCombo(Str(wszText))
+ ComboBox_ResetContent(hwndCtl)
+ For i = 0 To ubound(gFindInFiles.txtFolderCombo)
+ If Len(gFindInFiles.txtFolderCombo(i)) Then
+ wszText = gFindInFiles.txtFolderCombo(i)
+ ComboBox_AddString( hwndCtl, @wszText )
+ end if
+ Next
+ wszText = gFindInFiles.txtFolder
+ i = ComboBox_FindStringExact( hwndCtl, -1, @wszText )
+ ComboBox_SetCurSel(hwndCtl, i)
+ End If
+
+ Case IDC_FRMFINDINFILES_CMDFILES
+ If codeNotify = BN_CLICKED Then
+ ' Display the Open File Dialog
+ Dim pItems As IShellItemArray Ptr = AfxIFileOpenDialogMultiple(HWnd, IDM_FILEOPEN)
+ If pItems = Null Then Exit Function
+ Dim dwItemCount As Long, i As Long, idx As Long, pItem As IShellItem Ptr, pwszName As WString Ptr
+ pItems->lpVtbl->GetCount(pItems, @dwItemCount)
+
+ dim wszFolder as CWSTR
+ dim wszFiles as CWSTR
+
+ For i = 0 To dwItemCount - 1
+ pItems->lpVtbl->GetItemAt(pItems, i, @pItem)
+ If pItem Then
+ pItem->lpVtbl->GetDisplayName(pItem, SIGDN_FILESYSPATH, @pwszName)
+ If pwszName Then
+ wszFolder = AfxStrPathName("PATH", *pwszName)
+ AfxSetWindowText( GetDlgItem(HWND_FRMFINDINFILES,IDC_FRMFINDINFILES_COMBOFOLDER), wszFolder)
+ wszFiles = wszFiles + Chr(34) + AfxStrPathName("NAMEX", *pwszName) + chr(34, 32)
+ CoTaskMemFree(pwszName)
+ pwszName = Null
+ End If
+ pItem->lpVtbl->Release(pItem)
+ pItem = Null
+ End If
+ Next
+ AfxSetWindowText( GetDlgItem(HWND_FRMFINDINFILES,IDC_FRMFINDINFILES_COMBOFILES), wszFiles)
+ gFindInFiles.txtFiles = str(wszFiles)
+ pItems->lpVtbl->Release(pItems)
+ Exit Function
+ End If
+
+ Case IDC_FRMFINDINFILES_CMDFOLDERS
+ If codeNotify = BN_CLICKED Then
+ static wszStartFolder as CWSTR
+ dim wszFolder as CWSTR
+ if len(wszStartFolder) = 0 then wszStartFolder = AfxGetExePathName
+ wszFolder = AfxBrowseForFolder( HWND_FRMFINDINFILES, L(261,"Choose the folder to search in:"), wszStartFolder )
+ if len(wszFolder) then
+ AfxSetWindowText( GetDlgItem(HWND_FRMFINDINFILES,IDC_FRMFINDINFILES_COMBOFOLDER), wszFolder)
+ gFindInFiles.txtFolder = str(wszFolder)
+ end if
+ Exit Function
+ End If
+
+ Case IDC_FRMFINDINFILES_CHKMATCHCASE
+ If codeNotify = BN_CLICKED Then
+ gFindInFiles.nMatchCase = Button_GetCheck(hwndCtl)
+ Exit Function
+ End If
+
+ Case IDC_FRMFINDINFILES_CHKWHOLEWORDS
+ If codeNotify = BN_CLICKED Then
+ gFindInFiles.nWholeWord = Button_GetCheck(hwndCtl)
+ Exit Function
+ End If
+
+ Case IDC_FRMFINDINFILES_CHKSUBFOLDERS
+ If codeNotify = BN_CLICKED Then
+ gFindInFiles.nSearchSubFolders = Button_GetCheck(hwndCtl)
+ Exit Function
+ End If
+
+ Case IDC_FRMFINDINFILES_CHKCURRENTDOC
+ If codeNotify = BN_CLICKED Then
+ gFindInFiles.nSearchCurrentDoc = Button_GetCheck(hwndCtl)
+ gFindInFiles.nSearchAllOpenDocs = BST_UNCHECKED
+ gFindInFiles.nSearchProject = BST_UNCHECKED
+ frmFindInFiles_SetControlStates
+ Exit Function
+ End If
+
+ Case IDC_FRMFINDINFILES_CHKALLOPENDOCS
+ If codeNotify = BN_CLICKED Then
+ gFindInFiles.nSearchAllOpenDocs = Button_GetCheck(hwndCtl)
+ gFindInFiles.nSearchCurrentDoc = BST_UNCHECKED
+ gFindInFiles.nSearchProject = BST_UNCHECKED
+ frmFindInFiles_SetControlStates
+ Exit Function
+ End If
+
+ Case IDC_FRMFINDINFILES_CHKPROJECT
+ If codeNotify = BN_CLICKED Then
+ gFindInFiles.nSearchProject = Button_GetCheck(hwndCtl)
+ gFindInFiles.nSearchAllOpenDocs = BST_UNCHECKED
+ gFindInFiles.nSearchCurrentDoc = BST_UNCHECKED
+ frmFindInFiles_SetControlStates
+ Exit Function
+ End If
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmFindInFiles
+' ========================================================================================
+Function frmFindInFiles_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow HWnd
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmFindInFiles
+' ========================================================================================
+Function frmFindInFiles_OnCreate( _
+ ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmFindInFiles
+' ========================================================================================
+Function frmFindInFiles_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ ' Save the search parameters for later instances of the find/replace dialog
+ gFindInFiles.nWholeWord = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMFINDINFILES_CHKWHOLEWORDS) )
+ gFindInFiles.nMatchCase = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMFINDINFILES_CHKMATCHCASE) )
+ gFindInFiles.nSearchSubFolders = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMFINDINFILES_CHKSUBFOLDERS) )
+ gFindInFiles.nSearchCurrentDoc = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMFINDINFILES_CHKCURRENTDOC) )
+ gFindInFiles.nSearchAllOpenDocs = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMFINDINFILES_CHKALLOPENDOCS) )
+ gFindInFiles.nSearchProject = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMFINDINFILES_CHKPROJECT) )
+ gFindInFiles.txtFind = AfxGetWindowText( GetDlgItem(HWnd_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFIND))
+ gFindInFiles.txtLastFind = gFindInFiles.txtFind
+ gFindInFiles.txtFiles = AfxGetWindowText( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFILES))
+ gFindInFiles.txtFolder = AfxGetWindowText( GetDlgItem(HWND_FRMFINDINFILES,IDC_FRMFINDINFILES_COMBOFOLDER))
+
+ HWND_FRMFINDINFILES = 0
+
+ PostQuitMessage(0)
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmFindInFiles Window procedure
+' ========================================================================================
+Function frmFindInFiles_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmFindInFiles_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmFindInFiles_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmFindInFiles_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmFindInFiles_OnCommand)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmFindInFiles_Show
+' ========================================================================================
+Function frmFindInFiles_Show( ByVal hWndParent As HWnd ) As LRESULT
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ HWND_FRMFINDINFILES = _
+ pWindow->Create(hwndParent, L(256,"Find In Files"), @frmFindInFiles_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->SetClientSize(515, 222)
+ pWindow->Center
+
+ pWindow->AddControl("LABEL", , IDC_FRMFINDINFILES_LBLFINDWHAT, L(159,"Find What") & ":", 7, 19, 70, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", , IDC_FRMFINDINFILES_LABEL1, L(259,"In Files") & ":", 7, 48, 70, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", , IDC_FRMFINDINFILES_LABEL1, L(260,"In Folder") & ":", 7, 78, 70, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMFINDINFILES_COMBOFIND, "", 85, 17, 317, 22, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWN Or CBS_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMFINDINFILES_COMBOFILES, "", 85, 46, 317, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWN Or CBS_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMFINDINFILES_COMBOFOLDER, "", 85, 75, 317, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWN Or CBS_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("BUTTON", , IDOK, L(158,"Find"), 414, 16, 90, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_DEFPUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMFINDINFILES_CMDFILES, "...", 414, 45, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMFINDINFILES_CMDFOLDERS, "...", 414, 74, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(161,"Close"), 414, 105, 90, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("GROUPBOX", , IDC_FRMFINDINFILES_FRAMEOPTIONS, L(167,"Options"), 16, 105, 386, 107, _
+ WS_CHILD Or WS_VISIBLE Or BS_TEXT Or BS_LEFT Or BS_NOTIFY Or BS_GROUPBOX, _
+ WS_EX_TRANSPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMFINDINFILES_CHKWHOLEWORDS, L(162,"Match Whole Words"), 26, 123, 167, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMFINDINFILES_CHKMATCHCASE, L(163,"Match Case"), 26, 143, 167, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMFINDINFILES_CHKSUBFOLDERS, L(258,"Search Subfolders"), 26, 163, 167, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMFINDINFILES_CHKCURRENTDOC, L(408,"Current Document"), 195, 123, 167, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMFINDINFILES_CHKALLOPENDOCS, L(409,"All Open Documents"), 195, 143, 167, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMFINDINFILES_CHKPROJECT, L(410,"Current Project"), 195, 163, 167, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ Dim As Long i, nCount, startPos, endPos, startLine, endLine
+ Dim As String buffer, sFind, sFiles, sFolder
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ ' Fills the search box with the selected word.
+ ' If there are carriage returns or/and line feeds, this mean that
+ ' there is a block selected, instead of a word, so avoid it.
+ buffer = pDoc->GetSelText()
+ If Len(buffer) Then
+ if pDoc->IsMultilineSelection = false then
+ sFind = buffer
+ gFindInFiles.txtLastFind = buffer
+ end if
+ else
+ sFind = gFindInFiles.txtLastFind
+ End If
+ End If
+ frmFindInFiles_AddToFindCombo(sFind)
+
+ if len(gFindInFiles.txtFilesCombo(0)) = 0 THEN sFiles = "*.bas *.bi *.inc"
+ frmFindInFiles_AddToFilesCombo(sFiles)
+
+ if len(gFindInFiles.txtFolderCombo(0)) = 0 THEN
+ if gApp.IsProjectActive THEN
+ sFolder = AfxStrPathName("PATH", gApp.ProjectFilename)
+ else
+ sFolder = AfxGetExePathName
+ END IF
+ end if
+ frmFindInFiles_AddToFolderCombo(sFolder)
+
+ AfxSetWindowText( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFIND), gFindInFiles.txtFind )
+ AfxSetWindowText( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFILES), gFindInFiles.txtFiles )
+ AfxSetWindowText( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFOLDER), gFindInFiles.txtFolder )
+ EnableWindow( GetDlgItem(HWND_FRMFINDINFILES, IDOK), True )
+
+ frmFindInFiles_SetControlStates
+
+ ShowWindow HWND_FRMFINDINFILES, SW_SHOW
+ SetFocus( GetDlgItem(HWND_FRMFINDINFILES, IDC_FRMFINDINFILES_COMBOFIND) )
+
+ ' Process Windows messages(modal)
+ Function = pWindow->DoEvents( SW_SHOW )
+
+ ' Delete the CWindow class manually allocated memory
+ Delete pWindow
+
+ Function = 0
+End Function
+
diff --git a/src/frmFindReplace.bi b/src/frmFindReplace.bi
index fa091c6e..6d3fb0c2 100644
--- a/src/frmFindReplace.bi
+++ b/src/frmFindReplace.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmFindReplace.bi.bak b/src/frmFindReplace.bi.bak
new file mode 100644
index 00000000..fa091c6e
--- /dev/null
+++ b/src/frmFindReplace.bi.bak
@@ -0,0 +1,21 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMFINDREPLACE_TXTFIND 1000
+#Define IDC_FRMFINDREPLACE_TXTREPLACE 1001
+
+declare function frmFindReplace_HighlightSearches( byval bRepositionCaret as boolean ) as long
+declare Function frmFindReplace_PositionWindows() As LRESULT
+declare Function frmFindReplace_Show( ByVal hWndParent As HWnd, byval fShowReplace as BOOLEAN ) As LRESULT
diff --git a/src/frmFindReplace.inc b/src/frmFindReplace.inc
index 59dc1271..e1a4bf3a 100644
--- a/src/frmFindReplace.inc
+++ b/src/frmFindReplace.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmFindReplace.inc.bak b/src/frmFindReplace.inc.bak
new file mode 100644
index 00000000..59dc1271
--- /dev/null
+++ b/src/frmFindReplace.inc.bak
@@ -0,0 +1,1147 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmFindReplace.bi"
+
+' ========================================================================================
+' Determine if the incoming string is uppercase
+' ========================================================================================
+function isUpperCaseString( byval sText as string ) as boolean
+ ' Default that the string is uppercase
+ function = true
+ for i as long = 0 to len(sText) - 1
+ if isupper( sText[i] ) = 0 then return false
+ next
+end function
+
+' ========================================================================================
+' Determine if the incoming string is lowercase
+' ========================================================================================
+function isLowerCaseString( byval sText as string ) as boolean
+ ' Default that the string is lowercase
+ function = true
+ for i as long = 0 to len(sText) - 1
+ if islower( sText[i] ) = 0 then return false
+ next
+end function
+
+' ========================================================================================
+' frmFindReplace_PositionWindows
+' ========================================================================================
+function frmFindReplace_PositionWindows() as LRESULT
+
+ ' make sure that the shadows under the top tabs are showing and if the main form
+ ' has moved, that the shadows move with it.
+ frmTopTabs_ShowShadow
+
+ if IsWindow( HWND_FRMFINDREPLACE ) = 0 then exit function
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr( HWND_FRMFINDREPLACE )
+ if pWindow = 0 then exit function
+
+ pWindow->SetClientSize( 420, iif(gFind.bExpanded, 66, 33) )
+
+ ' find/replace is a popup window so we need to use screen coordinates. Place the
+ ' window just below the toptabs or the menubar if the toptabs are not showing.
+ ' Place the window the width of 2 scrollbars from the right of the main window.
+ dim as hwnd hCtrl = iif( IsWindowVisible(HWND_FRMMAIN_TOPTABS), _
+ HWND_FRMMAIN_TOPTABS, HWND_FRMMAIN_MENUBAR )
+ dim as RECT rc = AfxGetWindowRect( hCtrl )
+ SetWindowPos( HWND_FRMFINDREPLACE_SHADOW, HWND_TOP, _
+ rc.right - AfxGetWindowWidth(HWND_FRMFINDREPLACE) - _
+ pWindow->ScaleX(SCROLLBAR_WIDTH_EDITOR*3) - pWindow->ScaleX(3), _
+ rc.bottom, _
+ AfxGetWindowWidth(HWND_FRMFINDREPLACE) + pWindow->ScaleY(6), _
+ AfxGetWindowHeight(HWND_FRMFINDREPLACE) + pWindow->ScaleY(3), _
+ SWP_SHOWWINDOW )
+ SetWindowPos( HWND_FRMFINDREPLACE, HWND_TOP, _
+ rc.right - AfxGetWindowWidth(HWND_FRMFINDREPLACE) - pWindow->ScaleX(SCROLLBAR_WIDTH_EDITOR * 3), _
+ rc.bottom, 0, 0, SWP_SHOWWINDOW or SWP_NOSIZE )
+
+ dim as long frmWidth = AfxGetWindowWidth( HWND_FRMFINDREPLACE )
+ dim as long frmHeight = AfxGetWindowHeight( HWND_FRMFINDREPLACE )
+ dim as long iconWidth = pWindow->ScaleX(24)
+ dim as long iconHeight = pWindow->ScaleY(24)
+ dim as long textBoxHeight = pWindow->ScaleY(24)
+ dim as long hmargin = pWindow->ScaleX(2)
+ dim as long vmargin = pWindow->ScaleX(6)
+ dim as long nLeft = pWindow->ScaleY(2) ' account for the LeftEdge border
+ dim as long nTop = 0
+
+ ' Set the RECT values for each element that we draw in the form. We use these RECTs for
+ ' hot hittests and for clicking hittests.
+ ' Each panel (find panel and replace panel) total height of 66px
+
+ ' calculate the expand/collapse button
+ gFind.rcExpand.Left = nLeft
+ gFind.rcExpand.top = 0
+ gFind.rcExpand.right = gFind.rcExpand.Left + iconWidth
+ gFind.rcExpand.bottom = gFind.rcExpand.top + frmHeight
+
+ ' Display the Find textbox
+ nTop = vmargin
+ nLeft = gFind.rcExpand.Right + hmargin
+ SetWindowPos( GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND), 0, _
+ nLeft, nTop, 0, 0, SWP_SHOWWINDOW or SWP_NOSIZE )
+
+ ' Match Case RECT
+ gFind.rcMatchCase.Left = nLeft + _
+ AfxGetWindowWidth( GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND) )
+ gFind.rcMatchCase.top = nTop
+ gFind.rcMatchCase.right = gFind.rcMatchCase.Left + iconWidth
+ gFind.rcMatchCase.bottom = gFind.rcMatchCase.top + iconWidth
+
+ ' Whole Word RECT
+ gFind.rcWholeWord.Left = gFind.rcMatchCase.right
+ gFind.rcWholeWord.top = nTop
+ gFind.rcWholeWord.right = gFind.rcWholeWord.Left + iconWidth
+ gFind.rcWholeWord.bottom = gFind.rcWholeWord.top + iconWidth
+
+ ' Results from search eg. "1 of 10"
+ gFind.rcResults.Left = gFind.rcWholeWord.right + hmargin + hmargin
+ gFind.rcResults.top = nTop
+ gFind.rcResults.right = gFind.rcResults.Left + pWindow->ScaleX(70)
+ gFind.rcResults.bottom = gFind.rcResults.top + pWindow->ScaleY(24)
+
+ ' UpArrow RECT
+ gFind.rcUpArrow.Left = gFind.rcResults.right + hmargin
+ gFind.rcUpArrow.top = nTop
+ gFind.rcUpArrow.right = gFind.rcUpArrow.Left + iconWidth
+ gFind.rcUpArrow.bottom = gFind.rcUpArrow.top + iconWidth
+
+ ' DownArrow RECT
+ gFind.rcDownArrow.Left = gFind.rcUpArrow.right + hmargin
+ gFind.rcDownArrow.top = nTop
+ gFind.rcDownArrow.right = gFind.rcDownArrow.Left + iconWidth
+ gFind.rcDownArrow.bottom = gFind.rcDownArrow.top + iconWidth
+
+ ' Selection RECT
+ gFind.rcSelection.Left = gFind.rcDownArrow.right + hmargin
+ gFind.rcSelection.top = nTop
+ gFind.rcSelection.right = gFind.rcSelection.Left + iconWidth
+ gFind.rcSelection.bottom = gFind.rcSelection.top + iconWidth
+
+ ' Close RECT
+ gFind.rcClose.Left = gFind.rcSelection.right + hmargin
+ gFind.rcClose.top = nTop
+ gFind.rcClose.right = gFind.rcClose.Left + iconWidth
+ gFind.rcClose.bottom = gFind.rcClose.top + iconWidth
+
+ ' Display the Replace textbox
+ nTop = vmargin + textBoxHeight + vmargin
+ nLeft = gFind.rcExpand.Right + hmargin
+ SetWindowPos( GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE), 0, _
+ nLeft, nTop, 0, 0, iif(gFind.bExpanded, SWP_SHOWWINDOW, SWP_HIDEWINDOW) or SWP_NOSIZE )
+
+ ' Preserve Case RECT
+ gFind.rcPreserve.Left = nleft + _
+ AfxGetWindowWidth(GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE))
+ gFind.rcPreserve.top = nTop
+ gFind.rcPreserve.right = gFind.rcPreserve.Left + iconWidth
+ gFind.rcPreserve.bottom = gFind.rcPreserve.top + iconWidth
+
+ ' Replace RECT
+ gFind.rcReplace.Left = gFind.rcPreserve.right + hmargin + hmargin
+ gFind.rcReplace.top = nTop
+ gFind.rcReplace.right = gFind.rcReplace.Left + iconWidth
+ gFind.rcReplace.bottom = gFind.rcReplace.top + iconWidth
+
+ ' ReplaceAll RECT
+ gFind.rcReplaceAll.Left = gFind.rcReplace.right
+ gFind.rcReplaceAll.top = nTop
+ gFind.rcReplaceAll.right = gFind.rcReplaceAll.Left + iconWidth
+ gFind.rcReplaceAll.bottom = gFind.rcReplaceAll.top + iconWidth
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Find next/prev selection based on current document position
+' ========================================================================================
+function frmFindReplace_NextSelection( _
+ byval StartPos as long, _
+ byval bGetnext as boolean, _
+ byval bRepositionCaret as boolean _
+ ) as boolean
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc = 0 then exit function
+
+ dim as long mainIdx, lenFind, endPos, nPos, iStart, iEnd
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ dim as hwnd hWndFind = GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND)
+ dim txtFind as string = str(AfxGetWindowText(hWndFind))
+ lenFind = len(txtFind)
+ endPos = SciExec( hEdit, SCI_GETTEXTLENGTH, 0, 0)
+ if endPos = 0 then exit function
+
+ ' Build an array holding all of the selection positions
+ redim iPositions(100) as long
+
+ gFind.foundCount = 0
+ while nPos <= endPos
+ iStart = SciExec( hEdit, SCI_INDICATORSTART, 8, nPos)
+ iEnd = SciExec( hEdit, SCI_INDICATOREND, 8, iStart)
+ if (iStart = 0) andalso (iEnd = 0) then exit while ' no indicators found
+
+ if SciExec( hEdit, SCI_INDICATORVALUEAT, 8, iStart-1) then
+ gFind.foundCount = gFind.foundCount + 1
+ if gFind.foundCount > ubound(iPositions) then
+ redim preserve iPositions(gFind.foundCount) as long
+ end if
+ iPositions(gFind.foundCount) = iStart - lenFind
+ end if
+ nPos = iEnd + 1
+ Wend
+
+ ' Determine the next/prev selection that we should position to.
+ if bGetnext then
+ ' next selection
+ mainIdx = 1
+ for i as long = 1 to gFind.foundCount
+ if iPositions(i) > startPos then
+ mainIdx = i: exit for
+ end if
+ next
+ else
+ ' Previous selection
+ mainIdx = gFind.foundCount
+ for i as long = 1 to gFind.foundCount
+ if iPositions(i) < startPos then
+ mainIdx = i
+ end if
+ next
+ end if
+
+ ' Highlight the selection
+ if gFind.foundCount > 0 then
+ ' make sure target line is unfolded
+ if bRepositionCaret then
+ dim as long currentLine = SciExec( hEdit, SCI_LINEFROMPOSITION, iPositions(mainIdx), 0)
+ SciExec( hEdit, SCI_ENSUREVISIBLE, currentLine, 0)
+ SciExec( hEdit, SCI_SETSEL, iPositions(mainIdx), iPositions(mainIdx) + lenFind)
+ end if
+ gFind.wszResults = mainIdx & " of " & gFind.foundCount
+ return true
+ else
+ SciExec( hEdit, SCI_SETSEL, startPos, startPos)
+ gFind.wszResults = L(269, "No results")
+ return false
+ end if
+end function
+
+
+' ========================================================================================
+' Replace current selection or all selections
+' ========================================================================================
+function frmFindReplace_DoReplace( _
+ byval fReplaceAll as boolean = false, _
+ byval fMovenext as boolean = true _
+ ) as long
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc = 0 then exit function
+
+ dim as hwnd hWndFind = GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND)
+ dim as hwnd hWndReplace = GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE)
+ dim as string txtFind = str(AfxGetWindowText(hWndFind))
+ dim as string txtReplace = str(AfxGetWindowText(hWndReplace))
+ dim as long lenFind = len(txtFind)
+
+ if lenFind = 0 then exit function
+
+ dim as long nPos, startPos, endPos, findFlags, r
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ if fReplaceAll = true then
+ if gFind.nMatchCase then findFlags = (findFlags or SCFIND_MATCHCASE)
+ if gFind.nWholeWord then findFlags = (findFlags or SCFIND_WHOLEWORD)
+ SendMessage( hEdit, SCI_SETSEARCHFLAGS, findFlags, 0)
+
+ if pDoc->HasMarkerHighlight then
+ startPos = SciExec( hEdit, SCI_POSITIONFROMLINE, pDoc->FirstMarkerHighlight, 0)
+ endPos = SciExec( hEdit, SCI_GETLINEENDPOSITION, pDoc->LastMarkerHighlight, 0)
+ SciExec( hEdit, SCI_SETTARGETSTART, startPos, 0)
+ SciExec( hEdit, SCI_SETTARGETEND, endPos, 0)
+ else
+ SciExec( hEdit, SCI_TARGETWHOLEDOCUMENT, 0, 0)
+ startPos = SciExec( hEdit, SCI_GETTARGETSTART, 0, 0)
+ endPos = SciExec( hEdit, SCI_GETTARGETEND, 0, 0)
+ end if
+ SciExec( hEdit, SCI_INDICATORCLEARRANGE, startPos, endPos)
+
+ gApp.SuppressNotify = true
+ SetWindowRedraw( hEdit, false )
+ SendMessage( hEdit, SCI_BEGINUNDOACTION, 0, 0)
+ do
+ r = SciExec( hEdit, SCI_SEARCHINTARGET, len(txtFind), strptr(txtFind))
+ if r = -1 then exit do
+ dim as zstring * MAX_PATH sSelText
+ SciExec( hEdit, SCI_GETTARGETTEXT, 0, @sSelText )
+ ' If Preserve Case is active then check the selection to see if the entire
+ ' selection is all UPPERCASE or all lowercase.
+ if gFind.nPreserve then
+ dim as string sReplaceText
+ if isUpperCaseString( sSelText ) then
+ sReplaceText = ucase(txtReplace)
+ elseif isLowerCaseString( sSelText ) then
+ sReplaceText = lcase(txtReplace)
+ else
+ sReplaceText = txtReplace
+ end if
+ SciExec( hEdit, SCI_REPLACETARGET, len(sReplaceText), strptr(sReplaceText) )
+ startPos = r + len(sReplaceText)
+ endPos = endPos + len(sReplaceText) - len(sSelText)
+ else
+ SciExec( hEdit, SCI_REPLACETARGET, len(txtReplace), strptr(txtReplace) )
+ startPos = r + len(txtReplace)
+ endPos = endPos + len(txtReplace) - len(sSelText)
+ end if
+ ' Need to update the end searching positions because the replace action may
+ ' have made the document larger or smaller.
+ SciExec( hEdit, SCI_SETTARGETSTART, startPos, 0)
+ SciExec( hEdit, SCI_SETTARGETEND, endPos, 0)
+ loop
+ SendMessage( hEdit, SCI_ENDUNDOACTION, 0, 0)
+ SetWindowRedraw( hEdit, true )
+ gApp.SuppressNotify = false
+ AfxRedrawWindow( hEdit )
+
+ else
+ ' Need to ensure that the current cursor/selection is actually the find
+ ' phrase that we want to replace. if not, then move to the closest selection.
+ if ucase(pDoc->GetSelText) <> ucase(txtFind) then
+ startPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ frmFindReplace_NextSelection(startPos, fMoveNext, true)
+ exit function
+ end if
+ SciExec( hEdit, SCI_TARGETFROMSELECTION, 0, 0)
+ ' If Preserve Case is active then check the selection to see if the entire
+ ' selection is all UPPERCASE or all lowercase.
+ if gFind.nPreserve then
+ dim as string sSelText = pDoc->GetSelText
+ dim as string sReplaceText
+ if isUpperCaseString( sSelText ) then
+ sReplaceText = ucase(txtReplace)
+ elseif isLowerCaseString( sSelText ) then
+ sReplaceText = lcase(txtReplace)
+ else
+ sReplaceText = txtReplace
+ end if
+ SciExec( hEdit, SCI_REPLACETARGET, len(sReplaceText), strptr(sReplaceText) )
+ startPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0) + len(sReplaceText)
+ else
+ SciExec( hEdit, SCI_REPLACETARGET, len(txtReplace), strptr(txtReplace) )
+ startPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0) + len(txtReplace)
+ end if
+ frmFindReplace_NextSelection(startPos, fMoveNext, true)
+ end if
+
+ ' Need to reparse because some of the function names may been replaced
+ ' with new names.
+ pDoc->bNeedsParsing = true
+ pDoc->ParseDocument()
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Highlight the found selections
+' ========================================================================================
+function frmFindReplace_HighlightSearches( byval bRepositionCaret as boolean ) as long
+
+ dim as long r, startPos, endPos, findFlags, nLength
+ dim as hwnd hWndFind = GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND)
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc = 0 then exit function
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ SciExec( hEdit, SCI_SETADDITIONALCARETSVISIBLE, false, 0)
+ SciExec( hEdit, SCI_INDICSETSTYLE, 8, INDIC_STRAIGHTBOX)
+ SciExec( hEdit, SCI_SETINDICATORCURRENT, 8, 0)
+ SciExec( hEdit, SCI_INDICSETFORE, 8, ghEditor.ForeColorOccurrence )
+ SciExec( hEdit, SCI_INDICSETALPHA, 8, 60 )
+
+ dim txtFind as string = str(AfxGetWindowText(hWndFind))
+
+ if gFind.nMatchCase then findFlags = (findFlags or SCFIND_MATCHCASE)
+ if gFind.nWholeWord then findFlags = (findFlags or SCFIND_WHOLEWORD)
+ SciExec( hEdit, SCI_SETSEARCHFLAGS, findFlags, 0)
+
+ ' Remove all existing selection indicators
+ nLength = SendMessage( hEdit, SCI_GETTEXTLENGTH, 0, 0)
+ SciExec( hEdit, SCI_INDICATORCLEARRANGE, 0, nLength)
+
+ ' Are we searching a selection or the whole document
+ if pDoc->HasMarkerHighlight then
+ startPos = SciExec( hEdit, SCI_POSITIONFROMLINE, pDoc->FirstMarkerHighlight, 0)
+ endPos = SciExec( hEdit, SCI_GETLINEENDPOSITION, pDoc->LastMarkerHighlight, 0)
+ SciExec( hEdit, SCI_SETTARGETSTART, startPos, 0)
+ SciExec( hEdit, SCI_SETTARGETEND, endPos, 0)
+ else
+ SciExec( hEdit, SCI_TARGETWHOLEDOCUMENT, 0, 0)
+ startPos = SciExec( hEdit, SCI_GETTARGETSTART, 0, 0)
+ endPos = SciExec( hEdit, SCI_GETTARGETEND, 0, 0)
+ end if
+
+ ' Search for the text to find
+ if len(txtFind) then
+ do
+ r = SciExec( hEdit, SCI_SEARCHINTARGET, len(txtFind), strptr(txtFind))
+ if r = -1 then exit do
+
+ SciExec( hEdit, SCI_SETINDICATORVALUE, 8, 0 )
+ SciExec( hEdit, SCI_INDICATORFILLRANGE, r, len(txtFind))
+ startPos = r + len(txtFind)
+
+ ' Adjust the searching positions
+ SciExec( hEdit, SCI_SETTARGETSTART, startPos, 0)
+ SciExec( hEdit, SCI_SETTARGETEND, endPos, 0)
+ loop
+ startPos = SciExec( hEdit, SCI_GETANCHOR, 0, 0)
+ endPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ if endPos < startPos then startPos = endPos
+ startPos = startPos - 1
+ else
+ startPos = SciExec( hEdit, SCI_GETANCHOR, 0, 0)
+ end if
+
+ startPos = iif(startPos < 0, 0, startPos)
+ frmFindReplace_NextSelection(startPos, true, bRepositionCaret)
+
+ function = 0
+
+end function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmFindReplace
+' ========================================================================================
+function frmFindReplace_OnCommand( _
+ byval HWnd as HWnd, _
+ byval id as Long, _
+ byval hwndCtl as HWnd, _
+ byval codeNotify as UINT _
+ ) as LRESULT
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc = 0 then exit function
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+
+ select case id
+
+ case IDC_FRMFINDREPLACE_TXTFIND
+ if (codeNotify = EN_CHANGE) then
+ gFind.txtFind = AfxGetWindowText(hwndCtl)
+ frmFindReplace_HighlightSearches( true )
+ SetFocus( hwndCtl ) ' in case search stole focus from textbox
+ AfxRedrawWindow( hWnd )
+ elseif (codeNotify = EN_SETFOCUS) then
+ AfxRedrawWindow( hWnd )
+ end if
+
+ case IDC_FRMFINDREPLACE_TXTREPLACE
+ if (codeNotify = EN_SETFOCUS) then
+ AfxRedrawWindow( hWnd )
+ end if
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_PAINT message for window/dialog: frmFindReplace
+' ========================================================================================
+function frmFindReplace_OnPaint( byval HWnd as HWND) as LRESULT
+
+ dim as PAINTSTRUCT ps
+ dim as HPEN hPen
+ dim as HWND hCtl
+ dim as HDC hDc
+ dim as Rect rc
+
+ dim as long wsStyle
+
+ dim pWindow as CWindow ptr = AfxCWindowOwnerPtr(HWND)
+ if pWindow = 0 then exit function
+
+ hDC = BeginPaint( hWnd, @ps )
+
+ SaveDC( hDC )
+
+ dim as long nWidth = ps.rcPaint.right - ps.rcPaint.left
+ dim as long nHeight = ps.rcPaint.bottom - ps.rcPaint.top
+
+ dim memDC as HDC ' Double buffering
+ dim hbit as HBITMAP ' Double buffering
+
+ memDC = CreateCompatibleDC( hDC )
+ hbit = CreateCompatibleBitmap( hDC, nWidth, nHeight )
+ if hbit then hbit = SelectObject( memDC, hbit )
+
+ SelectObject( memDC, ghFindReplace.hPanelBrush )
+
+ ' Fill in the entire back panel width across the top of the screen
+ FillRect( memDC, @ps.rcPaint, ghFindReplace.hPanelBrush )
+
+ ' Paint the left edge
+ hPen = CreatePen( PS_SOLID, pWindow->ScaleY(2), ghFindReplace.leftedge )
+ SelectPen( memDC, hPen )
+ MoveToEx( memDC, 0, 0, null )
+ LineTo( memDC, 0, ps.rcPaint.bottom )
+ DeletePen( hPen )
+
+ ' Paint the Expand/Collapse button
+ if isMouseOverRECT( HWnd, gFind.rcExpand ) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ FillRect( memDC, @gFind.rcExpand, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.BackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ FillRect( memDC, @gFind.rcExpand, ghFindReplace.hBackBrush )
+ end if
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ dim as CWSTR wszText = iif( gFind.bExpanded, wszChevronDown, wszChevronRight )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszText.sptr, -1, cast(lpRect, @gFind.rcExpand), wsStyle )
+
+ ' Paint a rectangle around the textbox control that has focus.
+ hPen = CreatePen( PS_SOLID, 1, BGR(0,0,255) ) ' blue
+ SelectPen( memDC, hPen )
+ hCtl = GetFocus()
+ if hCtl = GetDlgItem(HWND, IDC_FRMFINDREPLACE_TXTFIND) then
+ SelectObject( hDC, ghFindReplace.hBackBrushTextBox )
+ GetWindowRect( GetDlgItem(HWND, IDC_FRMFINDREPLACE_TXTFIND), @rc )
+ MapWindowPoints( HWND_DESKTOP, HWND, cast(LPPOINT, @rc), 2)
+ Rectangle( memDC, rc.left - 1, rc.top - 1, rc.right + pWindow->ScaleX(49), rc.bottom + 1 )
+ elseif hCtl = GetDlgItem(HWND, IDC_FRMFINDREPLACE_TXTREPLACE) then
+ SelectObject( hDC, ghFindReplace.hBackBrushTextBox )
+ GetWindowRect( GetDlgItem(HWND, IDC_FRMFINDREPLACE_TXTREPLACE), @rc )
+ MapWindowPoints( HWND_DESKTOP, HWND, cast(LPPOINT, @rc), 2)
+ Rectangle( memDC, rc.left - 1, rc.top - 1, rc.right + pWindow->ScaleX(25), rc.bottom + 1 )
+ end if
+ DeleteObject( hPen )
+
+ ' Match Case
+ hPen = CreatePen( PS_NULL, 1, 0 ) ' null/invisible pen
+ SelectPen( memDC, hPen )
+ if gFind.nMatchCase then
+ SetBkColor( memDC, ghFindReplace.IconSelectedBackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrushIconSelected )
+ elseif isMouseOverRECT( HWnd, gFind.rcMatchCase ) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ SelectObject( memDC, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.TextBoxBackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrushTextBox )
+ end if
+ FillRect( memDC, @gFind.rcMatchCase, ghFindReplace.hBackBrushTextBox )
+ ' shrink the rectangle in order to fit within the textbox
+ rc = gFind.rcMatchCase
+ InflateRect( @rc, -(pWindow->ScaleX(2)), -(pWindow->ScaleY(2)) )
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SelectObject(memDC, ghStatusBar.hFontStatusBar)
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszMatchCase, -1, cast(lpRect, @rc), wsStyle )
+
+ ' Whole Word
+ if gFind.nWholeWord then
+ SetBkColor( memDC, ghFindReplace.IconSelectedBackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrushIconSelected )
+ elseif isMouseOverRECT( HWnd, gFind.rcWholeWord ) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ SelectObject( memDC, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.TextBoxBackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrushTextBox )
+ end if
+ rc = gFind.rcWholeWord
+ FillRect( memDC, @rc, ghFindReplace.hBackBrushTextBox )
+ ' shrink the rectangle in order to fit within the textbox
+ InflateRect( @rc, -(pWindow->ScaleX(2)), -(pWindow->ScaleY(2)) )
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SelectObject(memDC, ghStatusBar.hFontStatusBar)
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszWholeWord, -1, cast(lpRect, @rc), wsStyle )
+
+ ' Paint the Results text
+ if gFind.foundCount = 0 then
+ SetTextColor( memDC, ghFindReplace.NotFoundForeColor )
+ else
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ end if
+ SetBkColor( memDC, ghFindReplace.BackColor )
+ SelectObject(memDC, ghStatusBar.hFontStatusBar)
+ wsStyle = DT_NOPREFIX or DT_LEFT or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, gFind.wszResults.sptr, -1, cast(lpRect, @gFind.rcResults), wsStyle )
+
+ ' Paint the Up Arrow
+ if isMouseOverRECT( HWnd, gFind.rcUpArrow ) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ SelectObject( memDC, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.BackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrush )
+ end if
+ rc = gFind.rcUpArrow
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszUpArrow, -1, cast(lpRect, @rc), wsStyle )
+
+ ' Paint the Down Arrow
+ if isMouseOverRECT( HWnd, gFind.rcDownArrow ) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ SelectObject( memDC, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.BackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrush )
+ end if
+ rc = gFind.rcDownArrow
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszDownArrow, -1, cast(lpRect, @rc), wsStyle )
+
+ ' Paint the Selection icon
+ if gFind.nSelection then
+ SetBkColor( memDC, ghFindReplace.IconSelectedBackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrushIconSelected )
+ elseif isMouseOverRECT( HWnd, gFind.rcSelection) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ SelectObject( memDC, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.BackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrush )
+ end if
+ rc = gFind.rcSelection
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszSelection, -1, cast(lpRect, @rc), wsStyle )
+
+ ' Paint the Close icon
+ if isMouseOverRECT( HWnd, gFind.rcClose) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ SelectObject( memDC, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.BackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrush )
+ end if
+ rc = gFind.rcClose
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszClose, -1, cast(lpRect, @rc), wsStyle )
+
+ ' Preserve Case
+ if gFind.nPreserve then
+ SetBkColor( memDC, ghFindReplace.IconSelectedBackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrushIconSelected )
+ elseif isMouseOverRECT( HWnd, gFind.rcPreserve ) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ SelectObject( memDC, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.TextBoxBackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrushTextBox )
+ end if
+ FillRect( memDC, @gFind.rcPreserve, ghFindReplace.hBackBrushTextBox )
+ ' shrink the rectangle in order to fit within the textbox
+ rc = gFind.rcPreserve
+ InflateRect( @rc, -(pWindow->ScaleX(2)), -(pWindow->ScaleY(2)) )
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SelectObject(memDC, ghStatusBar.hFontStatusBar)
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszPreserveCase, -1, cast(lpRect, @rc), wsStyle )
+
+ ' Paint the Replace icon
+ if isMouseOverRECT( HWnd, gFind.rcReplace) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ SelectObject( memDC, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.BackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrush )
+ end if
+ rc = gFind.rcReplace
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszReplace, -1, cast(lpRect, @rc), wsStyle )
+
+ ' Paint the ReplaceAll icon
+ if isMouseOverRECT( HWnd, gFind.rcReplaceAll) then
+ SetBkColor( memDC, ghFindReplace.IconBackColorHot )
+ SetTextColor( memDC, ghFindReplace.ForeColorHot )
+ SelectObject( memDC, ghFindReplace.hIconBrushHot )
+ else
+ SetBkColor( memDC, ghFindReplace.BackColor )
+ SetTextColor( memDC, ghFindReplace.ForeColor )
+ SelectObject( memDC, ghFindReplace.hBackBrush )
+ end if
+ rc = gFind.rcReplaceAll
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszReplaceAll, -1, cast(lpRect, @rc), wsStyle )
+
+ BitBlt( hDC, 0, 0, nWidth, nHeight, memDC, 0, 0, SRCCOPY )
+
+ ' Cleanup
+ if hPen then DeleteObject( hPen )
+ if hbit then DeleteObject( SelectObject(memDC, hbit) )
+ if memDC then DeleteDC( memDC )
+ RestoreDC( hDC, -1 )
+
+ EndPaint( hWnd, @ps )
+
+ function = true
+end function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmFindReplace
+' ========================================================================================
+function frmFindReplace_OnClose( byval HWnd as HWnd ) as LRESULT
+ DestroyWindow HWnd
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmFindReplace
+' ========================================================================================
+function frmFindReplace_OnDestroy( byval HWnd as HWnd ) as LRESULT
+
+ ' Remove selected attributes (Attribute #8). We need to remove it from all
+ ' open documents because the user may have tabbed between documents while
+ ' the FindReplace dialog was active thereby causing selection highlights.
+ gApp.RemoveAllSelectionAttributes
+
+ ' Destroy the "shadow" form
+ DestroyWindow( HWND_FRMFINDREPLACE_SHADOW )
+
+ ' Remove any markers set in the document that highlights
+ ' entire lines (used for Selected text searching).
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ pDoc->RemoveMarkerHighlight
+ SetFocusScintilla
+ end if
+
+ HWND_FRMFINDREPLACE = 0
+
+ ' delete the pWindow because it gets recreated everytime frmFindReplace is invoked
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND)
+ if pWindow then delete pWindow
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmFindReplaceShadow_WndProc Window procedure
+' ========================================================================================
+function frmFindReplaceShadow_WndProc( _
+ byval HWnd as HWnd, _
+ byval uMsg as UINT, _
+ byval wParam as WPARAM, _
+ byval lParam as LPARAM _
+ ) as LRESULT
+
+ select case uMsg
+ case WM_DESTROY
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWnd)
+ if pWindow = 0 then delete pWindow
+ HWND_FRMFINDREPLACE_SHADOW = 0
+ end select
+
+ ' for messages that we don't deal with
+ function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+end function
+
+
+' ========================================================================================
+' frmFindReplace Window procedure
+' ========================================================================================
+function frmFindReplace_WndProc( _
+ byval HWnd as HWnd, _
+ byval uMsg as UINT, _
+ byval wParam as WPARAM, _
+ byval lParam as LPARAM _
+ ) as LRESULT
+
+ static hTooltip as HWND
+
+ select case uMsg
+ HANDLE_MSG (HWnd, WM_CLOSE, frmFindReplace_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmFindReplace_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmFindReplace_OnCommand)
+ HANDLE_MSG (HWnd, WM_PAINT, frmFindReplace_OnPaint)
+
+ case WM_ACTIVATE
+ AfxRedrawWindow( HWnd )
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_MOUSEMOVE
+ dim tme as TrackMouseEvent
+ tme.cbSize = sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER or TME_LEAVE
+ tme.hwndTrack = HWnd
+ tme.dwHoverTime = 400 ' system default is 400ms
+ TrackMouseEvent(@tme)
+
+ if IsWindow(hTooltip) = 0 then hTooltip = AfxAddTooltip( HWnd, "", false, false )
+ AfxRedrawWindow(HWnd)
+
+
+ case WM_MOUSELEAVE
+ AfxDeleteTooltip( hTooltip, HWnd )
+ hTooltip = 0
+ AfxRedrawWindow( HWnd )
+
+
+ case WM_MOUSEHOVER
+ dim as CWSTR wszTooltip = ""
+ if isMouseOverRECT( HWnd, gFind.rcExpand ) then
+ wszTooltip = L(270, "Toggle Replace mode")
+ elseif isMouseOverRECT( HWnd, gFind.rcMatchCase ) then
+ wszTooltip = L(163,"Match Case")
+ elseif isMouseOverRECT( HWnd, gFind.rcWholeWord ) then
+ wszTooltip = L(162,"Match Whole Words")
+ elseif isMouseOverRECT( HWnd, gFind.rcUpArrow ) then
+ wszTooltip = L(45,"Find Previous") & " (Shift+F3)"
+ elseif isMouseOverRECT( HWnd, gFind.rcDownArrow ) then
+ wszTooltip = L(44,"Find next") & " (F3)"
+ elseif isMouseOverRECT( HWnd, gFind.rcSelection ) then
+ wszTooltip = L(148,"Selection")
+ elseif isMouseOverRECT( HWnd, gFind.rcPreserve ) then
+ wszTooltip = L(424,"Preserve Case")
+ elseif isMouseOverRECT( HWnd, gFind.rcReplace ) then
+ wszTooltip = L(173,"Replace") & " (Enter)"
+ elseif isMouseOverRECT( HWnd, gFind.rcReplaceAll ) then
+ wszTooltip = L(174,"Replace All") & " (Ctrl+Alt+Enter)"
+ elseif isMouseOverRECT( HWnd, gFind.rcClose ) then
+ wszTooltip = L(161,"Close") & " (Esc)"
+ end if
+
+ ' Display the tooltip
+ if len(wszTooltip) then AfxSetTooltipText( hTooltip, HWnd, wszTooltip )
+ AfxRedrawWindow( HWnd )
+
+
+ case WM_RBUTTONDOWN
+
+ case WM_LBUTTONDOWN
+
+ case WM_LBUTTONUP
+ dim as hwnd hEdit
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then hEdit = pDoc->hWndActiveScintilla
+
+ if isMouseOverRECT( HWnd, gFind.rcExpand ) then
+ gFind.bExpanded = not gFind.bExpanded
+ frmFindReplace_Show( HWnd, gFind.bExpanded )
+
+ elseif isMouseOverRECT( HWnd, gFind.rcMatchCase ) then
+ gFind.nMatchCase = not gFind.nMatchCase
+ frmFindReplace_HighlightSearches( true )
+ AfxRedrawWindow(HWnd)
+
+ elseif isMouseOverRECT( HWnd, gFind.rcWholeWord ) then
+ gFind.nWholeWord = not gFind.nWholeWord
+ frmFindReplace_HighlightSearches( true )
+ AfxRedrawWindow(HWnd)
+
+ elseif isMouseOverRECT( HWnd, gFind.rcUpArrow ) then
+ PostMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(IDM_FINDPREV, 0), 0 )
+
+ elseif isMouseOverRECT( HWnd, gFind.rcDownArrow ) then
+ PostMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(IDM_FINDnext, 0), 0 )
+
+ elseif isMouseOverRECT( HWnd, gFind.rcSelection ) then
+ if pDoc = 0 then exit function
+ if (pDoc->IsMultilineSelection) or (pDoc->HasMarkerHighlight) then
+ gFind.nSelection = not gFind.nSelection
+ else
+ gFind.nSelection = false
+ end if
+ if gFind.nSelection then
+ pDoc->SetMarkerHighlight
+ else
+ pDoc->RemoveMarkerHighlight
+ end if
+ frmFindReplace_HighlightSearches( true )
+ AfxRedrawWindow(HWnd)
+
+ elseif isMouseOverRECT( HWnd, gFind.rcPreserve ) then
+ if pDoc = 0 then exit function
+ gFind.nPreserve = not gFind.nPreserve
+
+ elseif isMouseOverRECT( HWnd, gFind.rcReplace ) then
+ if pDoc = 0 then exit function
+ PostMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(IDM_REPLACEnext, 0), 0 )
+
+ elseif isMouseOverRECT( HWnd, gFind.rcReplaceAll ) then
+ if pDoc = 0 then exit function
+ PostMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(IDM_REPLACEALL, 0), 0 )
+
+ elseif isMouseOverRECT( HWnd, gFind.rcClose ) then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ end if
+
+ End Select
+
+ function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+end function
+
+
+' ========================================================================================
+' frmFindReplace_RichEdit_SubclassProc Window procedure
+' ========================================================================================
+Function frmFindReplace_RichEdit_SubclassProc ( _
+ byval hWin as HWnd, _ ' // Control window handle
+ byval uMsg as UINT, _ ' // Type of message
+ byval _wParam as WPARAM, _ ' // First message parameter
+ byval _lParam as LPARAM, _ ' // Second message parameter
+ byval uIdSubclass as UINT_PTR, _ ' // The subclass ID
+ byval dwRefData as DWORD_PTR _ ' // Pointer to reference data
+ ) as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(hWin)
+
+ select case uMsg
+
+ case WM_PRINTCLIENT, WM_PAINT
+ dim as long textLength = AfxGetWindowTextLength(hWin)
+ if (textLength = 0 ) then
+ ' Get the needed DC with DCX_INTERSECTUPDATE before the EDIT
+ ' control's WM_PAINT handler calls BeginPaint/EndPaint, which
+ ' validates the update rect and would otherwise lead to drawing
+ ' nothing later because the region is empty. Also, grab it from
+ ' the cache so we don't mess with the EDIT's DC.
+ dim as HDC hdc = iif(uMsg = WM_PRINTCLIENT, cast(HDC, _wParam), _
+ GetDCEx(hWin, 0, DCX_INTERSECTUPDATE or DCX_CACHE or DCX_CLIPCHILDREN or DCX_CLIPSIBLINGS) )
+
+ ' Call the EDIT control so that the caret is properly handled,
+ ' no caret litter left on the screen after tabbing away.
+ dim as LRESULT result = DefSubclassProc(hWin, uMsg, _wParam, _lParam)
+
+ ' Get the font and margin so the cue banner text has a
+ ' consistent appearance and placement with existing text.
+ dim as HFONT font = ghStatusBar.hFontStatusBar
+ dim as Rect editRect: SendMessage( hWin, EM_GETRECT, 0, cast(LPARAM, @editRect) )
+
+ ' Ideally we would call Edit_GetCueBannerText, but since that message
+ ' returns nothing when ES_MULTILINE, use a window property instead.
+ dim cueBannerText as wstring * 250
+ if hWin = GetDlgItem( HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND ) then
+ cueBannerText = L(158,"Find")
+ elseif hWin = GetDlgItem( HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE ) then
+ cueBannerText = L(173,"Replace")
+ end if
+
+ dim as HFONT previousFont = SelectFont(hdc, font)
+ SetTextColor( hDC, ghFindReplace.CueBannerForeColor )
+ SetBkMode(hdc, TRANSPARENT)
+ dim as long wsStyle = DT_TOP or DT_LEFT or DT_NOPREFIX or DT_NOCLIP
+ DrawText(hdc, cueBannerText, -1, @editRect, wsStyle)
+ SelectFont(hdc, previousFont)
+
+ RestoreDC( hDC, -1 )
+ ReleaseDC(hWin, hdc)
+
+ ' Return the EDIT's result (could probably safely just return zero here,
+ ' but seems safer to relay whatever value came from the edit).
+ return result
+ end if
+
+ case WM_CONTEXTMENU
+ ' Create the right click popup menu
+ dim as CWSTR wszText = RichEdit_GetSelText( hWin )
+ Dim hPopUpMenu As HMENU = CreatePopupMenu()
+ if len(wszText) then
+ AppendMenu( hPopUpMenu, MF_ENABLED, IDM_CUT, wstr("Cut") )
+ AppendMenu( hPopUpMenu, MF_ENABLED, IDM_COPY, wstr("Copy") )
+ end if
+ if RichEdit_CanPaste( hWin, 0 ) then
+ if len(wszText) then
+ AppendMenu( hPopUpMenu, MF_SEPARATOR, 0, "" )
+ end if
+ AppendMenu( hPopUpMenu, MF_ENABLED, IDM_PASTE, wstr("Paste") )
+ end if
+
+ dim as long nResult
+ nResult = TrackPopupMenu( hPopUpMenu, TPM_RETURNCMD or TPM_NONOTIFY, _
+ loword(_lParam), hiword(_lParam), 0, HWND_FRMFINDREPLACE, 0 )
+ select case nResult
+ case IDM_CUT: SendMessage( hWin, WM_CUT, 0, 0 )
+ case IDM_COPY: SendMessage( hWin, WM_COPY, 0, 0 )
+ case IDM_PASTE: SendMessage( hWin, WM_PASTE, 0, 0 )
+ end select
+ DestroyMenu hPopUpMenu
+ return 0
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hWin, @frmFindReplace_RichEdit_SubclassProc, uIdSubclass )
+ End Select
+
+ ' For messages that we don't deal with
+ function = DefSubclassProc(hWin, uMsg, _wParam, _lParam)
+
+end function
+
+
+' ========================================================================================
+' frmFindReplace_Show
+' ========================================================================================
+function frmFindReplace_Show( _
+ byval hWndParent as HWnd, _
+ byval fShowReplace as BOOLEAN _
+ ) as LRESULT
+
+ ' Create the main window and child controls
+ dim pWindow as CWindow ptr = new CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc = 0 then exit function
+
+ dim as HWND hCtl
+ dim as String sFindText
+ dim as HWND hCtlFind, hCtlReplace
+
+ gFind.bExpanded = fShowReplace
+
+ if IsWindow( HWND_FRMFINDREPLACE ) = 0 then
+ gFind.nMatchCase = false
+ gFind.nWholeWord = false
+ gFind.nSelection = false
+
+ HWND_FRMFINDREPLACE = _
+ pWindow->Create(hWndParent, "FINDREPLACE", @frmFindReplace_WndProc, 0, 0, 0, 0, _
+ WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
+ WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR )
+ pWindow->SetClientSize( 420, iif(gFind.bExpanded, 66, 33) )
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ ' we use RichEdit controls because regular Edit controls can not easily have
+ ' their text vertically centered.
+ dim as RECT rc
+ dim cf as CHARFORMATW
+ cf.cbSize = sizeof(cf)
+ cf.dwMask = CFM_COLOR
+ cf.crTextColor = ghFindReplace.TextBoxForeColor
+
+ hCtlFind = pWindow->AddControl("RICHEDIT", , IDC_FRMFINDREPLACE_TXTFIND, "", _
+ 0, 0, 166, 24, _
+ WS_CHILD or WS_VISIBLE or WS_TABSTOP or ES_LEFT or ES_AUTOHSCROLL, _
+ WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR, _
+ 0, @frmFindReplace_RichEdit_SubclassProc, IDC_FRMFINDREPLACE_TXTFIND, null )
+
+ AfxSetWindowFont( hCtlFind, ghStatusBar.hFontStatusBar )
+ SendMessage( hCtlFind, EM_SETCHARFORMAT, SCF_ALL, cast(LPARAM, @cf) )
+ SendMessage( hCtlFind, EM_SETBKGNDCOLOR , 0, cast(LPARAM, ghFindReplace.TextBoxBackColor) )
+ GetClientRect( hCtlFind, @rc )
+ rc.top = rc.top + pWindow->ScaleY(2): rc.left = rc.left + pWindow->ScaleX(4)
+ SendMessage( hCtlFind, EM_SETRECT, 0, cast(LPARAM, @rc) )
+ SendMessage( hCtlFind, EM_SETEVENTMASK, 0, cast(LPARAM, ENM_SELCHANGE or ENM_CHANGE) )
+
+ hCtlReplace = pWindow->AddControl("RICHEDIT", , IDC_FRMFINDREPLACE_TXTREPLACE, wstr(gFind.txtReplace), _
+ 0, 0, 190, 24, _
+ WS_CHILD or WS_VISIBLE or WS_TABSTOP or ES_LEFT or ES_AUTOHSCROLL, _
+ WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR, _
+ 0, @frmFindReplace_RichEdit_SubclassProc, IDC_FRMFINDREPLACE_TXTREPLACE, null )
+ AfxSetWindowFont( hCtlReplace, ghStatusBar.hFontStatusBar )
+ SendMessage( hCtlReplace, EM_SETCHARFORMAT, SCF_ALL, cast(LPARAM, @cf) )
+ SendMessage( hCtlReplace, EM_SETBKGNDCOLOR , 0, cast(LPARAM, ghFindReplace.TextBoxBackColor) )
+ GetClientRect( hCtlReplace, @rc )
+ rc.top = rc.top + pWindow->ScaleY(2): rc.left = rc.left + pWindow->ScaleX(4)
+ SendMessage( hCtlReplace, EM_SETRECT, 0, cast(LPARAM, @rc) )
+ SendMessage( hCtlReplace, EM_SETEVENTMASK, 0, cast(LPARAM, ENM_SELCHANGE or ENM_CHANGE) )
+
+ ' create semi-transparent window slightly offset under our popup menu in order to simulate a shadow.
+ if gApp.isWineActive = false then
+ pWindow = New CWindow
+ pWindow->DPI = AfxCWindowPtr(HWND_FRMMAIN)->DPI
+ HWND_FRMFINDREPLACE_SHADOW = pWindow->Create( HWND_FRMMAIN, "", _
+ @frmFindReplaceShadow_WndProc, 0, 0, 0, 0, _
+ WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, WS_EX_LAYERED )
+ pWindow->ClassStyle = CS_DBLCLKS
+ pWindow->Brush = GetSysColorBrush(COLOR_WINDOWTEXT + 1) ' black background
+ SetLayeredWindowAttributes( HWND_FRMFINDREPLACE_SHADOW, GetSysColor(COLOR_WINDOWTEXT + 1) , 80, LWA_ALPHA )
+ end if
+ end if
+
+ ' Fills the search box with the selected word.
+ ' if there are carriage returns or/and line feeds, this mean that
+ ' there is a block selected.
+
+ frmFindReplace_PositionWindows
+ sFindText = pDoc->GetSelText
+ if pDoc->IsMultilineSelection = false then
+ hCtl = GetDlgItem( HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND )
+ AfxSetWindowText( hCtl, sFindText )
+ gFind.txtFind = sFindtext
+ else
+ gFind.nSelection = true
+ pDoc->SetMarkerHighlight
+ end if
+
+ if gFind.bExpanded then
+ hCtl = GetDlgItem( HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE )
+ else
+ hCtl = GetDlgItem( HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND )
+ end if
+
+ frmFindReplace_HighlightSearches( true )
+ if len(AfxGetWindowText(hCtl)) then Edit_SetSel(hCtl, 0, -1)
+
+ SetFocus hCtl
+ AfxRedrawWindow(HWND_FRMFINDREPLACE)
+
+ function = 0
+end function
+
diff --git a/src/frmFunctions.bi b/src/frmFunctions.bi
index 12e18a47..445ef2fd 100644
--- a/src/frmFunctions.bi
+++ b/src/frmFunctions.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmFunctions.bi.bak b/src/frmFunctions.bi.bak
new file mode 100644
index 00000000..12e18a47
--- /dev/null
+++ b/src/frmFunctions.bi.bak
@@ -0,0 +1,39 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+#define IDC_FRMFUNCTIONS_LISTBOX 1000
+
+type FUNCTION_NODE_TYPE
+ wszFunctionName as CWSTR
+ wszPrototype as CWSTR ' the sub/function parameters
+ nLineNumber as long
+end type
+
+enum FunctionsDisplayState
+ ViewAsTree = 0
+ ViewAsList
+end enum
+
+dim shared gFunctionsDisplay as FunctionsDisplayState = FunctionsDisplayState.ViewAsTree
+
+declare function frmFunctions_Show( byval hWndParent as HWnd ) as LRESULT
+declare function frmFunctions_ReparseFiles() as Long
+declare function frmFunctions_SelectItemData( byval pDoc as clsDocument ptr ) as boolean
+declare function LoadFunctionsFiles() as long
+declare function frmFunctions_ViewAsTree() as long
+declare function frmFunctions_ViewAsList() as long
+declare function QuickSortpDocs( pDocs() As clsDocument ptr, lo as long, hi as long ) as long
+
diff --git a/src/frmFunctions.inc b/src/frmFunctions.inc
index 15629e53..902e8feb 100644
--- a/src/frmFunctions.inc
+++ b/src/frmFunctions.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmFunctions.inc.bak b/src/frmFunctions.inc.bak
new file mode 100644
index 00000000..15629e53
--- /dev/null
+++ b/src/frmFunctions.inc.bak
@@ -0,0 +1,846 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+''
+'' frmFunctions.inc
+''
+
+#include once "frmFunctions.bi"
+#include once "clsDB2.bi"
+
+' ========================================================================================
+' Reparse any dirty files
+' ========================================================================================
+function frmFunctions_ReparseFiles() as Long
+ ' Need to re-parse any dirty files. This is especially important for QuickRun scenarios
+ ' where the file is never physically saved.
+ Dim pDoc As clsDocument Ptr = gApp.pDocList
+ do until pDoc = 0
+ If cbool(SciExec( pDoc->hWindow(0), SCI_GETMODIFY, 0, 0 )) or pDoc->UserModified Then
+ pDoc->bNeedsParsing = true
+ pDoc->ParseDocument()
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+ function = 0
+end function
+
+' ========================================================================================
+' Get the Functions line number from the Listbox line
+' ========================================================================================
+function getFunctionsLineNumber( byval wszCaption as CWSTR ) as long
+ ' do not use Parse for this because line may contain embedded % in description
+ ' lineNum%functionName%prototype
+ dim as long nLineNum
+ dim as long f1
+ f1 = instr(wszCaption, "%")
+ if f1 then nLineNum = val(left(wszCaption, f1-1))
+ function = nLineNum
+end function
+
+' ========================================================================================
+' Get the Functions function name from the Listbox line
+' ========================================================================================
+function getFunctionsFunctionName( byval wszCaption as CWSTR ) as CWSTR
+ ' do not use Parse for this because line may contain embedded % in description
+ ' lineNum%functionName%prototype
+ dim as CWSTR wszTemp
+ dim as long f1
+ f1 = instr(wszCaption, "%")
+ if f1 then wszTemp = mid(wszCaption, f1 + 1)
+ f1 = instr(wszTemp, "%")
+ if f1 then wszTemp = left(wszTemp, f1 - 1)
+ function = wszTemp
+end function
+
+' ========================================================================================
+' Get the Functions prototype from the Listbox line
+' ========================================================================================
+function getFunctionsPrototype( byval wszCaption as CWSTR ) as CWSTR
+ ' do not use Parse for this because line may contain embedded % in description
+ ' lineNum%functionName%prototype
+ dim as CWSTR wszTemp
+ dim as long f1
+ f1 = instr(wszCaption, "%")
+ if f1 then wszTemp = mid(wszCaption, f1 + 1)
+ f1 = instr(wszTemp, "%")
+ if f1 then wszTemp = mid(wszTemp, f1 + 1)
+ function = wszTemp
+end function
+
+' ========================================================================================
+' Expand/Collapse all Functions Nodes
+' ========================================================================================
+function frmFunctions_ExpandAll() as long
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ pDoc->bFunctionsExpanded = true
+ pDoc = pDoc->pDocNext
+ loop
+ LoadFunctionsFiles()
+ function = 0
+end function
+
+function frmFunctions_CollapseAll() as long
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ pDoc->bFunctionsExpanded = false
+ pDoc = pDoc->pDocNext
+ loop
+ LoadFunctionsFiles()
+ function = 0
+end function
+
+' ========================================================================================
+' Select the listbox item that matches the incoming pDoc item. Do not open nodes to
+' find a possible hidden document because the user may have purposely closed a node
+' and we should not re-open it automatically.
+' ========================================================================================
+function frmFunctions_SelectItemData( byval pDoc as clsDocument ptr ) as boolean
+ ' Select the Function List listbox item where the ItemData holds the pDoc handle.
+ for i as long = 0 to ListBox_GetCount( HWND_FRMFUNCTIONS_LISTBOX ) - 1
+ if ListBox_GetItemData(HWND_FRMFUNCTIONS_LISTBOX, i) = pDoc then
+ ListBox_SetCurSel( HWND_FRMFUNCTIONS_LISTBOX, i )
+ if ListBox_GetTopIndex( HWND_FRMFUNCTIONS_LISTBOX ) <> i then
+ ListBox_SetTopIndex( HWND_FRMFUNCTIONS_LISTBOX, i )
+ end if
+ AfxRedrawWindow( HWND_FRMFUNCTIONS_LISTBOX )
+ return true
+ end if
+ next
+ return false
+end function
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+function frmFunctions_PositionWindows() as LRESULT
+
+ ' Get the entire client area
+ dim as Rect rc
+ GetClientRect( HWND_FRMFUNCTIONS, @rc )
+
+ SetWindowPos( HWND_FRMFUNCTIONS_LISTBOX, 0, _
+ rc.left, rc.top, rc.right-rc.left, rc.bottom-rc.top, _
+ SWP_NOZORDER )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmFunctions
+' ========================================================================================
+function frmFunctions_OnSize( _
+ byval HWnd as HWnd, _
+ byval state as UINT, _
+ byval cx as long, _
+ byval cy as long _
+ ) as LRESULT
+ if state <> SIZE_MINIMIZED then
+ ' Position all of the child windows
+ frmFunctions_PositionWindows
+ end if
+ function = 0
+end function
+
+' ========================================================================================
+' Process WM_PAINT message for window/dialog: frmFunctions
+' ========================================================================================
+function frmFunctions_OnPaint( byval HWnd as HWnd ) as LRESULT
+
+ dim as PAINTSTRUCT ps
+ dim as HDC hDc
+
+ hDC = BeginPaint(hWnd, @ps)
+
+ SaveDC( hDC )
+ FillRect( hDC, @ps.rcPaint, ghPanel.hPanelBrush )
+ RestoreDC( hDC, -1 )
+ EndPaint( hWnd, @ps )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_MEASUREITEM message for window/dialog: frmFunctions
+' ========================================================================================
+function frmFunctions_OnMeasureItem( _
+ byval HWnd as HWnd, _
+ byval lpmis as MEASUREITEMSTRUCT ptr _
+ ) as long
+ ' Set the height of the list box items.
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWnd)
+ lpmis->itemHeight = pWindow->ScaleY(EXPLORERITEM_HEIGHT)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_DRAWITEM message for window/dialog: frmFunctions
+' ========================================================================================
+function frmFunctions_OnDrawItem( _
+ byval HWnd as HWnd, _
+ byval lpdis as const DRAWITEMSTRUCT ptr _
+ ) as long
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ if pWindow = 0 then exit function
+
+ if lpdis = 0 then exit function
+
+ if ( lpdis->itemAction = ODA_DRAWENTIRE ) orelse _
+ ( lpdis->itemAction = ODA_SELECT ) orelse _
+ ( lpdis->itemAction = ODA_FOCUS ) then
+
+ dim as RECT rc = lpdis->rcItem
+ dim as long nWidth = rc.right-rc.left
+ dim as long nHeight = rc.bottom-rc.top
+
+ SaveDC(lpdis->hDC)
+
+ dim memDC as HDC ' Double buffering
+ dim hbit as HBITMAP ' Double buffering
+
+ memDC = CreateCompatibleDC( lpdis->hDC )
+ hbit = CreateCompatibleBitmap( lpdis->hDC, nWidth, nHeight )
+ if hbit then hbit = SelectObject( memDC, hbit )
+
+ SelectObject( memDC, ghMenuBar.hFontMenuBar )
+
+ ' Default to using normal
+ dim as HBRUSH hBrush = ghPanel.hBackBrush
+ dim as COLORREF foreclr = ghPanel.ForeColor
+ dim as COLORREF backclr = ghPanel.BackColor
+
+ dim as boolean IsHot = false
+ dim as boolean isNodeHeader = false
+ dim as boolean isIconDown = false
+
+ dim as POINT pt
+ GetCursorPos( @pt )
+ MapWindowPoints( lpdis->hwndItem, HWND_DESKTOP, cast( POINT ptr, @rc ), 2 )
+ if PtInRect( @rc, pt ) then IsHot = true
+
+ ' if mouse is over VScrollBar then reset hot
+ if isMouseOverWindow( HWND_FRMPANEL_VSCROLLBAR ) then IsHot = false
+
+ if ListBox_GetCurSel(lpdis->hwndItem) = lpdis->itemID then IsHot = true
+
+ hBrush = iif( IsHot, ghPanel.hBackBrushHot, ghPanel.hBackBrush)
+ backclr = iif( IsHot, ghPanel.BackColorHot, ghPanel.BackColor)
+ foreclr = iif( IsHot, ghPanel.ForeColorHot, ghPanel.ForeColor)
+
+ dim as CWSTR wszCaption = AfxGetListBoxText(lpdis->hwndItem, lpdis->ItemID)
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, lpdis->itemData)
+
+ ' if this is a "node" header
+ if left(wszCaption, 4) = "true" then
+ isNodeHeader = true
+ isIconDown = true
+ if pDoc then wszCaption = AfxStrPathName( "NAMEX", pDoc->DiskFilename )
+ elseif left(wszCaption, 5) = "false" then
+ isNodeHeader = true
+ isIconDown = false
+ if pDoc then wszCaption = AfxStrPathName( "NAMEX", pDoc->DiskFilename )
+ else
+ ' must be a function line
+ wszCaption = getFunctionsFunctionName( wszCaption )
+ end if
+
+ ' Paint the entire background
+ ' Create our rect that works with the entire line
+ SetRect( @rc, 0, 0, nWidth, nHeight )
+ FillRect( memDC, @rc, hBrush )
+
+ SetBkColor( memDC, backclr )
+ SetTextColor( memDC, foreclr )
+
+ dim as RECT rcText = rc
+ dim as RECT rcBitmap = rc
+
+ dim as long wsStyle
+
+ ' indent the text based on its type
+ if isNodeHeader then
+ rcBitmap.right = rcBitmap.left + pWindow->ScaleX(20)
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_TOP or DT_SINGLELINE
+' if isIconDown then
+' DrawText( memDC, wszChevronDown, -1, cast(lpRect, @rcBitmap), wsStyle )
+' else
+' DrawText( memDC, wszChevronRight, -1, cast(lpRect, @rcBitmap), wsStyle )
+' end if
+ DrawText( memDC, wszDocumentIcon, -1, cast(lpRect, @rcBitmap), wsStyle )
+ wszCaption = wszCaption
+ rcText.left = rcBitmap.right
+ SelectObject( memDC, ghMenuBar.hFontMenuBar )
+ wsStyle = DT_NOPREFIX or DT_LEFT or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszCaption.sptr, -1, cast(lpRect, @rcText), wsStyle )
+ else
+ ' This would be a function name.
+ if gFunctionsDisplay = FunctionsDisplayState.ViewAsTree then
+ rcBitmap.left = rcText.left + pWindow->ScaleX(20)
+ end if
+ rcBitmap.right = rcBitmap.left + pWindow->ScaleX(20)
+
+ SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_CENTER or DT_TOP or DT_SINGLELINE
+ DrawText( memDC, wszDocumentIcon, -1, cast(lpRect, @rcBitmap), wsStyle )
+
+ rcText.left = rcBitmap.right
+ SelectObject( memDC, ghMenuBar.hFontMenuBar )
+ wsStyle = DT_NOPREFIX or DT_LEFT or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszCaption.sptr, -1, cast(lpRect, @rcText), wsStyle )
+ end if
+
+ BitBlt( lpdis->hDC, lpdis->rcItem.left, lpdis->rcItem.top, _
+ nWidth, nHeight, memDC, 0, 0, SRCCOPY )
+
+ ' Cleanup
+ if hbit then DeleteObject SelectObject(memDC, hbit)
+ if memDC then DeleteDC memDC
+ RestoreDC(lpdis->hDC, -1)
+ end if
+
+ function = true
+
+end function
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmFunctions
+' ========================================================================================
+function frmFunctions_OnCommand( _
+ byval HWnd as HWnd, _
+ byval id as long, _
+ byval hwndCtl as HWnd, _
+ byval codeNotify as UINT _
+ ) as LRESULT
+
+ select case codeNotify
+ case LBN_SELCHANGE
+ ' update the highlighting of the current line
+ AfxRedrawWindow(hwndCtl)
+ ' update the scrollbar position if necessary
+ frmFunctions_PositionWindows()
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmFunctions Window procedure
+' ========================================================================================
+function frmFunctions_WndProc( _
+ byval HWnd as HWnd, _
+ byval uMsg as UINT, _
+ byval wParam as WPARAM, _
+ byval lParam as LPARAM _
+ ) as LRESULT
+
+ static hTooltip as HWND
+
+ select case uMsg
+ HANDLE_MSG (HWnd, WM_SIZE, frmFunctions_OnSize)
+ HANDLE_MSG (HWnd, WM_PAINT, frmFunctions_OnPaint)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmFunctions_OnCommand)
+ HANDLE_MSG (HWnd, WM_MEASUREITEM, frmFunctions_OnMeasureItem)
+ HANDLE_MSG (HWnd, WM_DRAWITEM, frmFunctions_OnDrawItem)
+
+ case WM_ERASEBKGND
+ return true
+
+ end select
+
+ ' for messages that we don't deal with
+ function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+end function
+
+' ========================================================================================
+' frmFunctionsListBox_SubclassProc
+' ========================================================================================
+function frmFunctionsListBox_SubclassProc ( _
+ byval hWin as HWnd, _ ' // Control window handle
+ byval uMsg as UINT, _ ' // Type of message
+ byval _wParam as WPARAM, _ ' // First message parameter
+ byval _lParam as LPARAM, _ ' // Second message parameter
+ byval uIdSubclass as UINT_PTR, _ ' // The subclass ID
+ byval dwRefData as DWORD_PTR _ ' // Pointer to reference data
+ ) as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMFUNCTIONS)
+ static as long accumDelta
+ static as HWND hTooltip
+
+ ' keep track of last index we were over so that we only issue a
+ ' repaint if the cursor has moved off of the line
+ static as long nLastIdx = -1
+
+ select case uMsg
+ case MSG_USER_LOAD_FUNCTIONSFILES
+ LoadFunctionsFiles()
+
+ Case WM_MOUSEWHEEL
+ ' accumulate delta until scroll one line (up +120, down -120).
+ ' 120 is the Microsoft default delta
+ dim as long zDelta = GET_WHEEL_DELTA_WPARAM( _wParam )
+ dim as long nTopIndex = SendMessage( hWin, LB_GETTOPINDEX, 0, 0 )
+ accumDelta = accumDelta + zDelta
+ if accumDelta >= 120 then ' scroll up 3 lines
+ nTopIndex = nTopIndex - 3
+ nTopIndex = max( 0, nTopIndex )
+ SendMessage( hWin, LB_SETTOPINDEX, nTopIndex, 0 )
+ accumDelta = 0
+ frmPanelVScroll_PositionWindows( SW_SHOWNA )
+ elseif accumDelta <= -120 then ' scroll down 3 lines
+ nTopIndex = nTopIndex + 3
+ SendMessage( hWin, LB_SETTOPINDEX, nTopIndex, 0 )
+ accumDelta = 0
+ frmPanelVScroll_PositionWindows( SW_SHOWNA )
+ end if
+
+ Case WM_MOUSEMOVE
+ ' Track that we are over the control in order to catch the
+ ' eventual WM_MOUSEHOVER and WM_MOUSELEAVE events
+ dim tme as TrackMouseEvent
+ tme.cbSize = sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER or TME_LEAVE
+ tme.hwndTrack = hWin
+ tme.dwHoverTime = 1
+ TrackMouseEvent(@tme)
+
+ ' get the item rect that the mouse is over and only invalidate
+ ' that instead of the entire listbox
+ dim as RECT rc
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ if idx <> nLastIdx then
+ ListBox_GetItemRect( hWin, idx, @rc )
+ InvalidateRect( hWin, @rc, true )
+ ListBox_GetItemRect( hWin, nLastIdx, @rc )
+ InvalidateRect( hWin, @rc, true )
+ nLastIdx = idx
+ end if
+ end if
+
+ case WM_MOUSEHOVER
+ dim as CWSTR wszTooltip
+ if IsWindow(hTooltip) = 0 then hTooltip = AfxAddTooltip( hWin, "", false, false )
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ static wszPrevTooltip as CWSTR
+ wszTooltip = ""
+ dim as CWSTR wszCaption = AfxGetListBoxText( hWin, idx )
+ if (left(wszCaption, 4) = "true") orelse (left(wszCaption, 5) = "false") then
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, ListBox_GetItemData( hWin, idx ))
+ if pDoc then wszTooltip = pDoc->DiskFilename
+ else
+ ' Get the function prototype and display it in popup multiline tooltip
+ wszTooltip = getFunctionsPrototype(wszCaption)
+ if len(wszTooltip) then
+ SendMessage( hTooltip, TTM_SETMAXTIPWIDTH, 0, 300 )
+ wszTooltip = FormatCodetip( wszTooltip )
+ end if
+ end if
+ ' Display the tooltip
+ if wszPrevTooltip <> wszTooltip then
+ AfxSetTooltipText( hTooltip, hWin, wszTooltip )
+ wszPrevTooltip = wszTooltip
+ AfxRedrawWindow( hWin )
+ end if
+ end if
+
+ case WM_MOUSELEAVE
+ nLastIdx = -1
+ AfxRedrawWindow(hWin)
+
+ case WM_LBUTTONUP
+ ' determine if we clicked on a function name or a node header
+ dim as RECT rc
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ ' The return value contains the index of the nearest item in the LOWORD. The HIWORD is zero
+ ' if the specified point is in the client area of the list box, or one if it is outside the
+ ' client area.
+ if hiword(idx) <> 1 then
+ dim as clsDocument ptr pDoc = cast(clsDocument ptr, ListBox_GetItemData( hWin, idx ))
+ dim as CWSTR wszCaption = AfxGetListBoxText( hWin, idx )
+ if (left(wszCaption, 4) = "true") orelse (left(wszCaption, 5) = "false") then
+ OpenSelectedDocument( pDoc->DiskFilename, "", -1 )
+ else
+ ' Attempt to show the function name
+ dim as long nLineNum = getFunctionsLinenumber( wszCaption )
+ dim as CWSTR wszFunctionName = getFunctionsFunctionName( wszCaption )
+ dim as CWSTR wszDiskFilename
+ if pDoc then wszDiskFilename = pDoc->DiskFilename
+ OpenSelectedDocument( wszDiskFilename, wszFunctionName, nLineNum )
+ end if
+ end if
+
+ case WM_ERASEBKGND
+ ' if the number of lines in the listbox maybe less than the number per page then
+ ' calculate from last item to bottom of listbox, otherwise calculate based on
+ ' the mod of the lineheight to listbox height so we can color the partial line
+ ' that won't be displayed at the bottom of the list.
+ dim as RECT rc: GetClientRect( hWin, @rc )
+
+ dim as RECT rcItem
+ SendMessage( hWin, LB_GETITEMRECT, 0, cast(LPARAM, @rcItem) )
+ dim as long itemHeight = rcItem.bottom - rcItem.top
+ dim as long NumItems = ListBox_GetCount(hWin)
+ dim as long nTopIndex = SendMessage( hWin, LB_GETTOPINDEX, 0, 0 )
+ dim as long visible_rows = 0
+ dim as long ItemsPerPage = 0
+ dim as long bottom_index = 0
+
+ if NumItems > 0 then
+ ItemsPerPage = (rc.bottom - rc.top) / itemHeight
+ bottom_index = (nTopIndex + ItemsPerPage)
+ if bottom_index >= NumItems then bottom_index = NumItems - 1
+ visible_rows = (bottom_index - nTopIndex) + 1
+ rc.top = visible_rows * itemHeight
+ end if
+
+ if rc.top < rc.bottom then
+ dim as HDC _hDC = cast(HDC, _wParam)
+ FillRect( _hDC, @rc, ghPanel.hPanelBrush )
+ end if
+
+ ValidateRect( hWin, @rc )
+ return true
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hWin, @frmFunctionsListBox_SubclassProc, uIdSubclass )
+ end select
+
+ ' For messages that we don't deal with
+ function = DefSubclassProc( hWin, uMsg, _wParam, _lParam )
+
+end function
+
+
+' ========================================================================================
+' frmFunctions_Show
+' ========================================================================================
+function frmFunctions_Show( byval hWndParent as HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ dim pWindow as CWindow ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMFUNCTIONS = pWindow->Create( hWndParent, "Function List", @frmFunctions_WndProc, _
+ 0, 0, 0, 0, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT or WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR)
+
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ HWND_FRMFUNCTIONS_LISTBOX = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMFUNCTIONS_LISTBOX, "", 0, 0, 0, 0, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_TABSTOP or _
+ LBS_NOINTEGRALHEIGHT or LBS_OWNERDRAWFIXED or LBS_HASSTRINGS or LBS_NOTIFY, _
+ WS_EX_LEFT or WS_EX_RIGHTSCROLLBAR, , _
+ cast(SUBCLASSPROC, @frmFunctionsListBox_SubclassProc), _
+ IDC_FRMFUNCTIONS_LISTBOX, cast(DWORD_PTR, @pWindow))
+
+ function = 0
+
+end function
+
+
+' ========================================================================================
+' Simple QuickSort of Filename array
+' ========================================================================================
+function QuickSortpDocs( pDocs() As clsDocument ptr, lo as long, hi as long ) as long
+ dim as long i, j
+ dim as CWSTR pivot
+
+ if lo < hi then
+ i = lo : j = hi
+ pivot = ucase( pDocs( (lo+hi)/2 )->DiskFilename )
+ do
+ while ucase(pDocs(i)->DiskFilename) < pivot and i < hi: i += 1: wend
+ while ucase(pDocs(j)->DiskFilename) > Pivot and j > lo: j -= 1: wend
+ if i <= j then swap pDocs(i), pDocs(j): i += 1: j -= 1
+ loop while i <= j
+ if lo < j then QuickSortpDocs( pDocs(), lo, j )
+ if hi > i then QuickSortpDocs( pDocs(), i, hi )
+ end if
+
+ function = 0
+end function
+
+' ========================================================================================
+' Simple QuickSort of Function Name array
+' ========================================================================================
+function QuickSortFuncs( a() as FUNCTION_NODE_TYPE, lo as long, hi as long ) as long
+ dim as long i, j
+ dim as CWSTR pivot
+
+ if lo < hi then
+ i = lo : j = hi
+ pivot = ucase( a( (lo+hi)/2 ).wszFunctionName )
+ do
+ while ucase(a(i).wszFunctionName) < pivot and i < hi: i += 1: wend
+ while ucase(a(j).wszFunctionName) > Pivot and j > lo: j -= 1: wend
+ if i <= j then swap a(i), a(j): i += 1: j -= 1
+ loop while i <= j
+ if lo < j then QuickSortFuncs( a(), lo, j )
+ if hi > i then QuickSortFuncs( a(), i, hi )
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' LoadFilesAndFunctions
+' This will clear the current list of files in the listbox and repopulate it.
+' ========================================================================================
+function LoadFilesAndFunctions() as long
+ dim as HWND hList = GetDlgItem(HWND_FRMFUNCTIONS, IDC_FRMFUNCTIONS_LISTBOX)
+
+ ' Hide the listbox while it is loading so that we don't get the unpainted
+ ' white background from the empty listbox
+ ShowWindow( hList, SW_HIDE )
+
+ ' Save the topindex because we will restore it after filling the new contents
+ dim as long nTopIndex = SendMessage( hList, LB_GETTOPINDEX, 0, 0 )
+
+ ' Clear all content from the listbox
+ ListBox_ResetContent(hList)
+
+ dim wszText as wstring * MAX_PATH
+
+ dim pData as DB2_DATA ptr
+ dim as CWSTR wszNodeName
+
+ ' Filename node line format. The drawing routine will parse this string to determine
+ ' what glyph to display as well as the filename only portion of the diskfilename.
+ ' true ' expanded node
+ ' false ' collapsed node
+ ' Function node line format.
+ ' 231%FunctionName%prototype ' function starts at line 231 of the file
+
+ ' **** FEB 8, 2022. Change approach to NOT allow the Functions list to be expanded
+ ' or collapsed. This should lead to a better user experience because the now all
+ ' functions are always shown and available and the user can easily activate the base
+ ' filename by clicking on it. The user can also still always navigate between files
+ ' via the Explorer.
+ ' Leave the expand/collapse code in case it is decided later to revert this approach.
+
+ ' Iterate all pDoc in the project/files list. Create an array and then
+ ' sort it alphabetically.
+ dim as long ub, idx
+ redim pDocs(any) as clsDocument ptr
+
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ ub = ubound(pDocs) + 1
+ redim preserve pDocs(ub)
+ pDocs(ub) = pDoc
+ pDoc = pDoc->pDocNext
+ loop
+
+ QuickSortpDocs( pDocs(), lbound(pDocs), ubound(pDocs) )
+
+ ' Get the functions (and sort them) for each file
+ redim arrFuncs(any) as FUNCTION_NODE_TYPE
+
+ for i as long = lbound(pDocs) to ubound(pDocs)
+
+ dim as CWSTR wszFilename = ucase(pDocs(i)->DiskFilename)
+
+ wszText = wstr(pDocs(i)->bFunctionsExpanded)
+ idx = Listbox_AddString( hList, @wszText )
+ ListBox_SetItemData( hList, idx, pDocs(i) )
+ pDocs(i)->bHasFunctions = false
+
+ if pDocs(i)->bFunctionsExpanded then
+ gdb2.dbRewind()
+ do
+ pData = gdb2.dbGetNext
+ if pData = 0 THEN exit do
+ if pData->deleted then continue do
+ if pData->nFileType <> DB2_FILETYPE_USERCODE then continue do
+ select case pData->id
+ case DB2_FUNCTION
+ if wszFilename = ucase(pData->fileName) THEN
+ wszNodeName = pData->ElementName
+ if len(pData->GetSet) then
+ wszNodeName = wszNodeName & " " & pData->GetSet
+ end if
+ ub = ubound(arrFuncs) + 1
+ redim preserve arrFuncs(ub)
+ arrFuncs(ub).wszFunctionName = wszNodeName
+ arrFuncs(ub).wszPrototype = pData->CallTip
+ arrFuncs(ub).nLineNumber = pData->nLineStart
+ end if
+ end select
+ loop
+
+ quickSortFuncs( arrFuncs(), lbound(arrFuncs), ubound(arrFuncs) )
+
+ for ii as long = lbound(arrFuncs) to ubound(arrFuncs)
+ wszText = wstr(arrFuncs(ii).nLineNumber) & _
+ "%" & ltrim(arrFuncs(ii).wszFunctionName) & _
+ "%" & trim(arrFuncs(ii).wszPrototype)
+ idx = Listbox_AddString( hList, @wszText )
+ ListBox_SetItemData( hList, idx, pDocs(i) )
+ pDocs(i)->bHasFunctions = true
+ next
+ erase arrFuncs
+ end if
+
+ next
+
+ ' Restore the top index so the list displays like it did before being reset
+ SendMessage( hList, LB_SETTOPINDEX, nTopIndex, 0 )
+
+ ' Ensure that Listbox is now properly sized and then show
+ ' the listbox now that it is fully populated (only if it contains any
+ ' items because zero items can produce white background).
+ if ListBox_GetCount( hList ) then ShowWindow( hList, SW_SHOW )
+ frmFunctions_PositionWindows()
+
+ AfxRedrawWindow( hList )
+
+ ' Determine if the VScroll bar has changed size or is now hidden/shown
+ frmPanelVScroll_PositionWindows( SW_HIDE )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' LoadFunctionsOnly
+' This will clear the current list of files in the listbox and repopulate it.
+' ========================================================================================
+function LoadFunctionsOnly() as long
+ dim as HWND hList = GetDlgItem(HWND_FRMFUNCTIONS, IDC_FRMFUNCTIONS_LISTBOX)
+
+ ' Hide the listbox while it is loading so that we don't get the unpainted
+ ' white background from the empty listbox
+ ShowWindow( hList, SW_HIDE )
+
+ ' Save the topindex because we will restore it after filling the new contents
+ dim as long nTopIndex = SendMessage( hList, LB_GETTOPINDEX, 0, 0 )
+
+ ' Clear all content from the listbox
+ ListBox_ResetContent(hList)
+
+ dim wszText as wstring * MAX_PATH
+
+ dim pData as DB2_DATA ptr
+ dim as CWSTR wszNodeName
+ dim as long ub, idx
+
+ ' 231%FunctionName%prototype ' function starts at line 231 of the file
+
+ ' Get the functions (and sort them)
+ redim arrFuncs(any) as FUNCTION_NODE_TYPE
+
+ gdb2.dbRewind()
+ do
+ pData = gdb2.dbGetNext
+ if pData = 0 THEN exit do
+ if pData->deleted then continue do
+ if pData->nFileType <> DB2_FILETYPE_USERCODE then continue do
+ select case pData->id
+ case DB2_FUNCTION
+ wszNodeName = pData->ElementName
+ if len(pData->GetSet) then
+ wszNodeName = wszNodeName & " " & pData->GetSet
+ end if
+ ub = ubound(arrFuncs) + 1
+ redim preserve arrFuncs(ub)
+ arrFuncs(ub).wszFunctionName = wszNodeName
+ arrFuncs(ub).wszPrototype = pData->CallTip
+ arrFuncs(ub).nLineNumber = pData->nLineStart
+ end select
+ loop
+
+ quickSortFuncs( arrFuncs(), lbound(arrFuncs), ubound(arrFuncs) )
+
+ for ii as long = lbound(arrFuncs) to ubound(arrFuncs)
+ wszText = wstr(arrFuncs(ii).nLineNumber) & _
+ "%" & ltrim(arrFuncs(ii).wszFunctionName) & _
+ "%" & trim(arrFuncs(ii).wszPrototype)
+ idx = Listbox_AddString( hList, @wszText )
+ ListBox_SetItemData( hList, idx, 0 )
+ next
+ erase arrFuncs
+
+ ' Restore the top index so the list displays like it did before being reset
+ SendMessage( hList, LB_SETTOPINDEX, nTopIndex, 0 )
+
+ ' Ensure that Listbox is now properly sized and then show
+ ' the listbox now that it is fully populated (only if it contains any
+ ' items because zero items can produce white background).
+ if ListBox_GetCount( hList ) then ShowWindow( hList, SW_SHOW )
+ frmFunctions_PositionWindows()
+
+ AfxRedrawWindow( hList )
+
+ ' Determine if the VScroll bar has changed size or is now hidden/shown
+ frmPanelVScroll_PositionWindows( SW_HIDE )
+
+ function = 0
+end function
+
+' ========================================================================================
+' LoadFunctionsFiles
+' This will clear the current list of files in the listbox and repopulate it.
+' ========================================================================================
+function LoadFunctionsFiles() as long
+ ' Call the specific function to load the listbox based on whether we want to
+ ' to show Files & Functions, or just Functions only.
+ if gFunctionsDisplay = FunctionsDisplayState.ViewAsTree then
+ LoadFilesAndFunctions()
+ elseif gFunctionsDisplay = FunctionsDisplayState.ViewAsList then
+ LoadFunctionsOnly()
+ end if
+ function = 0
+end function
+
+' ========================================================================================
+' frmFunctions_ViewAsTree / frmFunctions_ViewAsList
+' Set the global view state for the list and then reload the list.
+' ========================================================================================
+function frmFunctions_ViewAsTree() as long
+ if gFunctionsDisplay = FunctionsDisplayState.ViewAsTree then exit function
+ gFunctionsDisplay = FunctionsDisplayState.ViewAsTree
+ LoadFunctionsFiles()
+ function = 0
+end function
+
+function frmFunctions_ViewAsList() as long
+ if gFunctionsDisplay = FunctionsDisplayState.ViewAsList then exit function
+ gFunctionsDisplay = FunctionsDisplayState.ViewAsList
+ LoadFunctionsFiles()
+ function = 0
+end function
+
+
diff --git a/src/frmGoto.bi b/src/frmGoto.bi
index ea0003e5..51fb6db2 100644
--- a/src/frmGoto.bi
+++ b/src/frmGoto.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmGoto.bi.bak b/src/frmGoto.bi.bak
new file mode 100644
index 00000000..ea0003e5
--- /dev/null
+++ b/src/frmGoto.bi.bak
@@ -0,0 +1,24 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+#Define IDC_FRMGOTO_LBLLASTLINE 1000
+#Define IDC_FRMGOTO_LBLCURRENTLINE 1001
+#Define IDC_FRMGOTO_LBLGOTOLINE 1002
+#Define IDC_FRMGOTO_TXTLINE 1003
+#Define IDC_FRMGOTO_LBLLASTVALUE 1004
+#Define IDC_FRMGOTO_LBLCURRENTVALUE 1005
+
+declare Function frmGoto_Show( ByVal hWndParent As HWnd ) As LRESULT
diff --git a/src/frmGoto.inc b/src/frmGoto.inc
index f919bc7b..291edaa8 100644
--- a/src/frmGoto.inc
+++ b/src/frmGoto.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmGoto.inc.bak b/src/frmGoto.inc.bak
new file mode 100644
index 00000000..f919bc7b
--- /dev/null
+++ b/src/frmGoto.inc.bak
@@ -0,0 +1,175 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmGoto.bi"
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmGoto
+' ========================================================================================
+private Function frmGoto_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+ Select Case id
+ Case IDOK
+ If codeNotify = BN_CLICKED Then
+ Dim nLine As Long
+ Dim swzText As WString * MAX_PATH
+ swzText = AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMGOTO_TXTLINE) )
+ nLine = Val(swzText) - 1
+ If nLine >= 0 Then
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ SciExec( hEdit, SCI_GOTOLINE, nLine, 0 )
+ pDoc->CenterCurrentLine
+ END IF
+ End If
+ SendMessage HWnd, WM_CLOSE, 0, 0
+ Exit Function
+ End If
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage HWnd, WM_CLOSE, 0, 0
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmGoto
+' ========================================================================================
+private Function frmGoto_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow HWnd
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmGoto
+' ========================================================================================
+private Function frmGoto_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmGoto
+' ========================================================================================
+private Function frmGoto_OnCreate( ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' frmGoto Window procedure
+' ========================================================================================
+private Function frmGoto_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmGoto_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmGoto_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmGoto_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmGoto_OnCommand)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmGoto_Show
+' ========================================================================================
+public Function frmGoto_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->ClassStyle = CS_DROPSHADOW
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ pWindow->Create(hWndParent, L(168,"Go to Line"), @frmGoto_WndProc, 0, 0, 287, 126, _
+ WS_POPUP Or WS_DLGFRAME Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->SetClientSize(281, 97)
+ pWindow->Center
+
+ pWindow->AddControl("TEXTBOX", pWindow->hWindow, IDC_FRMGOTO_TXTLINE, "", 105, 56, 67, 23, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("BUTTON", pWindow->hWindow, IDOK, L(0,"OK"), 186, 14, 78, 30, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_DEFPUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", pWindow->hWindow, IDCANCEL, L(1,"Cancel"), 186, 51, 78, 30, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", pWindow->hWindow, IDC_FRMGOTO_LBLCURRENTLINE, L(170,"Current line") & ":", 15, 15, 81, 17, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", pWindow->hWindow, IDC_FRMGOTO_LBLLASTLINE, L(169,"Last line") & ":", 15, 36, 81, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", pWindow->hWindow, IDC_FRMGOTO_LBLGOTOLINE, L(171,"Go to line") & ":", 15, 59, 81, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", pWindow->hWindow, IDC_FRMGOTO_LBLCURRENTVALUE, "", 107, 15, 65, 17, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", pWindow->hWindow, IDC_FRMGOTO_LBLLASTVALUE, "", 107, 36, 65, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ Dim As Long curPos, nLine, nLines
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ curPos = SciExec(hEdit, SCI_GETCURRENTPOS, 0, 0)
+ nLine = SciExec(hEdit, SCI_LINEFROMPOSITION, curPos, 0) + 1
+ nLines = SciExec(hEdit, SCI_GETLINECOUNT, 0, 0)
+ SetWindowText( GetDlgItem(pWindow->hWindow, IDC_FRMGOTO_LBLCURRENTVALUE), WStr(nLine) )
+ SetWindowText( GetDlgItem(pWindow->hWindow, IDC_FRMGOTO_LBLLASTVALUE), WStr(nLines) )
+ End If
+
+ ShowWindow pWindow->hWindow, SW_SHOW
+ SetFocus GetDlgItem(pWindow->hWindow, IDC_FRMGOTO_TXTLINE)
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the frmGoto CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
diff --git a/src/frmHelpViewer.bi b/src/frmHelpViewer.bi
index 7aaf419b..1712ad4e 100644
--- a/src/frmHelpViewer.bi
+++ b/src/frmHelpViewer.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmHelpViewer.bi.bak b/src/frmHelpViewer.bi.bak
new file mode 100644
index 00000000..7aaf419b
--- /dev/null
+++ b/src/frmHelpViewer.bi.bak
@@ -0,0 +1,56 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMHELPVIEWER_WEBBROWSER_WINFBE 1000
+#Define IDC_FRMHELPVIEWER_WEBBROWSER_WINFBX 1001
+#Define IDC_FRMHELPVIEWER_TABCONTROL 1002
+#Define IDC_FRMHELPVIEWER_TVWINFBE 1003
+#Define IDC_FRMHELPVIEWER_TVWINFBX 1004
+#Define IDC_FRMHELPVIEWER_BACK 1005
+#Define IDC_FRMHELPVIEWER_FORWARD 1006
+#Define IDC_FRMHELPVIEWER_PRINT 1007
+#Define IDC_FRMHELPVIEWER_FIND 1008
+
+' Size = 32 bytes
+TYPE HH_AKLINK
+ cbStruct AS LONG ' int cbStruct; // sizeof this structure
+ fReserved AS BOOLEAN ' BOOL fReserved; // must be FALSE (really!)
+ pszKeywords AS WSTRING PTR ' LPCTSTR pszKeywords; // semi-colon separated keywords
+ pszUrl AS WSTRING PTR ' LPCTSTR pszUrl; // URL to jump to if no keywords found (may be NULL)
+ pszMsgText AS WSTRING PTR ' LPCTSTR pszMsgText; // Message text to display in MessageBox if pszUrl is NULL and no keyword match
+ pszMsgTitle AS WSTRING PTR ' LPCTSTR pszMsgTitle; // Message text to display in MessageBox if pszUrl is NULL and no keyword match
+ pszWindow AS WSTRING PTR ' LPCTSTR pszWindow; // Window to display URL in
+ fIndexOnFail AS BOOLEAN ' BOOL fIndexOnFail; // Displays index if keyword lookup fails.
+END TYPE
+
+#Define HH_DISPLAY_TOPIC 0000
+#Define HH_DISPLAY_TOC 0001
+#Define HH_KEYWORD_LOOKUP 0013
+#Define HH_HELP_CONTEXT 0015
+
+
+' Global holding all full path/name for HTML files linked to Help Treeview (index in lParam)
+type HTMLHELPNODES
+ wszFilename as CWSTR
+ wszLocationURL as CWSTR
+ TreeviewNode as HTREEITEM
+ hTreeview as HWND
+end type
+dim shared as HTMLHELPNODES gHTMLHelp(any)
+
+Dim Shared As Any Ptr gpHelpLib
+
+declare Function ShowContextHelp( byval id as long ) As Long
+declare Function frmHelpViewer_Show( ByVal hWndParent As HWnd, byval idmHelpMessage as long ) As LRESULT
diff --git a/src/frmHelpViewer.inc b/src/frmHelpViewer.inc
index 0f94d1e6..2c570657 100644
--- a/src/frmHelpViewer.inc
+++ b/src/frmHelpViewer.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmHelpViewer.inc.bak b/src/frmHelpViewer.inc.bak
new file mode 100644
index 00000000..0f94d1e6
--- /dev/null
+++ b/src/frmHelpViewer.inc.bak
@@ -0,0 +1,546 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+#include once "frmHelpViewer.bi"
+
+
+' ========================================================================================
+' Highlight the treeview node when moving between help documents
+' ========================================================================================
+private function frmHelpViewer_HighlightTreeviewNode( byref wszLocationURL as WSTRING ) as Long
+ for i as long = lbound(gHTMLHelp) to Ubound(gHTMLHelp)
+ if wszLocationURL = gHTMLHelp(i).wszLocationURL then
+ TreeView_SelectItem( gHTMLHelp(i).hTreeview, gHTMLHelp(i).TreeviewNode )
+ exit for
+ end if
+ next
+ function = 0
+end function
+
+
+' ========================================================================================
+' Show context help or general contents if word does not exist
+' ========================================================================================
+public Function ShowContextHelp( byval id as long ) As Long
+
+ Dim HtmlHelpW As Function ( BYVAL hwndCaller AS HWnd, _
+ BYVAL pswzFile AS WSTRING Ptr, _
+ BYVAL uCommand AS UNIT, _
+ BYVAL dwData AS DWORD_PTR _
+ ) AS HWND
+
+ dim as CWSTR wszHelpFilename, wszLabel
+
+ ' Ensure that the CurDrive parameter is converted if applicable
+ gConfig.CompilerHelpFile = ProcessFromCurdriveApp( gConfig.CompilerHelpFile )
+ gConfig.WinFBXHelpfile = ProcessFromCurdriveApp( gConfig.WinFBXHelpfile )
+
+ select Case id
+ case IDM_HELP
+ wszLabel = "FreeBASIC "
+ ' Convert relative path to absolute path if needed.
+ if AfxPathIsRelative(gConfig.CompilerHelpFile) then
+ wszHelpFilename = AfxPathCombine(AfxGetExePathName, gConfig.CompilerHelpFile)
+ else
+ wszHelpFilename = gConfig.CompilerHelpFile
+ END IF
+
+ case IDM_HELPSHORTCUTS, IDM_HELPWINFBE, IDM_HELPWINFBX
+ frmHelpViewer_Show( HWND_FRMMAIN, id )
+ exit function
+
+ END SELECT
+
+
+ If AfxFileExists(wszHelpFilename) = 0 Then
+ MessageBoxW( HWND_FRMMAIN, wszLabel & L(244,"Help file not found."), L(201,"Error"), _
+ MB_OK Or MB_ICONWARNING Or MB_DEFBUTTON1 Or MB_APPLMODAL )
+ Exit Function
+ End If
+
+
+ HtmlHelpW = DyLibSymbol( gpHelpLib, "HtmlHelpW" )
+
+ If (gpHelpLib = 0) OrElse (HtmlHelpW = 0) Then
+ MessageBox( HWND_FRMMAIN, L(243,"Error loading HtmlHelp."), L(201,"Error"), _
+ MB_OK Or MB_ICONWARNING Or MB_DEFBUTTON1 Or MB_APPLMODAL )
+ Exit Function
+ End If
+
+ ' If we are currently in an active document then attempt to lookup the
+ ' word immediately under the caret.
+ Dim pDoc as clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+
+ If pDoc = 0 Then
+ HtmlHelpW( 0, wszHelpFilename, HH_DISPLAY_TOC, NULL )
+ Exit Function
+ ENd If
+
+ Dim wszKeyword as WString * MAX_PATH
+
+ wszKeyword = WStr( pDoc->GetWord )
+
+ Dim li As HH_AKLINK
+ With li
+ .cbStruct = SizeOf(HH_AKLINK)
+ .fReserved = FALSE
+ .pszKeywords = @wszKeyword
+ .pszUrl = Null
+ .pszMsgText = Null
+ .pszMsgTitle = Null
+ .pszWindow = Null
+ .fIndexOnFail = FALSE
+ End With
+
+ ' Open the help and show the topic
+ HtmlHelpW( 0, wszHelpFilename, HH_DISPLAY_TOC, Null ) '<-- needed?
+
+ If HtmlHelpW( 0, wszHelpFilename, HH_KEYWORD_LOOKUP, Cast(DWORD_PTR, @li) ) = 0 Then
+ ' Normal case search failed, try a ucase search
+ wszKeyword = UCase(wszKeyword)
+ li.pszKeywords = @wszKeyword
+ HtmlHelpW( 0, wszHelpFilename, HH_KEYWORD_LOOKUP, Cast(DWORD_PTR, @li) )
+ End If
+
+ Function = 0
+
+End Function
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+private Function frmHelpViewer_PositionWindows() As LRESULT
+
+ ' Get the entire client area
+ Dim As Rect rc
+ GetClientRect(HWND_FRMHELPVIEWER, @rc)
+
+ dim as hwnd hTabCtrl = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_TABCONTROL)
+ dim as hwnd hTree(1), hWebBrowser(1), hBtn(3)
+ hTree(0) = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_TVWINFBE)
+ hTree(1) = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_TVWINFBX)
+ hWebBrowser(0) = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_WEBBROWSER_WINFBE )
+ hWebBrowser(1) = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_WEBBROWSER_WINFBX )
+ hBtn(0) = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_BACK )
+ hBtn(1) = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_FORWARD )
+ hBtn(2) = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_PRINT )
+ hBtn(3) = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_FIND )
+
+ dim as long nCurSel = TabCtrl_GetCurSel(hTabCtrl)
+ select case nCurSel
+ case -1
+ exit function
+ case 0
+ ShowWindow( hTree(1), SW_HIDE)
+ ShowWindow( hWebBrowser(1), SW_HIDE)
+ case 1
+ ShowWindow( hTree(0), SW_HIDE)
+ ShowWindow( hWebBrowser(0), SW_HIDE)
+ end select
+
+ dim as long nSpace = AfxScaleY(4)
+ dim as long nBtnHeight = AfxScaleY(28)
+ dim as long nBtnWidth = AfxScaleY(74)
+ dim as long nTabHeight = AfxScaleY(24)
+ dim as long nTreeWidth = AfxScaleX(200)
+ dim as long nTreeHeight = rc.Bottom-rc.top-AfxScaleY(70)
+
+ SetWindowPos( hTabCtrl, 0, 0, 0, rc.Right-rc.Left, nTabHeight, SWP_SHOWWINDOW Or SWP_NOZORDER)
+ SetWindowPos( hTree(nCurSel), 0, 0, AfxScaleY(70), nTreeWidth, nTreeHeight, SWP_SHOWWINDOW Or SWP_NOZORDER)
+
+ dim nLeft as long = 0
+ for i as long = 0 to 3
+ SetWindowPos( hBtn(i), 0, nTreeWidth + nLeft, nTabHeight + (nSpace * 2), nBtnWidth, nBtnHeight, SWP_SHOWWINDOW Or SWP_NOZORDER)
+ nLeft = nLeft + nBtnWidth + nSpace
+ next
+ SetWindowPos( hWebBrowser(nCurSel), 0, nTreeWidth, AfxScaleY(70), _
+ rc.Right-rc.Left-nTreeWidth, nTreeHeight, SWP_SHOWWINDOW Or SWP_NOZORDER)
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmHelpViewer
+' ========================================================================================
+private Function frmHelpViewer_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+ DIM pwb AS CWebCtx PTR
+
+ select case TabCtrl_GetCurSel( GetDlgItem(HWnd, IDC_FRMHELPVIEWER_TABCONTROL) )
+ case -1: exit function
+ case 0: pwb = CAST(CWebCtx PTR, GetProp(hwnd, "CWEBCTXPTR_WINFBE"))
+ case 1: pwb = CAST(CWebCtx PTR, GetProp(hwnd, "CWEBCTXPTR_WINFBX"))
+ end select
+ if pwb = 0 then exit function
+
+ Select Case id
+ Case IDC_FRMHELPVIEWER_BACK
+ If codeNotify = BN_CLICKED Then
+ pwb->GoBack
+ pwb->WaitForPageLoad(10)
+ frmHelpViewer_HighlightTreeviewNode(pwb->LocationURL)
+ End If
+ Case IDC_FRMHELPVIEWER_FORWARD
+ If codeNotify = BN_CLICKED Then
+ pwb->GoForward
+ pwb->WaitForPageLoad(10)
+ frmHelpViewer_HighlightTreeviewNode(pwb->LocationURL)
+ End If
+ Case IDC_FRMHELPVIEWER_PRINT
+ If codeNotify = BN_CLICKED Then
+ pwb->PrintPreview
+ End If
+ Case IDC_FRMHELPVIEWER_FIND
+ If codeNotify = BN_CLICKED Then
+ pwb->Find
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Display the HTML file held in the array index
+' ========================================================================================
+private function frmHelpViewer_DisplayHTML( byval idx as long ) as Long
+
+ if idx >= lbound(gHTMLHelp) andalso idx <= ubound(gHTMLHelp) then
+ if AfxFileExists(gHTMLHelp(idx).wszFilename) then
+ dim as hwnd hTabCtrl = GetDlgItem(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_TABCONTROL)
+ dim as long nCurSel = TabCtrl_GetCurSel(hTabCtrl)
+
+ DIM pwb AS CWebCtx PTR
+ select case nCurSel
+ case 0: pwb = CAST(CWebCtx PTR, GetProp(HWND_FRMHELPVIEWER, "CWEBCTXPTR_WINFBE"))
+ case 1: pwb = CAST(CWebCtx PTR, GetProp(HWND_FRMHELPVIEWER, "CWEBCTXPTR_WINFBX"))
+ end select
+
+ if pwb then
+ ' Navigate to the path
+ dim wszPath as wstring * MAX_PATH = gHTMLHelp(idx).wszFilename
+ pwb->Navigate(wszPath)
+ ' Optional: Wait for page load with a timeout of 10 seconds
+ DIM lReadyState AS READYSTATE = pwb->WaitForPageLoad(10)
+ gHTMLHelp(idx).wszLocationURL = pwb->LocationURL
+ ' Set the focus in the page (the page must be fully loaded)
+ pwb->SetFocus
+ end if
+
+ end if
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_NOTIFY message for window/dialog: frmHelpViewer
+' ========================================================================================
+private Function frmHelpViewer_OnNotify( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal pNMHDR As NMHDR Ptr _
+ ) As LRESULT
+ select case pNMHDR->code
+ case TCN_SELCHANGE
+ if id = IDC_FRMHELPVIEWER_TABCONTROL then
+ frmHelpViewer_PositionWindows
+ end if
+ case TVN_SELCHANGED
+ Dim lpNMTV As NM_TREEVIEW Ptr = Cast(NM_TREEVIEW Ptr, pNMHDR)
+ dim as long idx = TreeView_GetlParam( pNMHDR->hWndFrom, lpNMTV->itemNew.hItem)
+ frmHelpViewer_DisplayHTML(idx)
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmHelpViewer
+' ========================================================================================
+private Function frmHelpViewer_OnSize( ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+ If state <> SIZE_MINIMIZED Then
+ frmHelpViewer_PositionWindows
+ End If
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmHelpViewer
+' ========================================================================================
+private Function frmHelpViewer_OnClose( ByVal HWnd As HWnd ) As LRESULT
+ ' Only hide the window rather than destroy it
+ ShowWindow( HWnd, SW_HIDE )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmHelpViewer
+' ========================================================================================
+private Function frmHelpViewer_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ HWND_FRMHELPVIEWER = 0
+ ' Delete the CWewbCtx class
+ DIM pwb1 AS CWebCtx PTR = CAST(CWebCtx PTR, GetProp(hwnd, "CWEBCTXPTR_WINFBE"))
+ IF pwb1 THEN Delete pwb1
+ DIM pwb2 AS CWebCtx PTR = CAST(CWebCtx PTR, GetProp(hwnd, "CWEBCTXPTR_WINFBX"))
+ IF pwb2 THEN Delete pwb2
+
+ ' Delete the popup CWindow class
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
+ IF pWindow THEN Delete pWindow
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmHelpViewer Window procedure
+' ========================================================================================
+private Function frmHelpViewer_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_COMMAND, frmHelpViewer_OnCommand)
+ HANDLE_MSG (HWnd, WM_NOTIFY, frmHelpViewer_OnNotify)
+ HANDLE_MSG (HWnd, WM_SIZE, frmHelpViewer_OnSize)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmHelpViewer_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmHelpViewer_OnDestroy)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' Load the Treeview showing the hlep topics (recursive). Store array index in lParam
+' ========================================================================================
+private function LoadHelpTreeview( byval hTreeview as hwnd, _
+ byval sPath as CWSTR, _
+ byval hParent as HTREEITEM _
+ ) as long
+
+ DIM pFinder AS CFindFile
+
+ if pFinder.FindFile(sPath & "*.*") <> S_OK then exit function
+
+ dim as HTREEITEM addMode = iif( hParent = null, TVI_ROOT, TVI_FIRST )
+ dim SubFolders(any) as CWSTR
+ dim as CWSTR wszRoot
+
+ do
+
+ if pFinder.IsDots then
+
+ elseif pFinder.IsFolder then
+ dim as long ub = ubound(SubFolders)
+ redim preserve SubFolders(ub + 1)
+ SubFolders(ub + 1) = pFinder.FilePath
+ wszRoot = pFinder.Root
+ else
+ ' Find any *.html files
+ if ucase(pFinder.FileExt) = "HTML" then
+ dim as long ub = ubound(gHTMLHelp) + 1
+ redim preserve gHTMLHelp(ub)
+ gHTMLHelp(ub).wszFilename = pFinder.FilePath
+ gHTMLHelp(ub).TreeviewNode = TreeView_AddItem(hTreeView, hParent, addMode, pFinder.Filename, ub, 0, 0)
+ gHTMLHelp(ub).hTreeView = hTreeView
+ Treeview_SortChildren( hTreeView, hParent, 0 )
+ end if
+
+ end if
+
+ if pFinder.FindNext = 0 then exit do
+ loop
+
+ pFinder.Close()
+
+ ' Process all of the folders that were found
+ for i as long = lbound(SubFolders) to ubound(SubFolders)
+ dim as CWSTR wszFolder = mid(SubFolders(i), len(wszRoot) + 1)
+ dim as HTREEITEM hNode = TreeView_AddItem(hTreeView, hParent, addMode, wszFolder, -1, 0, 0)
+ LoadHelpTreeview(hTreeview, SubFolders(i) & "\", hNode)
+ next
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmHelpViewer_Show
+' ========================================================================================
+public Function frmHelpViewer_Show( ByVal hWndParent As HWnd, _
+ byval idmHelpMessage as long _
+ ) As LRESULT
+
+ static as Long idxNodeShortcuts = -1
+ dim as hwnd hTree1, hTree2, hTabCtrl
+
+ if IsWindow( HWND_FRMHELPVIEWER ) = 0 then
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ Dim rcWork As Rect = pWindow->GetWorkArea
+ Dim nHeight As Long = (rcWork.Bottom - rcWork.Top) * .80
+ Dim nWidth As Long = (rcWork.Right - rcWork.Left) * .80
+
+ HWND_FRMHELPVIEWER = _
+ pWindow->Create( 0, "Help Viewer", @frmHelpViewer_WndProc, 0, 0, nWidth, nHeight, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_MAXIMIZEBOX or WS_MINIMIZEBOX or WS_THICKFRAME or _
+ WS_CLIPCHILDREN OR WS_CLIPSIBLINGS, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+ pWindow->brush = GetSysColorBrush(COLOR_WINDOW)
+
+ ' Set the small and large icon for the main window (must be set after main window is created)
+ pWindow->BigIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 32, 32, LR_SHARED)
+ pWindow->SmallIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 16, 16, LR_SHARED)
+
+
+ hTree1 = _
+ pWindow->AddControl("TREEVIEW", , IDC_FRMHELPVIEWER_TVWINFBE, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP or _
+ TVS_INFOTIP or TVS_SHOWSELALWAYS Or TVS_FULLROWSELECT Or TVS_TRACKSELECT or _
+ TVS_HASBUTTONS or TVS_HASLINES or TVS_LINESATROOT, _
+ WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR)
+
+ ' Use the new style Explorer Treeview (triangles instead of boxes).
+ ' Set an undocumented extended style that enables the treeview glyphs to resize
+ ' according to the high dpi setting.
+ ' https://stackoverflow.com/questions/38772670/ctreectrl-with-explorer-theme-not-dpi-aware
+ SendMessage(hTree1, TVM_SETEXTENDEDSTYLE, &H1000, &H1000)
+ SetWindowTheme(hTree1, @wstr("EXPLORER"), 0)
+ SendMessage( hTree1, TVM_SETEXTENDEDSTYLE, TVS_EX_DOUBLEBUFFER, TVS_EX_DOUBLEBUFFER)
+
+ ' Load the Treeview
+ LoadHelpTreeview(hTree1, AfxGetExePath & "\Help\WinFBE\", null)
+
+
+ hTree2 = _
+ pWindow->AddControl("TREEVIEW", , IDC_FRMHELPVIEWER_TVWINFBX, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP or _
+ TVS_INFOTIP or TVS_SHOWSELALWAYS Or TVS_FULLROWSELECT Or TVS_TRACKSELECT or _
+ TVS_HASBUTTONS or TVS_HASLINES or TVS_LINESATROOT, _
+ WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR)
+
+ ' Use the new style Explorer Treeview (triangles instead of boxes).
+ ' Set an undocumented extended style that enables the treeview glyphs to resize
+ ' according to the high dpi setting.
+ ' https://stackoverflow.com/questions/38772670/ctreectrl-with-explorer-theme-not-dpi-aware
+ SendMessage(hTree2, TVM_SETEXTENDEDSTYLE, &H1000, &H1000)
+ SetWindowTheme(hTree2, @wstr("EXPLORER"), 0)
+ SendMessage( hTree2, TVM_SETEXTENDEDSTYLE, TVS_EX_DOUBLEBUFFER, TVS_EX_DOUBLEBUFFER)
+
+ ' Load the Treeview
+ LoadHelpTreeview(hTree2, AfxGetExePath & "\Help\WinFBX\", null)
+
+
+ ' Add the naviagation and print buttons
+ pWindow->AddControl("BUTTON", , IDC_FRMHELPVIEWER_BACK, "Back", 0, 0, 0, 0, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMHELPVIEWER_FORWARD, "Forward", 0, 0, 0, 0, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMHELPVIEWER_PRINT, "Print", 0, 0, 0, 0, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMHELPVIEWER_FIND, "Find", 0, 0, 0, 0, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ ' Add a WebBrowser controls
+ DIM pwb1 AS CWebCtx PTR = NEW CWebCtx(pWindow, IDC_FRMHELPVIEWER_WEBBROWSER_WINFBE, 0, 0, pWindow->ClientWidth, pWindow->ClientHeight)
+ SetProp(pWindow->hWindow, "CWEBCTXPTR_WINFBE", CAST(HANDLE, pwb1))
+ DIM pwb2 AS CWebCtx PTR = NEW CWebCtx(pWindow, IDC_FRMHELPVIEWER_WEBBROWSER_WINFBX, 0, 0, pWindow->ClientWidth, pWindow->ClientHeight)
+ SetProp(pWindow->hWindow, "CWEBCTXPTR_WINFBX", CAST(HANDLE, pwb2))
+
+ hTabCtrl = pWindow->AddControl("TABCONTROL", , _
+ IDC_FRMHELPVIEWER_TABCONTROL, "", 0, 0, 0, 24, _
+ WS_CHILD Or WS_TABSTOP Or TCS_SINGLELINE Or TCS_RAGGEDRIGHT Or TCS_HOTTRACK Or _
+ TCS_TABS Or TCS_FOCUSNEVER Or TCS_FORCEICONLEFT, WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ TabCtrl_AddTab(hTabCtrl, 0, "WinFBE Editor", 0)
+ TabCtrl_AddTab(hTabCtrl, 0, "WinFBX Library", 0)
+
+
+ ' Set the treeviews to their default topic (the first topic found in the array for each treeview).
+ dim as long idxNodeTree1 = -1
+ dim as long idxNodeTree2 = -1
+
+ for i as long = lbound(gHTMLHelp) to ubound(gHTMLHelp)
+ if gHTMLHelp(i).hTreeview = hTree1 then
+ if idxNodeTree1 = -1 then idxNodeTree1 = i
+ elseif gHTMLHelp(i).hTreeview = hTree2 then
+ if idxNodeTree2 = -1 then idxNodeTree2 = i
+ end if
+ if AfxStrPathName( "NAMEX", ucase( gHTMLHelp(i).wszFilename )) = "KEYBOARD SHORTCUTS.HTML" then
+ if idxNodeShortcuts = -1 then idxNodeShortcuts = i
+ end if
+ next
+
+ ' Set the default first page to show for each treeview
+ TabCtrl_SetCurSel( hTabCtrl, 0 )
+ if idxNodeTree1 > -1 then TreeView_SelectItem( hTree1, gHTMLHelp(idxNodeTree1).TreeviewNode )
+ frmHelpViewer_DisplayHTML( idxNodeTree1 )
+
+ TabCtrl_SetCurSel( hTabCtrl, 1 )
+ if idxNodeTree2 > -1 then TreeView_SelectItem( hTree2, gHTMLHelp(idxNodeTree2).TreeviewNode )
+ frmHelpViewer_DisplayHTML( idxNodeTree2 )
+ end if
+
+
+ ' Must set the active tab page first because frmHelpViewer_DisplayHTML and frmHelpViewer_PositionWindows
+ ' both test what the active tab page in order to perform their work.
+ hTabCtrl = GetDlgItem( HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_TABCONTROL )
+ select case idmHelpMessage
+ case IDM_HELPSHORTCUTS
+ TabCtrl_SetCurSel( hTabCtrl, 0 )
+ frmHelpViewer_DisplayHTML( idxNodeShortcuts )
+
+ case IDM_HELPWINFBE
+ TabCtrl_SetCurSel( hTabCtrl, 0 )
+
+ case IDM_HELPWINFBX
+ TabCtrl_SetCurSel( hTabCtrl, 1 )
+ end select
+
+ frmHelpViewer_PositionWindows
+
+
+ ' Display the window
+ ShowWindow HWND_FRMHELPVIEWER, SW_SHOW
+ UpdateWindow(HWND_FRMHELPVIEWER)
+
+ Function = 0
+End Function
+
diff --git a/src/frmImageManager.bi b/src/frmImageManager.bi
index dd1e3df5..b2a6ff93 100644
--- a/src/frmImageManager.bi
+++ b/src/frmImageManager.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmImageManager.bi.bak b/src/frmImageManager.bi.bak
new file mode 100644
index 00000000..dd1e3df5
--- /dev/null
+++ b/src/frmImageManager.bi.bak
@@ -0,0 +1,28 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMIMAGEMANAGER_TOOLBAR 1000
+#Define IDC_FRMIMAGEMANAGER_LISTVIEW 1001
+#Define IDC_FRMIMAGEMANAGER_COMBO1 1002
+#Define IDC_FRMIMAGEMANAGER_IMAGECTX 1003
+#Define IDC_FRMIMAGEMANAGER_FRAMEPREVIEW 1004
+#Define IDC_FRMIMAGEMANAGER_LBLFILENAME 1005
+#Define IDC_FRMIMAGEMANAGER_FORMATBITMAP 1006
+#Define IDC_FRMIMAGEMANAGER_FORMATICON 1007
+#Define IDC_FRMIMAGEMANAGER_FORMATCURSOR 1008
+#Define IDC_FRMIMAGEMANAGER_FORMATRCDATA 1009
+#Define IDC_FRMIMAGEMANAGER_CMDFILENAME 1010
+
+declare Function frmImageManager_Show( ByVal hWndParent As HWnd, Byval pProp as clsProperty ptr = 0 ) As LRESULT
diff --git a/src/frmImageManager.inc b/src/frmImageManager.inc
index b14499a7..be7f5a85 100644
--- a/src/frmImageManager.inc
+++ b/src/frmImageManager.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmImageManager.inc.bak b/src/frmImageManager.inc.bak
new file mode 100644
index 00000000..b14499a7
--- /dev/null
+++ b/src/frmImageManager.inc.bak
@@ -0,0 +1,751 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmImageManager.bi"
+#include once "clsDocument.bi"
+#include once "clsTopTabCtl.bi"
+
+
+' ========================================================================================
+' Create the popup menu showing the list of valid image formats
+' ========================================================================================
+Function frmImageManager_CreateImagesResourceMenu() As HMENU
+
+ dim wszImageFormat as wstring * MAX_PATH
+ dim as hwnd hLV = GetDlgItem(HWND_FRMIMAGES, IDC_FRMIMAGEMANAGER_LISTVIEW)
+ dim as long nCurSel = ListView_GetSelection(hLV)
+ FF_ListView_GetItemText(hLV, nCurSel, 1, @wszImageFormat, MAX_PATH)
+
+ dim as long fNormal = MF_ENABLED or MF_STRING
+ dim as long fChecked = MF_CHECKED or MF_ENABLED or MF_STRING
+ dim as long i
+
+ select case wszImageFormat
+ case "RCDATA": i = 1
+ case "BITMAP": i = 2
+ case "ICON": i = 3
+ case "CURSOR": i = 4
+ end select
+
+ Dim hPopUpMenu As HMENU = CreatePopupMenu()
+ AppendMenu( hPopUpMenu, iif(i = 1, fChecked, fNormal), IDC_FRMIMAGEMANAGER_FORMATRCDATA, "RCDATA")
+ AppendMenu( hPopUpMenu, iif(i = 2, fChecked, fNormal), IDC_FRMIMAGEMANAGER_FORMATBITMAP, "BITMAP")
+ AppendMenu( hPopUpMenu, iif(i = 3, fChecked, fNormal), IDC_FRMIMAGEMANAGER_FORMATICON, "ICON")
+ AppendMenu( hPopUpMenu, iif(i = 4, fChecked, fNormal), IDC_FRMIMAGEMANAGER_FORMATCURSOR, "CURSOR")
+
+ Function = hPopupMenu
+
+End Function
+
+
+' ========================================================================================
+' Display a selected image in the Image Manager
+' ========================================================================================
+private Function frmImageManager_DisplayImage( byval hwnd as HWND, _
+ byval nIndex as long _
+ ) As LRESULT
+
+ dim pImageCtx as CImageCtx PTR = AfxCImageCtxPtr(hwnd, IDC_FRMIMAGEMANAGER_IMAGECTX)
+ if pImageCtx = 0 then exit function
+
+ dim as hwnd hImageCtx = GetDlgItem(hwnd, IDC_FRMIMAGEMANAGER_IMAGECTX)
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+
+ dim pImageType as IMAGES_TYPE ptr
+ dim wszImageName as wstring * MAX_PATH
+ dim as CWSTR wszFilename
+
+ ' Get the disk filename for the selected Image. Do not use the method of storing
+ ' a pointer to the IMAGES_TYPE in the ListView data area because the pDoc->AllImages
+ ' array gets REDIM PRESERVE which moves the array elements around in memory.
+ ShowWindow(hImageCtx, SW_HIDE)
+ EnableWindow( GetDlgItem(hwnd, IDC_FRMIMAGEMANAGER_CMDFILENAME), false)
+ if nIndex >= 0 then
+ FF_ListView_GetItemText(GetDlgItem(hwnd, IDC_FRMIMAGEMANAGER_LISTVIEW), nIndex, 0, @wszImageName, MAX_PATH)
+ pImageType = GetImagesTypePtr(wszImageName)
+
+ if pImageType then
+ pImageCtx->LoadImageFromFile(pImageType->wszFileName)
+ ' Resize the image based on the ComboBox selections
+ dim as long nCurSel = ComboBox_GetCurSel( GetDlgItem(hwnd, IDC_FRMIMAGEMANAGER_COMBO1) )
+ select case nCurSel
+ case 0 ' Actual size
+ pImageCtx->SetImageAdjustment( GDIP_IMAGECTX_ACTUALSIZE, CTRUE )
+ case 1 ' Apply High DPI scaling
+ ' Make the image high dpi aware
+ if pWindow then
+ pImageCtx->SetImageWidth( pWindow->ScaleX(pImageCtx->GetImageWidth) )
+ pImageCtx->SetImageHeight( pWindow->ScaleY(pImageCtx->GetImageHeight) )
+ end if
+ pImageCtx->SetImageAdjustment( GDIP_IMAGECTX_ACTUALSIZE, CTRUE )
+ case 2 ' AutoSize
+ pImageCtx->SetImageAdjustment( GDIP_IMAGECTX_AUTOSIZE, CTRUE )
+ case 3 ' Fit to Width
+ pImageCtx->SetImageAdjustment( GDIP_IMAGECTX_FITTOWIDTH, CTRUE )
+ case 4 ' Fit to Height
+ pImageCtx->SetImageAdjustment( GDIP_IMAGECTX_FITTOHEIGHT, CTRUE )
+ case 5 ' Stretch
+ pImageCtx->SetImageAdjustment( GDIP_IMAGECTX_STRETCH, CTRUE )
+ end select
+
+ dim hCtrl as HWND = GetDlgItem( HWND_FRMIMAGES, IDC_FRMIMAGEMANAGER_FRAMEPREVIEW )
+ wszFilename = wszFilename & pImageType->wszFileName
+ if AfxFileExists(pImageType->wszFileName) = false then
+ wszFilename = wszFilename & " (" & L(81, "File not found") & ")"
+ end if
+ ShowWindow(hImageCtx, SW_SHOW)
+ EnableWindow( GetDlgItem(hwnd, IDC_FRMIMAGEMANAGER_CMDFILENAME), true)
+ end if
+ end if
+ AfxSetWindowText( GetDlgItem(hwnd, IDC_FRMIMAGEMANAGER_LBLFILENAME), wszFilename)
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Generate an IMAGE name based on the filename.
+' ========================================================================================
+private function frmImageManager_GenerateImageName( byval wszFilename as CWSTR ) as CWSTR
+
+ dim as CWSTR wszImageName
+ dim as Boolean fDuplicateName
+ dim as long counter = 0
+
+ ' Search all existing image names to ensure there are no duplicates.
+ do
+ ' Construct an IMAGE name to test
+ fDuplicateName = false
+ wszImageName = "IMAGE_" & ucase(AfxStrPathname("NAME", wszFilename))
+ wszImageName = AfxStrRemoveAny( wszImageName, " .," )
+ if counter > 0 then wszImageName = wszImageName & counter
+
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ if (gApp.IsProjectActive = false) andalso (pDoc <> gTTabCtl.GetActiveDocumentPtr) then
+ ' For non-projects only deal with images related to the active form.
+ else
+ for i as long = lbound(pDoc->AllImages) to ubound(pDoc->AllImages)
+ if pDoc->AllImages(i).wszImageName = wszImageName then
+ fDuplicateName = true
+ counter = counter + 1: exit do
+ end if
+ next
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+
+ if fDuplicateName = false then exit do
+ loop
+
+ function = wszImageName
+end function
+
+
+
+' ========================================================================================
+' Add an image to the Image Manager
+' ========================================================================================
+private Function frmImageManager_AddImage( ByVal HWnd As HWnd ) As LRESULT
+
+ ' Display the Open File Dialog
+ Dim pItems As IShellItemArray Ptr = AfxIFileOpenDialogMultiple(HWnd, IDM_ADDIMAGE)
+ If pItems = Null Then Exit Function
+
+ Dim as long dwItemCount
+ dim as long i
+ dim pItem As IShellItem Ptr
+ dim pwszName As WString Ptr
+
+ pItems->lpVtbl->GetCount(pItems, @dwItemCount)
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim as hwnd hLV = GetDlgItem(HWND, IDC_FRMIMAGEMANAGER_LISTVIEW)
+ dim as CWSTR wszText
+ dim as Boolean fDuplicate
+
+ dim as long nSelLine = ListView_GetSelection(hLV)
+
+ For i = 0 To dwItemCount - 1
+ pItems->lpVtbl->GetItemAt(pItems, i, @pItem)
+ If pItem Then
+ pItem->lpVtbl->GetDisplayName(pItem, SIGDN_FILESYSPATH, @pwszName)
+ If pwszName Then
+ ' Add the entry to the listview only if the generated name does
+ ' not already exist in the AllImages array in order to avoid
+ ' adding duplicate entries.
+ fDuplicate = false
+ for ii as long = lbound(pDoc->AllImages) to ubound(pDoc->AllImages)
+ IF ucase(pDoc->AllImages(ii).wszFileName) = ucase(*pwszName) then
+ fDuplicate = true: exit for
+ end if
+ next
+ if fDuplicate = false then
+ dim as long ub = ubound(pDoc->AllImages) + 1
+ redim preserve pDoc->AllImages(ub)
+ pDoc->AllImages(ub).wszFileName = *pwszName
+ pDoc->AllImages(ub).wszImageName = frmImageManager_GenerateImageName(*pwszName)
+ pDoc->AllImages(ub).wszFormat = "RCDATA"
+ pDoc->AllImages(ub).pDoc = pDoc
+ dim as long count = ListView_GetItemCount(hLV)
+ FF_ListView_InsertItem( hLV, count, 0, pDoc->AllImages(ub).wszImageName )
+ FF_ListView_InsertItem( hLV, count, 1, pDoc->AllImages(ub).wszFormat)
+ nSelLine = count
+ end if
+
+ CoTaskMemFree(pwszName)
+ pwszName = Null
+ End If
+ pItem->lpVtbl->Release(pItem)
+ pItem = Null
+ End If
+ Next
+ pItems->lpVtbl->Release(pItems)
+
+ ' Save the changes to the pDoc
+ if pDoc then pDoc->SaveFile
+
+ ListView_SelectItem(hLV, nSelLine)
+ frmImageManager_DisplayImage(hwnd, nSelLine)
+ SetFocus hLV
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Remove an image from the Image Manager
+' ========================================================================================
+private Function frmImageManager_RemoveImage( ByVal HWnd As HWnd ) As LRESULT
+
+ dim pDoc as clsDocument ptr
+ dim pCtrl as clsControl ptr
+ dim pProp as clsProperty ptr
+ dim pImageType as IMAGES_TYPE ptr
+
+ dim as hwnd hLV = GetDlgItem(HWND, IDC_FRMIMAGEMANAGER_LISTVIEW)
+ dim as long nCurSel = ListView_GetSelection(hLV)
+ if nCurSel = -1 then exit function
+
+ dim wszImageName as wstring * MAX_PATH
+ dim as CWSTR wszMsg
+
+ ' Get the pDoc related to this IMAGE_NAME being deleted in order to ensure that
+ ' we remove it from the correct document.
+ FF_ListView_GetItemText(hLV, nCurSel, 0, @wszImageName, MAX_PATH)
+ pImageType = GetImagesTypePtr(wszImageName)
+
+
+ ' Count the number of times this IMAGE_NAME is used by controls/properties
+ ' in the file/project. Ask the user if he wants to remove the image and
+ ' thereby remove all references in controls that rely on the image.
+ dim pProps(any) as clsProperty ptr
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ ' Loop through all controls on the Form
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ ' Loop through all properties for each control
+ for ii as long = lbound(pCtrl->Properties) to ubound(pCtrl->Properties)
+ pProp = @pCtrl->Properties(ii)
+ if pProp = 0 then continue for
+ if pProp->PropType = PropertyType.ImagePicker then
+ if pProp->wszPropValue = wszImageName then
+ dim as long ub = ubound(pProps) + 1
+ redim preserve pProps(ub)
+ pProps(ub) = pProp
+ end if
+ end if
+ next
+ next
+ pDoc = pDoc->pDocNext
+ loop
+
+ dim as long numRefs = ubound(pProps) - lbound(pProps) + 1
+ wszMsg = L(366,"Are you sure you want to delete?") & vbcrlf & _
+ wszImageName & vbcrlf & _
+ "(" & numRefs & " " & L(379,"references") & ")"
+ If MessageBox( hwnd, wszMsg, L(276,"Confirm"), MB_ICONQUESTION Or MB_YESNOCANCEL ) <> IDYES Then exit function
+
+ ' Do the actual delete from the AllImages array for the pDoc that holds the image.
+ if pImageType->pDoc then
+ for i as long = nCurSel to ubound(pImageType->pDoc->AllImages) - 1
+ pImageType->pDoc->AllImages(i) = pImageType->pDoc->AllImages(i+1)
+ next
+ if Ubound(pImageType->pDoc->AllImages)-1 < 0 then
+ erase pImageType->pDoc->AllImages
+ else
+ Redim Preserve pImageType->pDoc->AllImages(Ubound(pImageType->pDoc->AllImages)-1)
+ end if
+ ' Save the changes to the pDoc
+ pImageType->pDoc->SaveFile
+ end if
+
+ ' Ensure that the IMAGE_NAME is removed from all Properties that rely on the image.
+ for i as long = lbound(pProps) to ubound(pProps)
+ pProps(i)->wszPropValue = ""
+ next
+ DisplayPropertyList(gTTabCtl.GetActiveDocumentPtr)
+
+ ' Remove the Listview line and reposition the selection.
+ ListView_DeleteItem(hLV, nCurSel)
+
+ ' Reposition Listview to next closest line.
+ if ListView_GetItemCount(hLV) > 0 then
+ nCurSel = nCurSel - 1
+ if nCurSel < 0 then nCurSel = 0
+ ListView_SelectItem(hLV, nCurSel)
+ else
+ nCurSel = -1
+ end if
+ frmImageManager_DisplayImage(hwnd, nCurSel)
+ SetFocus hLV
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmImages
+' ========================================================================================
+private Function frmImageManager_OnCreate( ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmImages
+' ========================================================================================
+private Function frmImageManager_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim as hwnd hLV = GetDlgItem(HWND, IDC_FRMIMAGEMANAGER_LISTVIEW)
+ dim as long nCurSel
+ dim wszImageName as wstring * MAX_PATH
+ dim wszText as wstring * MAX_PATH
+
+ dim pImageCtx as CImageCtx PTR
+ dim pImageType as IMAGES_TYPE ptr
+ dim pProp as clsProperty ptr
+
+ if IsWindow(hLV) then
+ nCurSel = ListView_GetSelection(hLV)
+ FF_ListView_GetItemText(hLV, nCurSel, 0, @wszImageName, MAX_PATH)
+ pImageType = GetImagesTypePtr(wszImageName)
+ end if
+
+
+ Select Case id
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage HWnd, WM_CLOSE, 0, 0
+ Exit Function
+ End If
+
+ case IDC_FRMIMAGEMANAGER_CMDFILENAME
+ If codeNotify = BN_CLICKED Then
+ ' Popup an inputbox to get corrected image filename
+ dim as CWSTR wszResult
+ dim as CWSTR wszFilename
+ if pImageType then wszFilename = pImageType->wszFileName
+ wszResult = AfxInputBox( HWND_FRMIMAGES, 0, 0, _
+ L(368,"Image Manager"), _
+ L(405,"Enter valid image file path") & ":", _
+ wszFilename, 1000 )
+ if len(wszResult) then
+ if ucase(wszResult) <> ucase(wszFilename) then
+ if pImageType then
+ pImageType->wszFileName = wszResult
+ if pImageType->pDoc then pImageType->pDoc->SaveFile
+ frmImageManager_DisplayImage( HWND, nCurSel )
+ end if
+ end if
+ end if
+ Exit Function
+ End If
+
+ case IDM_ADDIMAGE
+ frmImageManager_AddImage(HWND)
+ exit function
+
+ case IDM_REMOVEIMAGE
+ frmImageManager_RemoveImage(HWND)
+ exit function
+
+ case IDM_FORMATIMAGE
+ if nCurSel = -1 then exit function
+ Dim pt As Point
+ Dim as HMENU hPopUpMenu = frmImageManager_CreateImagesResourceMenu()
+ GetCursorPos @pt
+ TrackPopupMenu(hPopUpMenu, 0, pt.x, pt.y, 0, HWnd, ByVal Null)
+ DestroyMenu hPopUpMenu
+ exit function
+
+ case IDC_FRMIMAGEMANAGER_FORMATBITMAP, IDC_FRMIMAGEMANAGER_FORMATICON, _
+ IDC_FRMIMAGEMANAGER_FORMATCURSOR, IDC_FRMIMAGEMANAGER_FORMATRCDATA
+ if id = IDC_FRMIMAGEMANAGER_FORMATBITMAP then wszText = "BITMAP"
+ if id = IDC_FRMIMAGEMANAGER_FORMATICON then wszText = "ICON"
+ if id = IDC_FRMIMAGEMANAGER_FORMATCURSOR then wszText = "CURSOR"
+ if id = IDC_FRMIMAGEMANAGER_FORMATRCDATA then wszText = "RCDATA"
+ if pImageType then
+ pImageType->wszFormat = wszText
+ FF_ListView_SetItemText( hLV, nCurSel, 1, @wszText, MAX_PATH )
+ pImageType->pDoc->SaveFile
+ end if
+ exit function
+
+ case IDM_ATTACHIMAGE, IDM_DETACHIMAGE
+ if nCurSel = -1 then exit function
+ if len(wszImageName) = 0 then exit function
+ if id = IDM_DETACHIMAGE then wszImageName = ""
+
+ ' If an editor called this ImageManager then save the selected
+ ' image name into the pProp of the currently selected
+ if (GetParent( HWND_FRMIMAGES ) = HWND_FRMSTATUSBAREDITOR) or _
+ (GetParent( HWND_FRMIMAGES ) = HWND_FRMTOOLBAREDITOR) or _
+ (GetParent( HWND_FRMIMAGES ) = HWND_FRMVDTABCHILD) then
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMIMAGES)
+ pProp = cast( clsProperty ptr, pWindow->UserData(0) )
+ if pProp then pProp->wszPropValue = wszImageName
+ else
+ pProp = GetActivePropertyPtr()
+ if pProp then pProp->wszPropValue = wszImageName
+ DisplayPropertyList(gTTabCtl.GetActiveDocumentPtr)
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr = pDoc->Controls.GetActiveControl
+ ApplyControlProperties( pDoc, pCtrl )
+ pDoc->UserModified = true
+ end if
+
+ SendMessage( HWnd, WM_CLOSE, 0, 0)
+ exit function
+
+ CASE IDC_FRMIMAGEMANAGER_COMBO1
+ If codeNotify = CBN_SELCHANGE Then
+ frmImageManager_DisplayImage( hwnd, nCurSel )
+ EXIT FUNCTION
+ END IF
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_NOTIFY message for window/dialog: frmImages
+' ========================================================================================
+private Function frmImageManager_OnNotify( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal pNMHDR As NMHDR Ptr _
+ ) As LRESULT
+ Select Case id
+ Case IDC_FRMIMAGEMANAGER_LISTVIEW
+ If pNMHDR->code = LVN_ITEMCHANGED Then
+ dim as long nSelLine = ListView_GetSelection(pNMHDR->hwndFrom)
+ frmImageManager_DisplayImage(hwnd, nSelLine)
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmImages
+' ========================================================================================
+private Function frmImageManager_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow HWnd
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmImages
+' ========================================================================================
+private Function frmImageManager_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ ' Destroy the toolbar image lists
+ ImageList_Destroy CAST(HIMAGELIST, SendMessage(GetDlgItem(hwnd, IDC_FRMIMAGEMANAGER_TOOLBAR), TB_SETIMAGELIST, 0, 0))
+ ImageList_Destroy CAST(HIMAGELIST, SendMessage(GetDlgItem(hwnd, IDC_FRMIMAGEMANAGER_TOOLBAR), TB_SETHOTIMAGELIST, 0, 0))
+ ImageList_Destroy CAST(HIMAGELIST, SendMessage(GetDlgItem(hwnd, IDC_FRMIMAGEMANAGER_TOOLBAR), TB_SETDISABLEDIMAGELIST, 0, 0))
+ HWND_FRMIMAGES = 0
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed frmImages listview control.
+' ========================================================================================
+private Function frmImageManager_Listview_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ Dim As HWND hLV
+ Dim As POINT pt
+ Dim As HTREEITEM hItem
+ Dim As BOOLEAN bIsFolder
+ Dim As BOOLEAN bIsExpanded
+
+ ' Convert our ENTER key presses into LBUTTONDBLCLK to process them similarly
+ If (uMsg = WM_KEYUP) And (Loword(wParam) = VK_RETURN) Then uMsg = WM_LBUTTONDBLCLK
+
+ Select Case uMsg
+
+ Case WM_GETDLGCODE
+ ' All keyboard input
+ Function = DLGC_WANTALLKEYS
+ Exit Function
+
+ Case WM_LBUTTONDBLCLK
+ Exit Function
+
+ Case WM_KEYUP
+ Select Case Loword(wParam)
+ Case VK_RETURN ' already processed in WM_LBUTTONDBLCLK
+ End Select
+ Exit Function
+
+ Case WM_CHAR ' prevent the annoying beep!
+ If wParam = VK_RETURN Then Return 0
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass HWnd, @frmImageManager_Listview_SubclassProc, uIdSubclass
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmImages Window procedure
+' ========================================================================================
+private Function frmImageManager_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmImageManager_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmImageManager_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmImageManager_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmImageManager_OnCommand)
+ HANDLE_MSG (HWnd, WM_NOTIFY, frmImageManager_OnNotify)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmImageManager_Show
+' ========================================================================================
+public Function frmImageManager_Show( ByVal hWndParent As HWnd, _
+ Byval pProp as clsProperty ptr = 0 _
+ ) As LRESULT
+
+ dim wszImageName as wstring * MAX_PATH
+ if pProp then wszImageName = pProp->wszPropValue
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMIMAGES = _
+ pWindow->Create( hWndParent, L(368,"Image Manager"), @frmImageManager_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT )
+ if ucase(gConfig.LocalizationFile) = "ENGLISH.LANG" then
+ pWindow->SetClientSize(700, 480)
+ else
+ pWindow->SetClientSize(780, 480)
+ end if
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ ' Save the incoming pProp value to the ImageManager window. We do this because if the StatusBar
+ ' Editor or ToolBar Editor or TabControl Custom called this ImageManager then we need to save
+ ' the Image Name into the pProp.
+ pWindow->UserData(0) = cast( LONG_PTR, pProp )
+
+ ' Add a tooolbar
+ DIM hToolBar AS HWND = pWindow->AddControl("Toolbar", , IDC_FRMIMAGEMANAGER_TOOLBAR, "", 0, 0, 0, 0, _
+ WS_CHILD or WS_VISIBLE OR WS_CLIPCHILDREN OR WS_CLIPSIBLINGS or _
+ TBSTYLE_FLAT or TBSTYLE_LIST or TBSTYLE_TOOLTIPS or TBSTYLE_AUTOSIZE or _
+ WS_BORDER or CCS_TOP )
+
+ DIM AS LONG nButtonWidth, nButtonHeight
+ nButtonWidth = LOWORD(SendMessage(hToolBar, TB_GETBUTTONSIZE, 0, 0)) * pWindow->rxRatio
+ nButtonHeight = HIWORD(SendMessage(hToolBar, TB_GETBUTTONSIZE, 0, 0)) * pWindow->ryRatio
+ SendMessage hToolBar, TB_SETBUTTONSIZE, 0, MAKELONG(nButtonWidth, nButtonHeight)
+ ' Send this message for backward compatibility
+ SendMessage hToolBar, TB_BUTTONSTRUCTSIZE, SIZEOF(TBBUTTON), 0
+
+ ' Calculate the size of the icon according the DPI
+ DIM cx AS LONG = 20 * pWindow->DPI \ 96
+
+ ' Create an image list for the toolbar
+ DIM hImageList AS HIMAGELIST
+ hImageList = ImageList_Create(cx, cx, ILC_COLOR32 OR ILC_MASK, 5, 0)
+ IF hImageList THEN
+ ImageList_SetBkColor(hImageList, CLR_NONE)
+ AfxGdipAddIconFromRes(hImageList, pWindow->InstanceHandle, "IMAGE_ADDIMAGE")
+ AfxGdipAddIconFromRes(hImageList, pWindow->InstanceHandle, "IMAGE_REMOVEIMAGE")
+ AfxGdipAddIconFromRes(hImageList, pWindow->InstanceHandle, "IMAGE_FORMATIMAGE")
+ AfxGdipAddIconFromRes(hImageList, pWindow->InstanceHandle, "IMAGE_ATTACHIMAGE")
+ AfxGdipAddIconFromRes(hImageList, pWindow->InstanceHandle, "IMAGE_DETACHIMAGE")
+ ' Set the normal image list
+ Toolbar_SetImageList hToolBar, hImageList
+ ' Set the hot image list with the same images than the normal one
+ Toolbar_SetHotImageList hToolBar, hImageList
+ END IF
+
+ ' Add buttons to the toolbar
+ dim as long fStyle = BTNS_BUTTON or BTNS_AUTOSIZE or BTNS_SHOWTEXT
+ Toolbar_AddButton hToolBar, 0, IDM_ADDIMAGE, 0, fStyle, 0, L(369, "Add Image")
+ Toolbar_AddSeparator hToolBar
+ Toolbar_AddButton hToolBar, 1, IDM_REMOVEIMAGE, 0, fStyle, 0, L(370, "Remove Image")
+ Toolbar_AddSeparator hToolBar
+ Toolbar_AddButton hToolBar, 2, IDM_FORMATIMAGE, 0, fStyle, 0, L(371, "Resource Format")
+ Toolbar_AddSeparator hToolBar
+ if pProp then
+ Toolbar_AddButton hToolBar, 3, IDM_ATTACHIMAGE, 0, fStyle, 0, L(372, "Attach to Control")
+ Toolbar_AddSeparator hToolBar
+ Toolbar_AddButton hToolBar, 4, IDM_DETACHIMAGE, 0, fStyle, 0, L(373, "Detach from Control")
+ end if
+
+ ' Size the toolbar
+ Toolbar_AutoSize hToolBar
+
+ dim as long nTop = pWindow->UnScaleY(AfxGetWindowHeight(hToolBar)) + 10
+
+ dim as hwnd hLV = _
+ pWindow->AddControl("LISTVIEW", , IDC_FRMIMAGEMANAGER_LISTVIEW, "", 10, nTop, 330, 430, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or LVS_REPORT Or LVS_SHOWSELALWAYS or LVS_SINGLESEL, _
+ WS_EX_LEFT Or WS_EX_CLIENTEDGE or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmImageManager_Listview_SubclassProc), IDC_FRMIMAGEMANAGER_LISTVIEW, Cast(DWORD_PTR, @pWindow))
+
+ ' Make the listview header flat
+ ListView_MakeHeaderFlat(hLV)
+
+
+ ' Add some extended styles
+ Dim dwExStyle As DWORD
+ dwExStyle = ListView_GetExtendedListViewStyle(hLV)
+ dwExStyle = dwExStyle Or LVS_EX_FULLROWSELECT Or LVS_EX_GRIDLINES Or LVS_EX_DOUBLEBUFFER Or LVS_EX_FLATSB
+ ListView_SetExtendedListViewStyle(hLV, dwExStyle)
+
+ ' Configure the ListView
+ ListView_AddColumn( hLV, 0, L(364, "Name"), pWindow->ScaleX(210) )
+ ListView_AddColumn( hLV, 1, L(374, "File Type"), pWindow->ScaleX(100) )
+
+
+ ' Add the images to the listview
+ dim pDoc as clsDocument ptr
+ dim as long nSelLine = 0
+ dim as long nextLine = 0
+
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ if (gApp.IsProjectActive = false) andalso (pDoc <> gTTabCtl.GetActiveDocumentPtr) then
+ ' For non-projects only output images related to the active form.
+ else
+ for i as long = lbound(pDoc->AllImages) to ubound(pDoc->AllImages)
+ FF_ListView_InsertItem( hLV, nextLine, 0, pDoc->AllImages(i).wszImageName )
+ FF_ListView_InsertItem( hLV, nextLine, 1, pDoc->AllImages(i).wszFormat )
+ ' If the Image being added matches the incoming ImageName then save the
+ ' insert line position so that the selection can be set to that line.
+ if pDoc->AllImages(i).wszImageName = wszImageName then nSelLine = nextLine
+ nextLine = nextLine + 1
+ next
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+
+
+ ' Add an image control
+ DIM pImageCtx AS CImageCtx = CImageCtx(pWindow, IDC_FRMIMAGEMANAGER_IMAGECTX, , 370, nTop + 30, 306, 306)
+
+ ' Add a combobox for the various image resize options.
+
+ ' Add a button without coordinates (it will be resized in WM_SIZE, below)
+ DIM hCtl AS HWND = _
+ pWindow->AddControl("COMBOBOX", , IDC_FRMIMAGEMANAGER_COMBO1, "", 356, nTop + 354, 334, 20, _
+ WS_CHILD OR WS_VISIBLE OR WS_VSCROLL OR WS_BORDER OR WS_TABSTOP OR CBS_DROPDOWNLIST OR CBS_HASSTRINGS, _
+ WS_EX_CLIENTEDGE or WS_EX_LEFT Or WS_EX_LTRREADING)
+ ComboBox_AddString( hCtl, @L(376, "Actual Size") )
+ ComboBox_AddString( hCtl, @L(165, "Apply High DPI Scaling") )
+ ComboBox_AddString( hCtl, @L(375, "Autosize") )
+ ComboBox_AddString( hCtl, @L(151, "Fit to Width") )
+ ComboBox_AddString( hCtl, @L(160, "Fit to Height") )
+ ComboBox_AddString( hCtl, @L(164, "Stretch") )
+ if pWindow->DPI > 96 then
+ ComboBox_SetCurSel( hCtl, 1 ) ' Use High DPI Scaling
+ else
+ ComboBox_SetCurSel( hCtl, 0 ) ' Actual Size
+ end if
+
+ pWindow->AddControl("BUTTON", , IDC_FRMIMAGEMANAGER_CMDFILENAME, L(0014, "Edit") & "...", 356, nTop + 380, 75, 20, _
+ WS_CHILD Or WS_VISIBLE or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("LABEL", , IDC_FRMIMAGEMANAGER_LBLFILENAME, "", 356, nTop + 400, 300, 20, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT or SS_PATHELLIPSIS, WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("GROUPBOX",, IDC_FRMIMAGEMANAGER_FRAMEPREVIEW, L(377,"Image Preview"), 356, nTop, 334, 350, _
+ WS_CHILD Or WS_VISIBLE Or BS_TEXT Or BS_LEFT Or BS_NOTIFY Or BS_GROUPBOX, _
+ WS_EX_TRANSPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ ' Set the Listview to the selected line and preview the image display
+ ListView_SelectItem(hLV, nSelLine)
+ frmImageManager_DisplayImage(pWindow->hWindow, nSelLine)
+
+ SetFocus hLV
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the frmImages CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
+
+
+
+
diff --git a/src/frmKeyboard.bi b/src/frmKeyboard.bi
index 6b446507..69801f1f 100644
--- a/src/frmKeyboard.bi
+++ b/src/frmKeyboard.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmKeyboard.bi.bak b/src/frmKeyboard.bi.bak
new file mode 100644
index 00000000..6b446507
--- /dev/null
+++ b/src/frmKeyboard.bi.bak
@@ -0,0 +1,56 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+#DEFINE IDC_FRMKEYBOARD_LIST1 1000
+#DEFINE IDC_FRMKEYBOARD_CMDMODIFY 1001
+#DEFINE IDC_FRMKEYBOARD_CMDCLEAR 1002
+#DEFINE IDC_FRMKEYBOARD_LBLCONFLICT 1003
+
+#define IDC_FRMKEYBOARDEDIT_CHKCTRL 1100
+#define IDC_FRMKEYBOARDEDIT_CHKALT 1101
+#define IDC_FRMKEYBOARDEDIT_CHKSHIFT 1102
+#define IDC_FRMKEYBOARDEDIT_CHKDISABLE 1103
+#define IDC_FRMKEYBOARDEDIT_LABEL1 1104
+#define IDC_FRMKEYBOARDEDIT_LABEL2 1105
+#define IDC_FRMKEYBOARDEDIT_LABEL3 1106
+#define IDC_FRMKEYBOARDEDIT_COMBOACCEL 1107
+#define IDC_FRMKEYBOARDEDIT_CHKDISABLED 1108
+
+TYPE KEYBINDINGS_TYPE
+ idAction as long ' IDM_* message
+ wszMsgString as CWSTR ' "IDM_SAVE", "IDM_SAVEAS", etc
+ wszCategory as CWSTR
+ wszDescription as CWSTR
+ wszDefaultKeys as CWSTR
+ wszUserKeys as CWSTR
+ bDefaultDisabled as boolean = false
+end type
+dim shared gKeys(any) as KEYBINDINGS_TYPE
+dim shared gKeysEdit as KEYBINDINGS_TYPE
+
+declare Function frmKeyboard_Show( ByVal hWndParent As HWnd ) As LRESULT
+declare function frmKeyboard_SaveKeyBindings( byval wszFilename as CWSTR ) as long
+declare function frmKeyBoard_AddKeyBinding( _
+ byval wszCategory as CWSTR, _
+ byval idAction as long, _
+ byval wszMsgString as CWSTR, _
+ byval wszDescription as CWSTR, _
+ byval wszDefaultKeys as CWSTR, _
+ byval wszUserKeys as CWSTR, _
+ byval bDisabled as boolean _
+ ) as long
+declare function frmKeyboard_CheckForKeyConflict ( byval wszKeys as CWSTR, byval nSkipIndex as long ) as long
+
diff --git a/src/frmKeyboard.inc b/src/frmKeyboard.inc
index 6c9b2fd2..04e33ce8 100644
--- a/src/frmKeyboard.inc
+++ b/src/frmKeyboard.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmKeyboard.inc.bak b/src/frmKeyboard.inc.bak
new file mode 100644
index 00000000..6c9b2fd2
--- /dev/null
+++ b/src/frmKeyboard.inc.bak
@@ -0,0 +1,737 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "clsConfig.bi"
+#include once "frmKeyboard.bi"
+
+
+' ========================================================================================
+' Save the gKeys() keybinding array to disk file
+' ========================================================================================
+function frmKeyboard_SaveKeyBindings( byval wszFilename as CWSTR ) as long
+ dim pStream AS CTextStream
+ if pStream.Create( wszFilename ) = S_OK then
+ dim as CWSTR wszLine
+ for i as long = lbound(gKeys) to ubound(gKeys)
+ wszLine = gKeys(i).wszMsgString
+
+ if gKeys(i).bDefaultDisabled then
+ wszLine = wszLine & "(DISABLED)"
+ end if
+
+ wszLine = wszLine & ":" & gKeys(i).wszUserKeys
+ pStream.WriteLine wszLine
+ next
+ pStream.Close
+ end if
+ function = 0
+end function
+
+
+' ========================================================================================
+' Load a keybinding into the global array
+' ========================================================================================
+function frmKeyBoard_AddKeyBinding( _
+ byval wszCategory as CWSTR, _
+ byval idAction as long, _
+ byval wszMsgString as CWSTR, _
+ byval wszDescription as CWSTR, _
+ byval wszDefaultKeys as CWSTR, _
+ byval wszUserKeys as CWSTR, _
+ byval bDisabled as boolean _
+ ) as long
+
+ ' Search the array to see if the id exists. If it does then update
+ ' that binding, otherwise, add it to the array.
+ dim as boolean bFound = false
+ dim as long nFoundIdx = -1
+
+ for i as long = lbound(gKeys) to ubound(gKeys)
+ if gKeys(i).wszMsgString = wszMsgString then
+ bFound = true
+ nFoundIdx = i
+ exit for
+ end if
+ next
+
+ if bFound = false then
+ nFoundIdx = ubound(gKeys) + 1
+ redim preserve gKeys(nFoundIdx) as KEYBINDINGS_TYPE
+ end if
+
+ with gKeys(nFoundIdx)
+ if bFound = false then ' don't update existing system entries
+ .idAction = idAction
+ .wszMsgString = wszMsgString
+ .wszCategory = wszCategory
+ .wszDescription = wszDescription
+ .wszDefaultKeys = wszDefaultKeys
+ else
+ ' Existing entry found which means we are reading the existing keybindings
+ ' file. Update the entry with any user defined keybinding or if the user has
+ ' disabled the Default keyboard shortcut.
+ .wszUserKeys = wszUserKeys
+ .bDefaultDisabled = bDisabled
+ end if
+ end with
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' ' Create the default keyboard bindings / shortcut mappings
+' ========================================================================================
+function frmKeyboard_CreateDefaultKeyBindings() as long
+ '' FILE MENU
+ frmKeyBoard_AddKeyBinding( "File", IDM_FILENEW, "IDM_FILENEW", "New file", "Ctrl+N", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_FILEOPEN, "IDM_FILEOPEN", "Open one or more files", "Ctrl+O", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_FILEOPENTEMPLATES, "IDM_FILEOPENTEMPLATES", "Open templates", "Ctrl+T", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_FILECLOSE, "IDM_FILECLOSE", "Close file", "Ctrl+W", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_FILECLOSEALL, "IDM_FILECLOSEALL", "Close all files", "Ctrl+Shift+W", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_FILESAVE, "IDM_FILESAVE", "Save file", "Ctrl+S", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_FILESAVEAS, "IDM_FILESAVEAS", "Save file as a different name", "F12", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_FILESAVEALL, "IDM_FILESAVEALL", "Save all files", "Ctrl+Shift+S", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_AUTOSAVE, "IDM_AUTOSAVE", "Toggle Auto Save", "", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_LOADSESSION, "IDM_LOADSESSION", "Load session", "", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_SAVESESSION, "IDM_SAVESESSION", "Save session", "", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_KEYBOARDSHORTCUTS, "IDM_KEYBOARDSHORTCUTS", "Keyboard shortcuts", "Ctrl+K", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_USERTOOLSDIALOG, "IDM_USERTOOLSDIALOG", "User tools", "Ctrl+F7", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_OPTIONSDIALOG, "IDM_OPTIONSDIALOG", "Environment options", "Shift+F7", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_BUILDCONFIG, "IDM_BUILDCONFIG", "Build configurations", "F7", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_USERSNIPPETS, "IDM_USERSNIPPETS", "User code snippets", "Ctrl+Shift+F7", "", false )
+ frmKeyBoard_AddKeyBinding( "File", IDM_EXIT, "IDM_EXIT", "Exit application", "Alt+F4", "", false )
+
+ '' EDIT MENU
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_UNDO, "IDM_UNDO", "Undo", "Ctrl+Z", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_REDO, "IDM_REDO", "Redo", "Ctrl+E", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_CUT, "IDM_CUT", "Cut selection to the clipboard", "Ctrl+X", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_COPY, "IDM_COPY", "Copy selection to the clipboard", "Ctrl+C", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_PASTE, "IDM_PASTE", "Paste clipboard contents", "Ctrl+V", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_DELETELINE, "IDM_DELETELINE", "Delete the current editor line", "Ctrl+Y", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_FIND, "IDM_FIND", "Find", "Ctrl+F", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_FINDINFILES, "IDM_FINDINFILES", "Find in files", "Ctrl+Shift+F", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_REPLACE, "IDM_REPLACE", "Replace", "Ctrl+H", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_DUPLICATELINE, "IDM_DUPLICATELINE", "Duplicate line", "Ctrl+D", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_MOVELINEUP, "IDM_MOVELINEUP", "Move line up", "Alt+Up", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_MOVELINEDOWN, "IDM_MOVELINEDOWN", "Move line down", "Alt+Down", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_COMMENTBLOCK, "IDM_COMMENTBLOCK", "Comment block", "Ctrl+/", "", false ) 'VK_OEM_2
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_UNCOMMENTBLOCK, "IDM_UNCOMMENTBLOCK", "UnComment block", "Ctrl+Shift+/", "", false ) ' VK_OEM_2
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_SELECTLINE, "IDM_SELECTLINE", "Select line", "Ctrl+L", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_SELECTALL, "IDM_SELECTALL", "Select all", "Ctrl+A", "", false )
+ ' The following are non-visual (no topmenu item)
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_FINDNEXTACCEL, "IDM_FINDNEXTACCEL", "Find next", "F3", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_FINDPREVACCEL, "IDM_FINDPREVACCEL", "Find previous", "Shift+F3", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_INDENTBLOCK, "IDM_INDENTBLOCK", "Indent block", "TAB", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_UNINDENTBLOCK, "IDM_UNINDENTBLOCK", "UnIndent block", "Shift+TAB", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_INSERTFILE, "IDM_INSERTFILE", "Insert file", "Ctrl+I", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_TOUPPERCASE, "IDM_TOUPPERCASE", "Change selection to uppercase", "Ctrl+Alt+U", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_TOLOWERCASE, "IDM_TOLOWERCASE", "Change selection to lowercase", "Ctrl+Alt+L", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_TOMIXEDCASE, "IDM_TOMIXEDCASE", "Change selection to mixedcase", "Ctrl+Alt+X", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_NEWLINEBELOWCURRENT, "IDM_NEWLINEBELOWCURRENT", "Insert new line below current line", "Ctrl+Enter", "", false )
+ frmKeyBoard_AddKeyBinding( "Edit", IDM_SETFOCUSEDITOR, "IDM_SETFOCUSEDITOR", "Set keyboard focus to the editing window", "Ctrl+Tilde", "", false ) ' VK_OEM_3
+
+ '' SEARCH MENU
+ frmKeyBoard_AddKeyBinding( "Search", IDM_DEFINITION, "IDM_DEFINITION", "Goto the sub/function definition", "F6", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_LASTPOSITION, "IDM_LASTPOSITION", "Goto previous file position", "Shift+F6", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTONEXTFUNCTION, "IDM_GOTONEXTFUNCTION", "Goto next sub/function", "Ctrl+PgDn", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTOPREVFUNCTION, "IDM_GOTOPREVFUNCTION", "Goto previous sub/function", "Ctrl+PgUp", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTOHEADERFILE, "IDM_GOTOHEADERFILE", "Goto header file", "Ctrl+Shift+H", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTOSOURCEFILE, "IDM_GOTOSOURCEFILE", "Goto code file", "Ctrl+Shift+C", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTOMAINFILE, "IDM_GOTOMAINFILE", "Goto main file", "Ctrl+Shift+M", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTORESOURCEFILE, "IDM_GOTORESOURCEFILE", "Goto resource file", "Ctrl+Shift+R", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_BOOKMARKTOGGLE, "IDM_BOOKMARKTOGGLE", "Toggle bookmark", "Ctrl+F2", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_BOOKMARKNEXT, "IDM_BOOKMARKNEXT", "Goto the next bookmark", "F2", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_BOOKMARKPREV, "IDM_BOOKMARKPREV", "Goto the previous bookmark", "Shift+F2", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_BOOKMARKCLEARALL, "IDM_BOOKMARKCLEARALL", "Clear bookmarks", "Ctrl+Shift+F2", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTO, "IDM_GOTO", "Goto line", "Ctrl+G", "", false )
+ ' The following are non-visual (no topmenu item)
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTONEXTTAB, "IDM_GOTONEXTTAB", "Goto next open editor tab", "Ctrl+Tab", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTOPREVTAB, "IDM_GOTOPREVTAB", "Goto previous open editor tab", "Ctrl+Shift+Tab", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTONEXTCOMPILEERROR, "IDM_GOTONEXTCOMPILEERROR", "Goto next compile error", "Ctrl+\", "", false )
+ frmKeyBoard_AddKeyBinding( "Search", IDM_GOTOPREVCOMPILEERROR, "IDM_GOTOPREVCOMPILEERROR", "Goto previous compile error", "Ctrl+Shift+\", "", false)
+
+ '' VIEW MENU
+ frmKeyBoard_AddKeyBinding( "View", IDM_VIEWEXPLORER, "IDM_VIEWEXPLORER", "View Explorer window", "F9", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_VIEWOUTPUT, "IDM_VIEWOUTPUT", "View Output window", "Ctrl+F9", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_FUNCTIONLIST, "IDM_FUNCTIONLIST", "View Function List", "F4", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_BOOKMARKSLIST, "IDM_BOOKMARKSLIST", "View Bookmarks List", "Shift+F4", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_ZOOMIN, "IDM_ZOOMIN", "Zoom in", "Ctrl+Plus", "", false ) ' VK_OEM_PLUS
+ frmKeyBoard_AddKeyBinding( "View", IDM_ZOOMOUT, "IDM_ZOOMOUT", "Zoom out", "Ctrl+Minus", "", false ) ' VK_OEM_MINUS
+ frmKeyBoard_AddKeyBinding( "View", IDM_FOLDTOGGLE, "IDM_FOLDTOGGLE", "Toggle current fold point", "F8", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_FOLDBELOW, "IDM_FOLDBELOW", "Fold current line and all below", "Ctrl+F8", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_FOLDALL, "IDM_FOLDALL", "Fold all lines", "Shift+F8", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_UNFOLDALL, "IDM_UNFOLDALL", "Unfold all lines", "Ctrl+Shift+F8", "", false )
+ ' The following are non-visual (no topmenu item)
+ frmKeyBoard_AddKeyBinding( "View", IDM_VIEWNOTES, "IDM_VIEWNOTES", "Notes for this file or project", "", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_VIEWTODO, "IDM_VIEWTODO", "List of TODO's for this file or project", "", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_EXPLORER_EXPANDALL, "IDM_EXPLORER_EXPANDALL", "Expand all nodes in the Explorer window", "", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_EXPLORER_COLLAPSEALL, "IDM_EXPLORER_COLLAPSEALL", "Collapse all nodes in the Explorer window", "", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_FUNCTIONS_EXPANDALL, "IDM_FUNCTIONS_EXPANDALL", "Expand all nodes in the Function List window", "", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_FUNCTIONS_COLLAPSEALL, "IDM_FUNCTIONS_COLLAPSEALL", "Collapse all nodes in the Function List window", "", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_BOOKMARKS_EXPANDALL, "IDM_BOOKMARKS_EXPANDALL", "Expand all nodes in the Bookmarks window", "", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_BOOKMARKS_COLLAPSEALL, "IDM_BOOKMARKS_COLLAPSEALL", "Collapse all nodes in the Bookmarks window", "", "", false )
+ frmKeyBoard_AddKeyBinding( "View", IDM_CLOSEPANEL, "IDM_CLOSEPANEL", "Close left side panel", "", "", false )
+
+ '' PROJECT MENU
+ frmKeyBoard_AddKeyBinding( "Project", IDM_PROJECTNEW, "IDM_PROJECTNEW", "New project", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Project", IDM_PROJECTSAVE, "IDM_PROJECTSAVE", "Save project", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Project", IDM_PROJECTSAVEAS, "IDM_PROJECTSAVEAS", "Save project as a different name ", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Project", IDM_PROJECTOPEN, "IDM_PROJECTOPEN", "Open project", "F11", "", false )
+ frmKeyBoard_AddKeyBinding( "Project", IDM_PROJECTFILESADD, "IDM_PROJECTFILESADD", "Add files to project", "Ctrl+F11", "", false )
+ frmKeyBoard_AddKeyBinding( "Project", IDM_PROJECTCLOSE, "IDM_PROJECTCLOSE", "Close project", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Project", IDM_PROJECTOPTIONS, "IDM_PROJECTOPTIONS", "Project options", "", "", false )
+
+ '' COMPILE MENU
+ frmKeyBoard_AddKeyBinding( "Compile", IDM_BUILDEXECUTE, "IDM_BUILDEXECUTE", "Build and Execute", "F5", "", false )
+ frmKeyBoard_AddKeyBinding( "Compile", IDM_COMPILE, "IDM_COMPILE", "Compile the project or the current active file", "Ctrl+F5", "", false )
+ frmKeyBoard_AddKeyBinding( "Compile", IDM_REBUILDALL, "IDM_REBUILDALL", "Rebuild all", "Ctrl+Alt+F5", "", false )
+ frmKeyBoard_AddKeyBinding( "Compile", IDM_QUICKRUN, "IDM_QUICKRUN", "Quick Run current active file", "Ctrl+Shift+F5", "", false )
+ frmKeyBoard_AddKeyBinding( "Compile", IDM_RUNEXE, "IDM_RUNEXE", "Run executable", "Shift+F5", "", false )
+ frmKeyBoard_AddKeyBinding( "Compile", IDM_COMMANDLINE, "IDM_COMMANDLINE", "Command line", "", "", false )
+
+ '' DESIGNER MENU
+ frmKeyBoard_AddKeyBinding( "Designer", IDM_NEWFORM, "IDM_NEWFORM", "New form", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Designer", IDM_VIEWTOOLBOX, "IDM_VIEWTOOLBOX", "View toolbox", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Designer", IDM_MENUEDITOR, "IDM_MENUEDITOR", "Menu editor", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Designer", IDM_TOOLBAREDITOR, "IDM_TOOLBAREDITOR", "Toolbar editor", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Designer", IDM_STATUSBAREDITOR, "IDM_STATUSBAREDITOR", "Statusbar editor", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Designer", IDM_IMAGEMANAGER, "IDM_IMAGEMANAGER", "Image manager", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Designer", IDM_SNAPLINES, "IDM_SNAPLINES", "Enable snap lines", "", "", false )
+ frmKeyBoard_AddKeyBinding( "Designer", IDM_LOCKCONTROLS, "IDM_LOCKCONTROLS", "Lock controls", "", "", false )
+
+ '' HELP MENU
+ frmKeyBoard_AddKeyBinding( "Help", IDM_HELP, "IDM_HELP", "FreeBasic Help (context sensitive help)", "F1", "", false )
+
+ ' Load the keybindings settings file. This will update the gKeys array with any
+ ' user defined key mappings.
+ dim as CWSTR wszFilename = AfxGetExePathName & "Settings\keybindings.ini"
+
+ dim pStream AS CTextStream
+
+ if pStream.Open( wszFilename ) = S_OK then
+ do until pStream.EOS
+ dim as CWSTR wst = pStream.ReadLine
+ wst = trim(wst)
+ if len(wst) = 0 then Continue Do
+
+ ' Each keybinding entry has fields separated by a colon
+ if instr( wst, ":" ) = 0 then continue do
+
+ dim as CWSTR wszMsgString = AfxStrParse(wst, 1, ":")
+
+ ' The MsgString could have an embedded (DISABLED) flag indicating that the
+ ' default key combination should be disabled.
+ dim as boolean bDisabled = false
+ dim as long i
+ i = instr(wszMsgString, "(DISABLED)")
+ if i then
+ bDisabled = true
+ wszMsgString = left(wszMsgString, i-1 )
+ end if
+
+ dim as CWSTR wszUserKeys = trim(AfxStrParse(wst, 2, ":"))
+ frmKeyBoard_AddKeyBinding( "", 0, wszMsgString, "", "", wszUserKeys, bDisabled )
+ Loop
+ pStream.Close
+ end if
+
+ ' Lastly, save the keybindings settings file (we do this in case the file never existed
+ ' in the first place so now we will have a default keybindings file).
+ frmKeyboard_SaveKeyBindings( wszFilename )
+
+ function = 0
+end function
+
+' ========================================================================================
+' Convert a virtual key string (Ctrl, Alt, Shift) to virtual key value
+' ========================================================================================
+function frmKeyboard_VirtKeyToValue( byval wszString as CWSTR ) as long
+ select case ucase(wszString)
+ case "CTRL": return FCONTROL
+ case "ALT": return FALT
+ case "SHIFT": return FSHIFT
+ end select
+ function = 0
+end function
+
+' ========================================================================================
+' Convert an accelerator key string (F1, TAB, "A", etc..) to virtual key value
+' ========================================================================================
+function frmKeyboard_AccelKeyToValue( byval wszString as CWSTR ) as long
+ select case ucase(wszString)
+ case "BACKSPACE": return VK_BACK
+ case "TAB": return VK_TAB
+ case "ENTER": return VK_RETURN
+ case "ESCAPE": return VK_ESCAPE
+ case "SPACEBAR": return VK_SPACE
+ case "PGUP": return VK_PRIOR
+ case "PGDN": return VK_NEXT
+ case "END": return VK_END
+ case "HOME": return VK_HOME
+ case "LEFT": return VK_LEFT
+ case "UP": return VK_UP
+ case "RIGHT": return VK_RIGHT
+ case "DOWN": return VK_DOWN
+ case "INS": return VK_INSERT
+ case "DEL": return VK_DELETE
+ case "NUMPAD0": return VK_NUMPAD0
+ case "NUMPAD1": return VK_NUMPAD1
+ case "NUMPAD2": return VK_NUMPAD2
+ case "NUMPAD3": return VK_NUMPAD3
+ case "NUMPAD4": return VK_NUMPAD4
+ case "NUMPAD5": return VK_NUMPAD5
+ case "NUMPAD6": return VK_NUMPAD6
+ case "NUMPAD7": return VK_NUMPAD7
+ case "NUMPAD8": return VK_NUMPAD8
+ case "NUMPAD9": return VK_NUMPAD9
+ case "NUMPAD*": return VK_MULTIPLY
+ case "NUMPAD+": return VK_ADD
+ case "NUMPAD-": return VK_SUBTRACT
+ case "NUMPAD.": return VK_DECIMAL
+ case "NUMPAD/": return VK_DIVIDE
+ case "F1": return VK_F1
+ case "F2": return VK_F2
+ case "F3": return VK_F3
+ case "F4": return VK_F4
+ case "F5": return VK_F5
+ case "F6": return VK_F6
+ case "F7": return VK_F7
+ case "F8": return VK_F8
+ case "F9": return VK_F9
+ case "F10": return VK_F10
+ case "F11": return VK_F11
+ case "F12": return VK_F12
+ case "+", "PLUS": return VK_OEM_PLUS
+ case ",", "COMMA": return VK_OEM_COMMA
+ case "-", "MINUS": return VK_OEM_MINUS
+ case ".", "PERIOD": return VK_OEM_PERIOD
+ case ";", ":", "SEMICOLON", "COLON": return VK_OEM_1
+ case "/", "?", "FORWARDSLASH", "QUESTIONMARK": return VK_OEM_2
+ case "`", "~", "BACKTICK", "TILDE": return VK_OEM_3
+ case "[", "{", "OPENSQUAREBRACKET", "OPENCURLYBRACE": return VK_OEM_4
+ case "\", "|", "BACKSLASH", "PIPE": return VK_OEM_5
+ case "]", "}", "CLOSESQUAREBRACKET", "CLOSECURLYBRACE": return VK_OEM_6
+ case "'", chr(34), "SINGLEQUOTE", "DOUBLEQUOTE": return VK_OEM_7
+ case "0" to "9": return asc(wszString)
+ case "A" to "Z": return asc(wszString)
+ end select
+ function = 0
+end function
+
+
+' ========================================================================================
+' Build the main keyboard accelerator table
+' ========================================================================================
+Function frmKeyboard_BuildAcceleratorTable() As long
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ if pWindow = 0 then exit function
+
+ ' Create mapping array that equates the string representation of the
+ ' IDM_* messages to their values. We use that array we saving and
+ ' restoring the keybindings from file. We can not use the literal IDM
+ ' value because if we modify any of the IDM source code values then the
+ ' mappings stored in the keybindings file will instantly be incorrect.
+
+ ' Create the default keyboard bindings / shortcut mappings
+ frmKeyboard_CreateDefaultKeyBindings()
+
+ ' Destroy any existing accelerator table
+ pWindow->DestroyAcceleratorTable
+
+ ' The following ALWAYS get created and can not be altered because they are shortcuts
+ ' to activate each of the top menus.
+ pWindow->AddAccelerator( FVIRTKEY Or FALT, VK_F, IDC_MENUBAR_FILE )
+ pWindow->AddAccelerator( FVIRTKEY Or FALT, VK_E, IDC_MENUBAR_EDIT )
+ pWindow->AddAccelerator( FVIRTKEY Or FALT, VK_S, IDC_MENUBAR_SEARCH )
+ pWindow->AddAccelerator( FVIRTKEY Or FALT, VK_V, IDC_MENUBAR_VIEW )
+ pWindow->AddAccelerator( FVIRTKEY Or FALT, VK_P, IDC_MENUBAR_PROJECT )
+ pWindow->AddAccelerator( FVIRTKEY Or FALT, VK_C, IDC_MENUBAR_COMPILE )
+ pWindow->AddAccelerator( FVIRTKEY Or FALT, VK_D, IDC_MENUBAR_DESIGNER )
+ pWindow->AddAccelerator( FVIRTKEY Or FALT, VK_H, IDC_MENUBAR_HELP )
+
+ ' Create the accelerator table based on the data in the gKeys() array
+ for i as long = lbound(gKeys) to ubound(gKeys)
+
+ dim as CWSTR wszKeys = gKeys(i).wszDefaultKeys
+
+ ' wszUserKeys will override the wszDefaultKeys entry
+ if len(gKeys(i).wszUserKeys) then
+ wszKeys = gKeys(i).wszUserKeys
+ else
+ ' Only create the default keyboard short if it has not been disabled
+ if gKeys(i).bDefaultDisabled then
+ wszKeys = ""
+ end if
+ end if
+
+ ' No need to proceed further if no User defined shortcut and Default keys disabled
+ if len(wszKeys) = 0 then continue for
+
+ ' convert the key combination into something that AddAcelerator can understand
+ ' F5
+ ' TAB
+ ' Alt+F4
+ ' Shift+F5
+ ' Ctrl+F5
+ ' Ctrl+Shift+F5
+ ' etc...
+
+ ' Parse for + signs
+ dim as long nCount = AfxStrParseCount( wszKeys, "+" )
+ dim as long nVirtValue = FVIRTKEY
+ dim as long nAccelValue = 0
+
+ for ii as long = nCount to 1 step -1
+ ' The accelerator key will always be the last parse regardless of
+ ' number of items in the string
+ dim as CWSTR wszString = AfxStrParse( wszKeys, ii, "+" )
+ if ii = nCount then
+ nAccelValue = frmKeyboard_AccelKeyToValue( wszString )
+ else
+ nVirtValue = nVirtValue or frmKeyboard_VirtKeyToValue( wszString )
+ end if
+ next
+ if nAccelValue <> 0 then ' value can be zero if no default or user key defined
+ pWindow->AddAccelerator( nVirtValue, nAccelValue, gKeys(i).idAction )
+ end if
+ next
+
+ pWindow->CreateAcceleratorTable()
+
+ function = 0
+End Function
+
+' ========================================================================================
+' Check for keybinding conflict with other keys and display warning label message
+' ========================================================================================
+Function frmKeyboard_CheckForKeyConflict ( _
+ byval wszKeys as CWSTR, _
+ byval nSkipIndex as long _
+ ) as long
+
+ dim as CWSTR wszMessage
+ dim as CWSTR wszCheck
+
+ for i as long = lbound(gKeys) to ubound(gKeys)
+ if i = nSkipIndex then continue for
+ ' If user binding exists then check that b/c it would override the default binding
+ wszCheck = iif( len(gKeys(i).wszUserKeys), gKeys(i).wszUserKeys, gKeys(i).wszDefaultKeys )
+ if len(wszCheck) = 0 then continue for
+ if wszKeys = wszCheck then
+ wszMessage = "Conflict: " & gKeys(i).wszDescription & " (" & wszKeys & ")"
+ exit for
+ end if
+ next
+
+ dim as HWND hCtrl = GetDlgItem( HWND_FRMKEYBOARD, IDC_FRMKEYBOARD_LBLCONFLICT )
+ AfxSetWindowText( hCtrl, wszMessage )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmKeyboard
+' ========================================================================================
+Function frmKeyboard_OnCreate( _
+ ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_NOTIFY message for window/dialog: frmMain
+' ========================================================================================
+function frmKeyboard_OnNotify( _
+ byval HWnd as HWnd, _
+ byval id as long, _
+ byval pNMHDR as NMHDR ptr _
+ ) as LRESULT
+
+ select case pNMHDR->code
+
+ case LVN_ITEMCHANGED
+ if id = IDC_FRMKEYBOARD_LIST1 then
+ Dim As Long nCurSel = ListView_GetSelection( HWND_FRMKEYBOARD_LISTVIEW )
+ If nCurSel < 0 Then exit function
+ dim as CWSTR wszKeys = iif( len(gKeys(nCurSel).wszUserKeys), _
+ gKeys(nCurSel).wszUserKeys, gKeys(nCurSel).wszDefaultKeys )
+ frmKeyboard_CheckForKeyConflict( wszKeys, nCurSel )
+ end if
+
+ end select
+
+ Function = 0
+
+end function
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmKeyboard
+' ========================================================================================
+Function frmKeyboard_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+
+ case IDC_FRMKEYBOARD_CMDMODIFY
+ if codeNotify = BN_CLICKED THEN
+ PostMessage( HWnd, MSG_USER_SHOW_KEYBOARDEDIT, 0, 0 )
+ end if
+
+ case IDC_FRMKEYBOARD_CMDCLEAR
+ if codeNotify = BN_CLICKED THEN
+ Dim As Long nCurSel = ListView_GetSelection( HWND_FRMKEYBOARD_LISTVIEW )
+ If nCurSel < 0 Then exit function
+ gKeys(nCurSel).wszUserKeys = ""
+ dim wszText as wstring * MAX_PATH = gKeys(nCurSel).wszUserKeys
+ FF_ListView_SetItemText( HWND_FRMKEYBOARD_LISTVIEW, nCurSel, 5, wszText, MAX_PATH )
+ frmKeyboard_CheckForKeyConflict( "", nCurSel )
+ ListView_SelectItem( HWND_FRMKEYBOARD_LISTVIEW, nCurSel )
+ SetFocus( HWND_FRMKEYBOARD_LISTVIEW )
+ end if
+
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmKeyboard
+' ========================================================================================
+Function frmKeyboard_OnClose( byval HWnd As HWnd ) As LRESULT
+ dim as CWSTR wszFilename = AfxGetExePathName & "Settings\keybindings.ini"
+ frmKeyboard_SaveKeyBindings( wszFilename )
+ frmKeyboard_BuildAcceleratorTable
+
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow( HWnd )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmKeyboard
+' ========================================================================================
+Function frmKeyboard_OnDestroy( byval HWnd As HWnd) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed ListBox window.
+' ========================================================================================
+Function frmKeyboard_ListView_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+
+ ' Convert our ENTER key presses into LBUTTONDBLCLK to process them similarly
+ If (uMsg = WM_KEYUP) And (Loword(wParam) = VK_RETURN) Then uMsg = WM_LBUTTONDBLCLK
+
+ Select Case uMsg
+
+ Case WM_LBUTTONDBLCLK
+ PostMessage( GetParent(HWnd), MSG_USER_SHOW_KEYBOARDEDIT, 0, 0 )
+ Exit Function
+
+ Case WM_CHAR ' prevent the annoying beep
+ If wParam = VK_RETURN Then Return 0
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( HWnd, @frmKeyboard_ListView_SubclassProc, uIdSubclass )
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc( HWnd, uMsg, wParam, lParam )
+
+End Function
+
+' ========================================================================================
+' frmKeyboard Window procedure
+' ========================================================================================
+Function frmKeyboard_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmKeyboard_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmKeyboard_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmKeyboard_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmKeyboard_OnCommand)
+ HANDLE_MSG (HWnd, WM_NOTIFY, frmKeyboard_OnNotify)
+
+ case MSG_USER_SHOW_KEYBOARDEDIT
+ Dim As Long nCurSel = ListView_GetSelection( HWND_FRMKEYBOARD_LISTVIEW )
+ If nCurSel < 0 Then Return 0
+ dim wszText as wstring * MAX_PATH
+ FF_ListView_GetItemText( HWND_FRMKEYBOARD_LISTVIEW, nCurSel, 0, @wszText, MAX_PATH)
+ dim as long idx = val( wszText )
+ if (idx >= lbound(gKeys)) and (idx <= ubound(gKeys)) then
+ gKeysEdit = gKeys(idx)
+ frmKeyboardEdit_Show( Hwnd )
+ gKeys(idx) = gKeysEdit
+
+ ' Update the Default keys column because it could have changed (DISABLED)
+ wszText = gKeysEdit.wszDefaultKeys
+ if gKeys(idx).bDefaultDisabled then
+ wszText = wszText & " (DISABLED)"
+ end if
+ FF_ListView_SetItemText( HWND_FRMKEYBOARD_LISTVIEW, nCurSel, 4, wszText, MAX_PATH )
+
+ ' Update the UserKeys column because it could have changed
+ wszText = gKeysEdit.wszUserKeys
+ FF_ListView_SetItemText( HWND_FRMKEYBOARD_LISTVIEW, nCurSel, 5, wszText, MAX_PATH )
+ frmKeyboard_CheckForKeyConflict( wszText, nCurSel )
+ end if
+ ListView_SelectItem( HWND_FRMKEYBOARD_LISTVIEW, nCurSel )
+ SetFocus( HWND_FRMKEYBOARD_LISTVIEW )
+
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+End Function
+
+
+' ========================================================================================
+' frmKeyboard_Show
+' ========================================================================================
+Function frmKeyboard_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ dim hCtrl as HWnd
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ HWND_FRMKEYBOARD = _
+ pWindow->Create(hWndParent, L(220,"Keyboard Shortcuts"), _
+ @frmKeyboard_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT )
+ pWindow->SetClientSize(622, 436)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ HWND_FRMKEYBOARD_LISTVIEW = _
+ pWindow->AddControl("LISTVIEW", , IDC_FRMKEYBOARD_LIST1, "", 0, 0, 622, 364, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or LVS_REPORT Or LVS_SHOWSELALWAYS or LVS_SINGLESEL, _
+ WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmKeyboard_ListView_SubclassProc), IDC_FRMKEYBOARD_LIST1, Cast(DWORD_PTR, @pWindow))
+
+ ' Make the listview header flat
+ ListView_MakeHeaderFlat( HWND_FRMKEYBOARD_LISTVIEW )
+
+ ' Add some extended styles
+ Dim dwExStyle As DWORD
+ dwExStyle = ListView_GetExtendedListViewStyle( HWND_FRMKEYBOARD_LISTVIEW )
+ dwExStyle = dwExStyle Or LVS_EX_FULLROWSELECT Or LVS_EX_GRIDLINES Or LVS_EX_DOUBLEBUFFER Or LVS_EX_FLATSB
+ ListView_SetExtendedListViewStyle( HWND_FRMKEYBOARD_LISTVIEW, dwExStyle )
+
+ ' Configure the ListView
+ dim as HWND hLV = HWND_FRMKEYBOARD_LISTVIEW
+ ListView_AddColumn( hLV, 0, "idMenu", 0 ) ' hidden
+ ListView_AddColumn( hLV, 1, "", pWindow->ScaleX(10) ) ' left padding
+ ListView_AddColumn( hLV, 2, "Category", pWindow->ScaleX(90) )
+ ListView_AddColumn( hLV, 3, "Description", pWindow->ScaleX(250) )
+ ListView_AddColumn( hLV, 4, "Default Keys", pWindow->ScaleX(125) )
+ ListView_AddColumn( hLV, 5, "User Keys", pWindow->ScaleX(125) )
+
+ pWindow->AddControl("BUTTON", , IDC_FRMKEYBOARD_CMDMODIFY, L(433, "Modify"), 8, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMKEYBOARD_CMDCLEAR, L(434, "Clear"), 90, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(161,"Close"), 536, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ hCtrl = pWindow->AddControl("LABEL", , IDC_FRMKEYBOARD_LBLCONFLICT, "", 168, 394, 350, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_CENTER Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, true )
+
+ ' Load the listview with these temp keys
+ for i as long = lbound(gKeys) to ubound(gKeys)
+ FF_ListView_InsertItem( hLV, i, 0, str(i) ) ' array index (hidden column)
+ FF_ListView_InsertItem( hLV, i, 1, "" )
+ FF_ListView_InsertItem( hLV, i, 2, gKeys(i).wszCategory )
+ FF_ListView_InsertItem( hLV, i, 3, gKeys(i).wszDescription )
+ dim as CWSTR wszTemp = gKeys(i).wszDefaultKeys
+ if gKeys(i).bDefaultDisabled then
+ wszTemp = wszTemp & " (DISABLED)"
+ end if
+ FF_ListView_InsertItem( hLV, i, 4, wszTemp )
+ FF_ListView_InsertItem( hLV, i, 5, gKeys(i).wszUserKeys )
+ next
+
+ AfxSetWindowFont( hLV, ghStatusBar.hFontStatusBar, true )
+
+ ListView_SelectItem( hLV, 0 )
+ SetFocus( hLV )
+
+ ShowWindow( HWND_FRMKEYBOARD, SW_SHOW )
+ UpdateWindow HWND_FRMKEYBOARD
+
+ ' Message loop (modal)
+ DIM uMsg AS MSG
+ WHILE GetMessage( @uMsg, NULL, 0, 0 )
+ if (uMsg.message = WM_KEYDOWN) andalso (uMsg.wParam = VK_ESCAPE) then
+ SendMessage( HWND_FRMKEYBOARD, WM_CLOSE, 0, 0 )
+ end if
+ IF IsDialogMessage( HWND_FRMKEYBOARD, @uMsg ) = 0 THEN
+ TranslateMessage( @uMsg )
+ DispatchMessage( @uMsg )
+ end if
+ WEND
+ function = uMsg.wParam
+
+ ' Delete the CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
diff --git a/src/frmKeyboardEdit.inc b/src/frmKeyboardEdit.inc
index 8597b0f2..17e290bb 100644
--- a/src/frmKeyboardEdit.inc
+++ b/src/frmKeyboardEdit.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmKeyboardEdit.inc.bak b/src/frmKeyboardEdit.inc.bak
new file mode 100644
index 00000000..8597b0f2
--- /dev/null
+++ b/src/frmKeyboardEdit.inc.bak
@@ -0,0 +1,341 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmKeyboard.bi"
+
+
+' ========================================================================================
+' Generate the keybind string based on the selected controls
+' ========================================================================================
+function frmKeyboardEdit_GenerateKeyBinding() as CWSTR
+ dim as HWND hCtrl
+ dim as CWSTR wszKeys
+ dim as CWSTR wszAccel
+
+ hCtrl = GetDlgItem( HWND_FRMKEYBOARDEDIT, IDC_FRMKEYBOARDEDIT_CHKCTRL )
+ if Button_GetCheck(hCtrl) = BST_CHECKED then wszKeys = "Ctrl+"
+ hCtrl = GetDlgItem( HWND_FRMKEYBOARDEDIT, IDC_FRMKEYBOARDEDIT_CHKALT )
+ if Button_GetCheck(hCtrl) = BST_CHECKED then wszKeys = wszKeys & "Alt+"
+ hCtrl = GetDlgItem( HWND_FRMKEYBOARDEDIT, IDC_FRMKEYBOARDEDIT_CHKSHIFT )
+ if Button_GetCheck(hCtrl) = BST_CHECKED then wszKeys = wszKeys & "Shift+"
+
+ hCtrl = GetDlgItem( HWND_FRMKEYBOARDEDIT, IDC_FRMKEYBOARDEDIT_COMBOACCEL )
+ dim as long nCursel = ComboBox_GetCurSel( hCtrl )
+ wszAccel = AfxGetComboBoxText( hCtrl, nCurSel )
+ if wszAccel = "None" then
+ wszKeys = ""
+ else
+ wszKeys = wszKeys & wszAccel
+ end if
+
+ return wszKeys
+end function
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmKeyboardEdit
+' ========================================================================================
+Function frmKeyboardEdit_OnCreate( _
+ ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+ EnableWindow( GetParent(Hwnd), false )
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmKeyboard
+' ========================================================================================
+Function frmKeyboardEdit_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+
+ case IDC_FRMKEYBOARDEDIT_CHKCTRL, IDC_FRMKEYBOARDEDIT_CHKALT, IDC_FRMKEYBOARDEDIT_CHKSHIFT
+ if codeNotify = BN_CLICKED then
+ Dim As Long nCurSel = ListView_GetSelection( HWND_FRMKEYBOARD_LISTVIEW )
+ If nCurSel < 0 Then exit function
+ dim as CWSTR wszKeys = frmKeyboardEdit_GenerateKeyBinding()
+ frmKeyboard_CheckForKeyConflict( wszKeys, nCurSel )
+ end if
+
+ case IDC_FRMKEYBOARDEDIT_COMBOACCEL
+ if codeNotify = CBN_SELCHANGE then
+ Dim As Long nCurSel = ListView_GetSelection( HWND_FRMKEYBOARD_LISTVIEW )
+ If nCurSel < 0 Then exit function
+ dim as CWSTR wszKeys = frmKeyboardEdit_GenerateKeyBinding()
+ frmKeyboard_CheckForKeyConflict( wszKeys, nCurSel )
+ end if
+
+ Case IDOK
+ If codeNotify = BN_CLICKED Then
+ ' Update the gKeysEdit entry with the new UserKeys value & Enabled value
+ dim as CWSTR wszKeys = frmKeyboardEdit_GenerateKeyBinding()
+ gKeysEdit.wszUserKeys = wszKeys
+ dim as HWND hCtrl = GetDlgItem( HWND_FRMKEYBOARDEDIT, IDC_FRMKEYBOARDEDIT_CHKDISABLED )
+ gKeysEdit.bDefaultDisabled = iif( Button_GetCheck(hCtrl) = BST_CHECKED, true, false )
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ end if
+
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmKeyboardEdit
+' ========================================================================================
+Function frmKeyboardEdit_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ EnableWindow( GetParent(Hwnd), true )
+ DestroyWindow( HWnd )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmKeyboardEdit
+' ========================================================================================
+Function frmKeyboardEdit_OnDestroy( byval HWnd As HWnd) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmKeyboard Window procedure
+' ========================================================================================
+Function frmKeyboardEdit_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmKeyboardEdit_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmKeyboardEdit_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmKeyboardEdit_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmKeyboardEdit_OnCommand)
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+End Function
+
+
+' ========================================================================================
+' frmKeyboardEdit_Show
+' ========================================================================================
+Function frmKeyboardEdit_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ dim hCtrl as HWnd
+ dim as CWSTR wszText
+
+ ' Get the components of the current user key binding
+ dim as CWSTR wszKeys = gKeysEdit.wszUserKeys
+ dim as long nCount = AfxStrParseCount( wszKeys, "+" )
+ dim as CWSTR wszAccel
+ dim as long isAlt = BST_UNCHECKED
+ dim as long isShift = BST_UNCHECKED
+ dim as long isCtrl = BST_UNCHECKED
+ dim as long isDisabled = BST_UNCHECKED
+
+ if gKeysEdit.bDefaultDisabled then
+ isDisabled = BST_CHECKED
+ end if
+
+ for ii as long = nCount to 1 step -1
+ ' The accelerator key will always be the last parse regardless of
+ ' number of items in the string
+ dim as CWSTR wszString = AfxStrParse( wszKeys, ii, "+" )
+ if ii = nCount then
+ wszAccel = wszString
+ else
+ select case ucase(wszString)
+ case "CTRL": isCtrl = BST_CHECKED
+ case "SHIFT": isShift = BST_CHECKED
+ case "ALT": isAlt = BST_CHECKED
+ end select
+ end if
+ next
+
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ HWND_FRMKEYBOARDEDIT = _
+ pWindow->Create(hWndParent, L(220,"Keyboard Shortcuts"), _
+ @frmKeyboardEdit_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT )
+ pWindow->SetClientSize( 330, 220 )
+ pWindow->Center( pWindow->hWindow, hWndParent )
+
+ hCtrl = pWindow->AddControl("LABEL", , IDC_FRMKEYBOARDEDIT_LABEL1, "", 20, 10, 350, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowText( hCtrl, gKeysEdit.wszDescription )
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, true )
+
+ hCtrl = pWindow->AddControl("LABEL", , IDC_FRMKEYBOARDEDIT_LABEL2, "", 20, 30, 350, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszText = gKeysEdit.wszDefaultKeys
+ if len(wszText) = 0 then wszText = "(no key binding)"
+ AfxSetWindowText( hCtrl, "Default: " & wszText )
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, true )
+
+ hCtrl = pWindow->AddControl("CHECKBOX", , IDC_FRMKEYBOARDEDIT_CHKDISABLED, "Disable Default", 20, 50, 150, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, true )
+ Button_SetCheck( hCtrl, isDisabled )
+
+ hCtrl = pWindow->AddControl("LABEL", , IDC_FRMKEYBOARDEDIT_LABEL3, "", 20, 94, 350, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowText( hCtrl, "User defined Keybinding" )
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, true )
+
+ hCtrl = pWindow->AddControl("CHECKBOX", , IDC_FRMKEYBOARDEDIT_CHKCTRL, "Ctrl", 20, 114, 48, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, true )
+ Button_SetCheck( hCtrl, isCtrl )
+
+ hCtrl = pWindow->AddControl("CHECKBOX", , IDC_FRMKEYBOARDEDIT_CHKALT, "Alt", 75, 114, 42, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, true )
+ Button_SetCheck( hCtrl, isAlt )
+
+ hCtrl = pWindow->AddControl("CHECKBOX", , IDC_FRMKEYBOARDEDIT_CHKSHIFT, "Shift", 127, 114, 48, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, true )
+ Button_SetCheck( hCtrl, isShift )
+
+ dim as HWND hCombo
+ hCombo = pWindow->AddControl("COMBOBOX", , IDC_FRMKEYBOARDEDIT_COMBOACCEL, "", 190, 114, 120, 200, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ AfxSetWindowFont( hCtrl, ghStatusBar.hFontStatusBar, true )
+
+ pWindow->AddControl("BUTTON", , IDOK, L(0,"OK"), 154, 170, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(1,"Cancel"), 236, 170, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ ComboBox_AddString( hCombo, @wstr("None") )
+ ComboBox_AddString( hCombo, @wstr("Backspace") )
+ ComboBox_AddString( hCombo, @wstr("Tab") )
+ ComboBox_AddString( hCombo, @wstr("Enter") )
+ ComboBox_AddString( hCombo, @wstr("Escape") )
+ ComboBox_AddString( hCombo, @wstr("Spacebar") )
+ ComboBox_AddString( hCombo, @wstr("PageUp") )
+ ComboBox_AddString( hCombo, @wstr("PageDn") )
+ ComboBox_AddString( hCombo, @wstr("End") )
+ ComboBox_AddString( hCombo, @wstr("Home") )
+ ComboBox_AddString( hCombo, @wstr("Left") )
+ ComboBox_AddString( hCombo, @wstr("Right") )
+ ComboBox_AddString( hCombo, @wstr("Up") )
+ ComboBox_AddString( hCombo, @wstr("Down") )
+ ComboBox_AddString( hCombo, @wstr("DEL") )
+ ComboBox_AddString( hCombo, @wstr("INS") )
+ for i as long = 48 to 57 ' 0 to 9
+ wszText = wchr(i)
+ ComboBox_AddString( hCombo, wszText.sptr )
+ next
+ for i as long = 65 to 90 ' A to Z
+ wszText = wchr(i)
+ ComboBox_AddString( hCombo, wszText.sptr )
+ next
+ ComboBox_AddString( hCombo, @wstr("Numpad0") )
+ ComboBox_AddString( hCombo, @wstr("Numpad1") )
+ ComboBox_AddString( hCombo, @wstr("Numpad2") )
+ ComboBox_AddString( hCombo, @wstr("Numpad3") )
+ ComboBox_AddString( hCombo, @wstr("Numpad4") )
+ ComboBox_AddString( hCombo, @wstr("Numpad5") )
+ ComboBox_AddString( hCombo, @wstr("Numpad6") )
+ ComboBox_AddString( hCombo, @wstr("Numpad7") )
+ ComboBox_AddString( hCombo, @wstr("Numpad8") )
+ ComboBox_AddString( hCombo, @wstr("Numpad9") )
+ ComboBox_AddString( hCombo, @wstr("Numpad*") )
+ ComboBox_AddString( hCombo, @wstr("Numpad+") )
+ ComboBox_AddString( hCombo, @wstr("Numpad-") )
+ ComboBox_AddString( hCombo, @wstr("Numpad.") )
+ ComboBox_AddString( hCombo, @wstr("Numpad/") )
+ ComboBox_AddString( hCombo, @wstr("F1") )
+ ComboBox_AddString( hCombo, @wstr("F2") )
+ ComboBox_AddString( hCombo, @wstr("F3") )
+ ComboBox_AddString( hCombo, @wstr("F4") )
+ ComboBox_AddString( hCombo, @wstr("F5") )
+ ComboBox_AddString( hCombo, @wstr("F6") )
+ ComboBox_AddString( hCombo, @wstr("F7") )
+ ComboBox_AddString( hCombo, @wstr("F8") )
+ ComboBox_AddString( hCombo, @wstr("F9") )
+ ComboBox_AddString( hCombo, @wstr("F10") )
+ ComboBox_AddString( hCombo, @wstr("F11") )
+ ComboBox_AddString( hCombo, @wstr("F12") )
+ ComboBox_AddString( hCombo, @wstr("Tilde") )
+ ComboBox_AddString( hCombo, @wstr("Plus") )
+ ComboBox_AddString( hCombo, @wstr("Comma") )
+ ComboBox_AddString( hCombo, @wstr("Minus") )
+ ComboBox_AddString( hCombo, @wstr("Period") )
+ ComboBox_AddString( hCombo, @wstr("SingleQuote") )
+ ComboBox_AddString( hCombo, @wstr("SemiColon") )
+ ComboBox_AddString( hCombo, @wstr("/") )
+ ComboBox_AddString( hCombo, @wstr("\") )
+ ComboBox_AddString( hCombo, @wstr("[") )
+ ComboBox_AddString( hCombo, @wstr("]") )
+
+ if len(wszAccel) = 0 then wszAccel = "None"
+ dim as long nCurSel
+ nCursel = ComboBox_FindStringExact( hCombo, -1, wszAccel.sptr )
+ ComboBox_SetCurSel( hCombo, nCursel )
+
+ SetFocus( GetDlgItem(HWND_FRMKEYBOARDEDIT, IDOK) )
+
+ ' Process Windows messages(modal)
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
diff --git a/src/frmMain.bi b/src/frmMain.bi
index 471ae419..76263a41 100644
--- a/src/frmMain.bi
+++ b/src/frmMain.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMain.bi.bak b/src/frmMain.bi.bak
new file mode 100644
index 00000000..471ae419
--- /dev/null
+++ b/src/frmMain.bi.bak
@@ -0,0 +1,37 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMMAIN_TOPTABCONTROL 1000
+#Define IDC_FRMMAIN_COMPILETIMER 1001
+
+
+'' Last position in document. Used when "Last Position" menu option is selected.
+Type LASTPOSITION_TYPE
+ pDoc As clsDocument_ Ptr
+ nFirstLine As Long ' first visible line on screen
+ nPosition As Long ' Position in Scintilla document where caret is positioned
+End Type
+Dim Shared gLastPosition As LASTPOSITION_TYPE
+
+declare Function frmMain_GotoFile( ByVal pDoc As clsDocument Ptr, byval nMenuId as long ) As Long
+declare Function frmMain_GotoLastPosition() As Long
+declare Function frmMain_GotoDefinition( ByVal pDoc As clsDocument Ptr ) As Long
+declare Function frmMain_SetStatusbar() as long
+declare Function frmMain_SetFocusToCurrentCodeWindow() As Long
+Declare Function frmMain_OpenFileSafely( ByVal HWnd As HWnd, ByVal bIsNewFile As BOOLEAN, ByVal bIsTemplate As BOOLEAN, ByVal bShowInTab As BOOLEAN, byval bIsInclude as BOOLEAN, Byref wszName As WString, ByVal pDocIn As clsDocument Ptr, byval bIsDesigner as Boolean = false, byval wszFileType as CWSTR = FILETYPE_UNDEFINED ) As clsDocument Ptr
+declare Function frmMain_OpenProjectSafely( ByVal HWnd As HWnd, byref wszProjectFileName as const WString ) as Boolean
+declare Function frmMain_PositionWindows() As LRESULT
+declare function frmMain_HighlightWord( byval pDoc as clsDocument ptr, byref text as string ) as long
+declare Function frmMain_Show( ByVal hWndParent As HWnd ) as LRESULT
diff --git a/src/frmMain.inc b/src/frmMain.inc
index 3eea6c92..1d8d7633 100644
--- a/src/frmMain.inc
+++ b/src/frmMain.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMain.inc.bak b/src/frmMain.inc.bak
new file mode 100644
index 00000000..3eea6c92
--- /dev/null
+++ b/src/frmMain.inc.bak
@@ -0,0 +1,2109 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMain.bi"
+#include once "clsDocument.bi"
+#include once "frmUserTools.bi"
+#include once "frmSnippets.bi"
+#include once "frmProjectOptions.bi"
+#include once "frmBuildConfig.bi"
+#include once "frmExplorer.bi"
+#include once "frmPanel.bi"
+#include once "modMRU.bi"
+#include once "modAutoInsert.bi"
+#include once "modMenus.bi"
+#include once "modCompile.bi"
+#include once "mod302Upgrade.bi"
+
+
+' ========================================================================================
+' Update the main form statusbar. This is the only routine that updates
+' the statusbar in the entire program.
+' ========================================================================================
+function frmMain_SetStatusbar() as long
+
+ ' Update the statusbar with the current Line/Col position
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+
+ dim wszText as wstring * MAX_PATH
+
+ ' PANEL (0) Line/Col/Sel -or- VD coordinates
+ ' PANEL (1) Compiling Results -or- Filename being parsed
+ ' PANEL (2) Build Configuration
+ ' PANEL (3) Filetype (Normal/Main/Resource/Module)
+ ' PANEL (4) Spacing
+ ' PANEL (5) File Encoding (Ansi, UTF-8, etc)
+ ' PANEL (6) Line Endings
+
+ ' blank out the current statusbar values
+ for i as long = lbound(gSBPanels) to ubound(gSBPanels)
+ gSBPanels(i).wszText = ""
+ next
+
+ ' PANEL (1) Compiling Results -or- Filename being parsed
+ gSBPanels(1).wszText = gApp.wszPanelText
+ 'hIconPanel4 = gApp.hIconPanel
+
+ if (gApp.IsProjectLoading) orelse (gApp.IsFileLoading) then
+ gSBPanels(1).wszText = L(66,"Parsing") & ": (" & gApp.FileLoadingCount & ") " & gApp.wszPanelText
+
+ elseif pDoc <> 0 then
+ dim as HWND hEdit = pDoc->hWndActiveScintilla
+ wszText = ""
+ if (pDoc->IsDesigner) andalso (IsDesignerView(pDoc)) then
+ dim pCtrl as clsControl ptr = pDoc->Controls.GetActiveControl
+ if pCtrl then
+ wszText = "L:" & GetControlProperty(pCtrl, "LEFT") & ", T:" & GetControlProperty(pCtrl, "TOP") & " :: " & _
+ "W:" & GetControlProperty(pCtrl, "WIDTH") & " x H:" & GetControlProperty(pCtrl, "HEIGHT")
+ end if
+ else
+ dim as long curPos, nLine, nCol
+ dim as long startPos, endPos, startLine, endLine, nLines
+ ' Retrieve the information and show it in the status bar
+ curPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ nLine = SciExec( hEdit, SCI_LINEFROMPOSITION, curPos, 0)
+ nCol = SciExec( hEdit, SCI_GETCOLUMN, curPos, 0)
+ pDoc->GetSelectedLineRange(startLine, endLine, startPos, endPos )
+
+ wszText = " Ln " & str(nLine + 1) & ", Col " & str(nCol + 1)
+ if endPos - startPos then ' there is selected text
+ wszText = wszText + " (" + str(endPos - startPos) + " selected)"
+ end if
+
+ ' Should we display the "shadow" under the tabcontrol
+ frmTopTabs_ShowShadow()
+
+ ' Update the vertical scrollbar
+ frmEditorVScroll_calcVThumbRect(pDoc)
+ AfxRedrawWindow( iif( hEdit = pDoc->hWindow(0), HWND_FRMEDITOR_VSCROLLBAR(0), HWND_FRMEDITOR_VSCROLLBAR(1)) )
+
+ end if
+
+ ' PANEL (0) Line/Col/Sel -or- VD coordinates
+ gSBPanels(0).wszText = wszText
+
+ ' PANEL (2) Build Configuration
+ if gApp.GetDocumentCount then
+ gSBPanels(2).wszText = frmBuildConfig_GetSelectedBuildDescription()
+ end if
+
+ ' PANEL (3) Filetype (Normal/Main/Resource/Module)
+ wszText = ""
+ select case pDoc->ProjectFileType
+ case FILETYPE_HEADER: wszText = L(175,"Header")
+ case FILETYPE_NORMAL: wszText = L(210,"Normal")
+ case FILETYPE_MODULE: wszText = L(211,"Module")
+ case FILETYPE_MAIN: wszText = L(212,"Main")
+ case FILETYPE_RESOURCE: wszText = L(213,"Resource")
+ end select
+ gSBPanels(3).wszText = wszText
+
+ ' PANEL (4) Spacing
+ gSBPanels(4).wszText = "Spaces: " & gConfig.TabSize
+
+ ' PANEL (5) File Encoding (Ansi, UTF-8, UTF-16)
+ wszText = ""
+ select case pDoc->FileEncoding
+ case FILE_ENCODING_UTF8_BOM
+ wszText = "UTF-8 (BOM)"
+ SciExec( hEdit, SCI_SETCODEPAGE, SC_CP_UTF8, 0 )
+ case FILE_ENCODING_UTF16_BOM
+ wszText = "UTF-16 (BOM)"
+ SciExec( hEdit, SCI_SETCODEPAGE, SC_CP_UTF8, 0 )
+ case else
+ wszText = "ANSI"
+ SciExec( hEdit, SCI_SETCODEPAGE, 0, 0 )
+ end select
+ gSBPanels(5).wszText = wszText
+
+ ' PANEL (6) Line Endings
+ select case SciExec( hEdit, SCI_GETEOLMODE, 0, 0 )
+ case SC_EOL_CRLF: wszText = "CRLF" '(0)
+ case SC_EOL_CR: wszText = "CR" '(1)
+ case SC_EOL_LF: wszText = "LF" '(2)
+ end select
+ gSBPanels(6).wszText = wszText
+
+ if SciExec( hEdit, SCI_GETREADONLY, 0, 0 ) then
+ gSBPanels(1).wszText = L(222,"Read Only")
+ end if
+
+ end if
+
+
+ ' MAIN WINDOW CAPTION
+ wszText = iif( gApp.GetDocumentCount, APPNAMESHORT, APPNAME )
+ if (gApp.IsProjectActive = true) or (gApp.IsProjectLoading = true) then
+ wszText = wszText & " - [" & gApp.ProjectName & "]"
+ end if
+ if pDoc then
+ wszText = wszText & " - [" & pDoc->DiskFilename & "]"
+ if SciExec( pDoc->hWndActiveScintilla, SCI_GETREADONLY, 0, 0 ) then
+ wszText = wszText & " - [" & L(222,"Read Only") & "]"
+ end if
+ end if
+ if wszText <> AfxGetWindowText( HWND_FRMMAIN ) then AfxSetWindowText( HWND_FRMMAIN, wszText )
+
+ ' TAB CONTROL FILENAME ( * modified flag )
+ gTTabCtl.SetTabText(-1) ' this will only repaint if text has changed
+ ' repaint the tab to ensure that the unsaved indicator changes
+ AfxRedrawWindow( HWND_FRMMAIN_TOPTABS )
+
+ ' Call function to calculate the size/position of the panels and also paint the statusbar
+ frmStatusBar_PositionWindows()
+
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Process any command line that was passed to the editor
+' ========================================================================================
+function frmMain_ProcessCommandLine( byval HWnd as HWnd ) as long
+
+ ' The incoming command line may contain a regular file to open or a project file.
+
+ ' Command: A space-separated list of all command-line arguments is returned. When the
+ ' command line is parsed for arguments, everything between double quotes in
+ ' the parameter list will be considered as a single parameter, and is returned
+ ' with the double quotes.
+ ' A value of zero (0) returns the name of the executable; and values of
+ ' one (1) and greater return each command-line argument.
+
+ ' as of v1.7.4 start to use AfxCommand which is a unicode aware replacement for FB's
+ ' built in COMMAND function (that is not unicode compliant).
+
+ if len(AfxCommand(1)) = 0 then exit function
+
+ dim wszPath as wstring * MAX_PATH
+ dim wszArg as wstring * MAX_PATH
+ dim DataToSend as COPYDATASTRUCT
+
+ if IsIconic(hwnd) then
+ dim WinPla as WINDOWPLACEMENT
+ with WinPla
+ .Length = sizeof(WinPla)
+ .rcNormalPosition.Left = gConfig.StartupLeft
+ .rcNormalPosition.Top = gConfig.StartupTop
+ .rcNormalPosition.Right = gConfig.StartupRight
+ .rcNormalPosition.Bottom = gConfig.StartupBottom
+ .showCmd = iif( gConfig.StartupMaximized, SW_MAXIMIZE, SW_SHOWNORMAL )
+ end with
+ SetWindowPlacement(HWND, @WinPla)
+ end if
+ SetForegroundWindow(hwnd)
+
+ dim as long i = 1
+ Do
+ wszArg = AfxCommand(i)
+ if len(wszArg) = 0 then exit do
+
+ ' Remove any double quotes from the argument.
+ wszPath = AfxStrRemove( wszArg, wchr(34) )
+
+ ' if no path exists for the file then add the current folder
+ wszPath = AfxStrPathname( "PATH", wszArg )
+ if len(wszPath) = 0 then wszArg = AfxGetExePathName & wszArg
+
+ if AfxFileExists(wszArg) then
+ DataToSend.lpData = @wszArg
+ DataToSend.cbdata = (len(wszArg)*2) + 1
+ SendMessage(hwnd, WM_COPYDATA, len(DataToSend), cast(lParam, @DataToSend))
+ end if
+
+ i += 1
+ Loop
+
+ function = 0
+end function
+
+
+
+' ========================================================================================
+' Determine if the incoming character is a brace character
+' ========================================================================================
+function frmMain_HighlightWord( _
+ byval pDoc as clsDocument ptr, _
+ byref text as string _
+ ) as long
+
+ if pDoc = 0 then exit function
+
+ dim as any ptr pSci = pDoc->GetActiveScintillaPtr()
+ if pSci = 0 then exit function
+
+ '// Indicators 0-7 could be in use by a lexer
+ '// Indicator 8 is used by Find/Replace
+ '// Indicator 9 is used for Brace Highlighting
+ '// so we'll use indicator 10 to highlight words.
+ dim as long NUM = 10
+
+ '// Remove all uses of our Occurrence indicator
+ dim as long nLength = SciMsg( pSci, SCI_GETTEXTLENGTH, 0, 0)
+ SciMsg( pSci, SCI_SETINDICATORCURRENT, 10, 0)
+ SciMsg( pSci, SCI_INDICATORCLEARRANGE, 0, nLength)
+
+ if len(ltrim(text)) = 0 then exit function
+
+ '// Update indicator appearance
+ SciMsg( pSci, SCI_INDICSETSTYLE, NUM, INDIC_STRAIGHTBOX )
+ SciMsg( pSci, SCI_INDICSETFORE, NUM, ghEditor.ForeColorOccurrence )
+ SciMsg( pSci, SCI_INDICSETALPHA, NUM, 80 )
+
+ '// Search the document
+ SciMsg( pSci, SCI_TARGETWHOLEDOCUMENT, 0, 0)
+ SciMsg( pSci, SCI_SETSEARCHFLAGS, SCFIND_WHOLEWORD, 0)
+
+ dim as long numfound = 0
+ dim as long startPos = 0
+ dim as long r
+ do
+ r = SciMsg( pSci, SCI_SEARCHINTARGET, len(text), cast(LPARAM, strptr(text)))
+ if r = -1 then exit do
+
+ numfound = numfound + 1
+
+ SciMsg( pSci, SCI_SETINDICATORVALUE, NUM, 0 )
+ SciMsg( pSci, SCI_INDICATORFILLRANGE, r, len(text))
+ startPos = r + len(text)
+
+ ' Adjust the searching positions
+ SciMsg( pSci, SCI_SETTARGETSTART, startPos, 0)
+ SciMsg( pSci, SCI_SETTARGETEND, nLength, 0)
+ loop
+
+ '// if only the current word was found then we don't want any highlighting
+ '// because the effect would be that the current word highlights as we type.
+ '// Remove all uses of our indicator
+ if numfound <= 1 then
+ nLength = SciMsg( pSci, SCI_GETTEXTLENGTH, 0, 0)
+ SciMsg( pSci, SCI_SETINDICATORCURRENT, 10, 0)
+ SciMsg( pSci, SCI_INDICATORCLEARRANGE, 0, nLength)
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Determine if the incoming character is a brace character
+' ========================================================================================
+function frmMain_IsBrace( byval c as integer ) as boolean
+
+ select case chr(c)
+ case "(", ")", "[", "]", "{", "}"
+ return true
+ end select
+
+ return false
+end function
+
+
+' ========================================================================================
+' Handle Character Autocompletion if that editor option is active
+' ========================================================================================
+function frmMain_InsertMatchedChars( _
+ byval pDoc as clsDocument ptr, _
+ byval ch as long _
+ ) as boolean
+
+ if gConfig.CharacterAutoComplete = 0 then exit function
+
+ if pDoc = 0 then exit function
+
+ dim as any ptr pSci = pDoc->GetActiveScintillaPtr()
+ if pSci = 0 then exit function
+
+ dim as long caretPos = SciMsg( pSci, SCI_GETCURRENTPOS, 0, 0)
+ dim as long docStart = caretPos = 1
+ dim as long docend = caretPos = SciMsg( pSci, SCI_GETTEXTLENGTH, 0, 0)
+
+ ' Get the styling of the current line to determine if we are in a
+ ' multiline or single line comment block then abort the autoinsert.
+ select case SciMsg( pSci, SCI_GETSTYLEAT, caretPos, 0)
+ case SCE_B_MULTILINECOMMENT, SCE_B_COMMENT
+ exit function
+ end select
+
+ dim as long nCharPrev = iif( docStart, _
+ SciMsg( pSci, SCI_GETCHARAT, caretPos, 0), _
+ SciMsg( pSci, SCI_GETCHARAT, caretPos-2, 0) )
+
+ dim as long nCharNext = SciMsg( pSci, SCI_GETCHARAT, caretPos, 0)
+
+ dim as boolean isCharPrevBlank = iif( instr(chr(nCharPrev), any chr(32, 9, 10, 13)), true, false )
+
+ dim as boolean isCharNextBlank = iif( instr(chr(nCharNext), any chr(32, 9, 10, 13)), true, false )
+ if nCharNext = docend then isCharNextBlank = true
+
+ dim as boolean isEnclosed = false
+ if (nCharPrev = asc("(") and nCharNext = asc(")") ) or _
+ (nCharPrev = asc("{") and nCharNext = asc("}") ) or _
+ (nCharPrev = asc("[") and nCharNext = asc("]") ) then
+ isEnclosed = true
+ end if
+
+ dim as boolean isSpaceEnclosed = false
+ if (nCharPrev = asc("(") and isCharNextBlank ) or _
+ (isCharPrevBlank and nCharNext = asc(")") ) or _
+ (nCharPrev = asc("{") and isCharNextBlank) or _
+ (isCharPrevBlank and nCharNext = asc("}") ) or _
+ (nCharPrev = asc("[") and isCharNextBlank) or _
+ (isCharPrevBlank and nCharNext = asc("]") ) then
+ isSpaceEnclosed = true
+ end if
+
+ dim as boolean isCharOrString = false
+ if (isCharPrevBlank and isCharNextBlank) or isEnclosed or isSpaceEnclosed then
+ isCharOrString = true
+ end if
+
+ dim as boolean charNextIsCharOrString = iif( instr(chr(nCharNext), any chr(34,92)), true, false )
+
+ dim as wstring * 10 wszText
+
+ select case chr(ch)
+ case "("
+ if (charNextIsCharOrString) then return false
+ wszText = ")"
+ SciMsg( pSci, SCI_INSERTTEXT, caretPos, cast(LPARAM, @wszText) )
+
+ case "{"
+ if (charNextIsCharOrString) then return false
+ wszText = "}"
+ SciMsg( pSci, SCI_INSERTTEXT, caretPos, cast(LPARAM, @wszText) )
+
+ case "["
+ if (charNextIsCharOrString) then return false
+ wszText = "]"
+ SciMsg( pSci, SCI_INSERTTEXT, caretPos, cast(LPARAM, @wszText) )
+
+ case chr(34)
+ '// 0x22 = "
+ if (nCharPrev = 34) and (nCharNext = 34) then
+ SciMsg( pSci, SCI_DELETERANGE, caretPos, 1)
+ SciMsg( pSci, SCI_GOTOPOS, caretPos, 0)
+ return false
+ end if
+
+ if (isCharOrString) then
+ wszText = chr(34)
+ SciMsg( pSci, SCI_INSERTTEXT, caretPos, cast(LPARAM, @wszText) )
+ end if
+
+ end select
+
+ function = true
+end function
+
+
+' ========================================================================================
+' Process Scintilla Notifications
+' ========================================================================================
+function Scintilla_OnNotify( _
+ byval HWnd as HWnd, _
+ byval pNSC as SCNOTIFICATION ptr _
+ ) as long
+
+ if pNSC = 0 then exit function
+
+ dim pDoc as clsDocument ptr
+
+ dim as HWND hEdit
+ dim as long nLine, nFoldLevel
+
+ select case pNSC->hdr.code
+
+ case SCN_UPDATEUI
+ if gApp.SuppressNotify then return true
+ pDoc = gApp.GetDocumentPtrByWindow( pNSC->hdr.hwndFrom )
+ if pDoc then
+ if pDoc->IsValidScintillaID( pNSC->hdr.idFrom ) then
+ frmMain_SetStatusbar
+
+ '// Has the caret changed position
+ var caretPos = SciExec( pDoc->hWndActiveScintilla, SCI_GETCURRENTPOS, 0, 0)
+
+ if pDoc->lastCaretPos <> caretPos then
+ pDoc->lastCaretPos = caretPos
+
+ '// If the xOffset has changed then we need to update the horizontal scrollbar
+ dim as long GetXOffset = SciExec( pDoc->hWndActiveScintilla, SCI_GETXOFFSET, 0, 0 )
+ if pDoc->lastXOffsetPos <> GetXOffset then
+ pDoc->lastXOffsetPos = GetXOffset
+ AfxRedrawWindow( HWND_FRMEDITOR_HSCROLLBAR(0) )
+ AfxRedrawWindow( HWND_FRMEDITOR_HSCROLLBAR(1) )
+ end if
+
+ '// Update any occurrence highlights
+ if gConfig.OccurrenceHighlight then
+ static as string sCurWord, sPrevWord
+ sCurWord = pDoc->GetWord()
+ if sCurWord <> sPrevWord then
+ frmMain_HighlightWord( pDoc, sCurWord )
+ sPrevWord = sCurWord
+ end if
+ end if
+
+ '// Update any brace highlighting
+ if gConfig.BraceHighlight then
+ var bracePos1 = -1
+ var bracePos2 = -1
+
+ '// Is there a brace to the left or right
+ if (caretPos > 0) and ( frmMain_IsBrace(SciExec(pDoc->hWndActiveScintilla, SCI_GETCHARAT, caretPos - 1, 0))) then
+ bracePos1 = (caretPos - 1)
+ elseif frmMain_IsBrace(SciExec(pDoc->hWndActiveScintilla, SCI_GETCHARAT, caretPos, 0)) then
+ bracePos1 = caretPos
+ end if
+
+ if bracePos1 >= 0 then
+ '// Find the matching brace
+ bracePos2 = SciExec( pDoc->hWndActiveScintilla, SCI_BRACEMATCH, bracePos1, 0)
+ if bracePos2 = -1 then
+ SciExec( pDoc->hWndActiveScintilla, SCI_INDICSETFORE, 9, ghEditor.ForeColorBracebad )
+ SciExec( pDoc->hWndActiveScintilla, SCI_BRACEBADLIGHT, bracePos1, 0 )
+ else
+ SciExec( pDoc->hWndActiveScintilla, SCI_INDICSETFORE, 9, ghEditor.ForeColorBracegood )
+ SciExec( pDoc->hWndActiveScintilla, SCI_BRACEHIGHLIGHT, bracePos1, bracePos2 )
+ end if
+ SciExec( pDoc->hWndActiveScintilla, SCI_INDICSETOUTLINEALPHA, 9, 127 ) ' transparency of outline
+ SciExec( pDoc->hWndActiveScintilla, SCI_INDICSETALPHA, 9, 127 ) ' transparency of interior
+ else
+ '// Turn off brace matching
+ SciExec( pDoc->hWndActiveScintilla, SCI_BRACEHIGHLIGHT, -1, -1 )
+ end if
+
+ else
+ SciExec( pDoc->hWndActiveScintilla, SCI_BRACEHIGHLIGHT, -1, -1 )
+ end if
+ end if
+
+ end if
+ end if
+ return true
+
+
+ case SCN_MODIFYATTEMPTRO
+ ' Attempting to modify a read-only document.
+ MessageBeep(MB_ICONWARNING)
+
+
+ case SCN_MODIFIED
+ if gApp.SuppressNotify then return true
+
+ ' Show line and column. Only do on modification of text otherwise we will have
+ ' a huge slowdown when notifications sent for UI updates.
+
+ if (pNSC->modificationType and SC_MOD_INSERTTEXT) orelse _
+ (pNSC->modificationType and SC_MOD_DELETETEXT) then
+
+ ' Set parsing flag to true. We use a parse flag rather than depending on the dirty
+ ' flags because the file could stay dirty for a long time before it gets saved and
+ ' every call to the parser would happen even in cases where only directional
+ ' movement has occured with no text modifications at all.
+
+ ' Get the pDoc from the Scintilla HWND because this is the most reliable
+ ' method of knowing which scintilla window sent the notification (rather than
+ ' using gTTabCtl.GetActiveDocumentPtr. Possible that a control is sending the message
+ ' as it is loading and is not yet the active document ptr.
+ pDoc = gApp.GetDocumentPtrByWindow( pNSC->hdr.hwndFrom )
+ if pDoc then
+ if pDoc->LoadingFromFile = false then
+ pDoc->AutoSaveRequired = true
+ end if
+ frmMain_SetStatusbar
+
+ pDoc->bNeedsParsing = true
+ if (pNSC->modificationType and SC_MOD_DELETETEXT) then
+ ' Do a check to see if we have backspaced to a point where there is a
+ ' period to try to popup an autocomplete or codetip.
+ dim as long nPos, nChar
+ hEdit = pDoc->hWndActiveScintilla
+ nPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0 ) - 1
+ nChar = SciExec( hEdit, SCI_GETCHARAT, nPos, 0 )
+ select case chr(nChar)
+ case ".", ">" ' Show autocomplete list for TYPE variables
+ ' dot "." or ">" part of a pointer
+ ' Need to PostMessage in order to give time for notification to complete. The "."
+ ' is also used as a character that selects and closes the popup list. If no
+ ' PostMessage then the "." will automatically select the first entry in the list
+ ' and close.
+ pDoc->AutoCTriggerStartPos = nPos
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+ PostMessage( HWND_FRMMAIN, MSG_USER_SHOWAUTOCOMPLETE, nChar, 0 )
+ end select
+ end if
+ end if
+ end if
+ return true
+
+ case SCN_MARGINCLICK
+ ' Folder margin
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ hEdit = pDoc->hWndActiveScintilla
+ nLine = SciExec(hEdit, SCI_LINEFROMPOSITION, pNSC->position, 0)
+ nFoldLevel = SciExec(hEdit, SCI_GETFOLDLEVEL, nLine, 0)
+ select case pNSC->margin
+ case 1 ' left margin (bookmarks)
+ pDoc->ToggleBookmark(nLine)
+ LoadBookmarksFiles
+ AfxRedrawWindow( HWND_FRMBOOKMARKS )
+ case 2 ' fold margin
+ ' if is the head line...
+ if (nFoldLevel and SC_FOLDLEVELHEADERFLAG) <> 0 then
+ pDoc->FoldToggle(nLine)
+ end if
+ end select
+ end if
+
+
+ case SCN_AUTOCCANCELLED
+ ' Destroy the popup information window
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ ' If the last typed character was a BACKSPACE then do NOT reset the
+ ' autocomplete type otherwise the autocomplete popup will not continue
+ ' to popup on subsequent characters being added.
+ if pDoc->LastCharTyped = VK_BACK then
+ ' backspace pressed... do nothing, unless we are backspacing past where
+ ' the popup trigger occurred.
+ dim as long curPos = SciExec(pDoc->hWndActiveScintilla, SCI_GETCURRENTPOS, 0, 0)
+ if curPos <= pDoc->AutoCTriggerStartPos then
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+ end if
+ else
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+ end if
+ end if
+
+
+ case SCN_AUTOCSELECTION
+ ' A selection occured from the AutoComplete listbox. We do the insertion
+ ' ourselves because the startpos of the word is not the same as the start position
+ ' used by the autocomplete listbox (because we are doing incremental searches).
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+
+ if pDoc then
+
+ hEdit = pDoc->hWndActiveScintilla
+
+ ' Get the position where the listbox was opened.
+ dim as long nStartPos = pDoc->AutoCStartPos
+ dim as long nPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+
+ ' Get the match word that existed when the listbox was displayed
+ dim as long nLenMatchWord = len(pDoc->sMatchWord)
+
+ ' Set the word that was selected in the listbox
+ dim as string sText = *cast(zstring ptr, pNSC->lpText)
+
+ if ucase(sText) <> ucase(pDoc->sMatchWord) then
+ SciExec( hEdit, SCI_SETSEL, nStartPos-nLenMatchWord, nPos)
+ SciExec( hEdit, SCI_REPLACESEL, 0, cast(LPARAM, strptr(sText)))
+ nPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ end if
+ SciExec( hEdit, SCI_SETSEL, nPos, nPos)
+
+ ' Now that we have inserted our own text, cancel the autoinsertion by
+ ' the autocomplete listbox.
+ SciExec( hEdit, SCI_AUTOCCANCEL, 0, 0)
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+
+ if chr(pNSC->ch) = "=" then
+ ' Add a space before and after Equals sign whenever the user presses
+ ' the equals sign to terminate ab autocomplete popup list.
+ PostMessage(HWND, MSG_USER_APPENDEQUALSSIGN, 0, 0)
+ end if
+
+ ' if a CodeTip was displayed prior to the autocomplete popup list then
+ ' redisplay that CodeTip now.
+ ShowCodetip( pDoc )
+
+ return true
+ end if
+
+
+ case SCN_AUTOCCHARDELETED
+ if gConfig.CodeTips then
+ ' User deleted a character while autocompletion list was active. Display
+ ' new contents of list because the underlying word being typed as changed.
+ ShowAutocompleteList(SCN_AUTOCCHARDELETED)
+ end if
+
+
+ case SCN_CHARADDED
+ if gApp.SuppressNotify then exit function
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc = 0 then exit function
+ hEdit = pDoc->hWndActiveScintilla
+
+ pDoc->bNeedsParsing = true
+
+ ' Attempt to do a Character Autocompletion if that editor option is active.
+ frmMain_InsertMatchedChars( pDoc, pNSC->ch )
+
+ select case chr(pNSC->ch)
+ case ".", ">" ' Show autocomplete list for TYPE variables
+ ' dot "." or ">" part of a pointer
+ ' Need to PostMessage in order to give time for notification to complete. The "."
+ ' is also used as a character that selects and closes the popup list. if no
+ ' PostMessage then the "." will automatically select the first entry in the list
+ ' and close.
+ pDoc->AutoCTriggerStartPos = SciExec(hEdit, SCI_GETCURRENTPOS, 0, 0)
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+ if PostMessage(HWND_FRMMAIN, MSG_USER_SHOWAUTOCOMPLETE, pNSC->ch, 0) then exit function
+
+ case ")" ' Close and active code tip
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+ SciExec( hEdit, SCI_CALLTIPCANCEL, 0, 0 )
+
+ case "(", "," ' Show code tip
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+ if PostMessage(HWND_FRMMAIN, MSG_USER_SHOWAUTOCOMPLETE, pNSC->ch, 0) then exit function
+
+ case chr(13) ' ENTER KEY PRESSED
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+ AttemptAutoInsert()
+
+ case chr(32) ' Space key pressed (Insert AutoComplete constructs if applicable)
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+ if ShowAutocompleteList() then exit function
+
+ case else ' all other letters
+ if ShowAutocompleteList() then exit function
+
+ end select
+
+ end select
+
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Set focus to currently active Scintilla window
+' ========================================================================================
+function frmMain_SetFocusToCurrentCodeWindow() as long
+ ' Post a message to the main form CUSTOM handler that will
+ ' set focus to the currently active Scintilla code window. We
+ ' use PostMessage to ensure that all all other windows
+ ' messages are finished processing.
+ PostMessage( HWND_FRMMAIN, MSG_USER_SETFOCUS, 0, 0 )
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Process WM_PAINT message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnPaint( byval HWnd as HWnd ) as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr( HWND_FRMMAIN )
+ if pWindow = 0 then exit function
+
+ dim as PAINTSTRUCT ps
+ dim as HPEN hPen
+ dim as HDC hDc
+ dim as RECT rc
+
+ hDC = BeginPaint(hWnd, @ps)
+
+ SaveDC hDC
+
+ FillRect( hDC, @ps.rcPaint, ghBrushMainBackground )
+
+ ' Draw any horizontal splitter between the two edit windows
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc then
+ if pDoc->bEditorIsSplit then
+ if IsWindowVisible( pDoc->hWindow(1) ) then
+ GetWindowRect( pDoc->hWindow(1), @rc )
+ rc.top = rc.bottom
+ if IsWindowVisible( HWND_FRMEDITOR_HSCROLLBAR(1) ) then
+ rc.top = rc.top + AfxGetWindowHeight( HWND_FRMEDITOR_HSCROLLBAR(1) )
+ end if
+ rc.bottom = rc.top + pWindow->ScaleY(SPLITSIZE)
+ rc.right = rc.right + pWindow->ScaleX(SCROLLBAR_WIDTH_EDITOR)
+ MapWindowPoints( HWND_DESKTOP, HWND_FRMMAIN, cast(POINT ptr, @rc), 2 )
+ pDoc->rcSplitButton = rc
+ dim as HBRUSH hBackBrush = CreateSolidBrush( ghEditor.Divider )
+ FillRect( hDC, @rc, hBackBrush )
+ DeleteObject( hBackBrush )
+ end if
+ end if
+ end if
+
+ RestoreDC hDC, -1
+
+ EndPaint hWnd, @ps
+
+ function = 0
+end Function
+
+' ========================================================================================
+' Hide the vertical & horizontal editor scrollbars
+' ========================================================================================
+function frmMain_HideScrollBars() as LRESULT
+ ShowWindow( HWND_FRMEDITOR_HSCROLLBAR(0), SW_HIDE )
+ ShowWindow( HWND_FRMEDITOR_HSCROLLBAR(1), SW_HIDE )
+ ShowWindow( HWND_FRMEDITOR_VSCROLLBAR(0), SW_HIDE )
+ ShowWindow( HWND_FRMEDITOR_VSCROLLBAR(1), SW_HIDE )
+ function = 0
+end function
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+function frmMain_PositionWindows() as LRESULT
+ dim as HWnd hEdit
+ dim as long nHeightTabControl, nLeft, nTop
+ dim as Rect rc
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr( HWND_FRMMAIN )
+ if pWindow = 0 then exit function
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+
+ ' Get the entire client area
+ GetClientRect( HWND_FRMMAIN, @rc )
+
+ dim as long nHeightMenuBar = AfxGetWindowHeight( HWND_FRMMAIN_MENUBAR )
+ dim as long nHeightStatusBar = AfxGetWindowHeight( HWND_FRMMAIN_STATUSBAR )
+ dim as long nHeightOutput = AfxGetWindowHeight( HWND_FRMOUTPUT )
+ dim as long nWidthPanel = AfxGetWindowWidth( HWND_FRMPANEL )
+
+ ' Set the top menu menubar into place
+ SetWindowPos( HWND_FRMMAIN_MENUBAR, 0, _
+ 0, 0, rc.right - rc.left, nHeightMenuBar, _
+ SWP_NOZORDER or SWP_SHOWWINDOW )
+
+ ' Set the statusbar into place
+ SetWindowPos( HWND_FRMMAIN_STATUSBAR, 0, _
+ 0, rc.bottom - nHeightStatusBar, rc.right - rc.left, nHeightStatusBar, _
+ SWP_NOZORDER or SWP_SHOWWINDOW )
+
+ nLeft = rc.Left
+ nTop = rc.top + nHeightMenuBar
+
+ ' Set the Panel pane into place if applicable
+ if IsWindowVisible(HWND_FRMPANEL) then
+ SetWindowPos( HWND_FRMPANEL, 0, _
+ nLeft, nTop, _
+ nWidthPanel, _
+ rc.Bottom - nHeightStatusBar - nHeightMenuBar, _
+ SWP_NOZORDER or SWP_SHOWWINDOW )
+ frmPanel_PositionWindows
+ nLeft = nWidthPanel
+ Else
+ nWidthPanel = 0
+ end if
+
+
+ ' if items exist in the top tabcontrol then show the tab control and account for its height
+ if gTTabCtl.GetItemCount = 0 then
+ ShowWindow( HWND_FRMMAIN_TOPTABS, SW_HIDE )
+ nHeightTabControl = 0
+ ' If Find/Replace is open then close it
+ if IsWindowVisible( HWND_FRMFINDREPLACE ) then
+ DestroyWindow( HWND_FRMFINDREPLACE )
+ end if
+ else
+ nHeightTabControl = AfxGetWindowHeight(HWND_FRMMAIN_TOPTABS)
+ SetWindowPos( HWND_FRMMAIN_TOPTABS, 0, _
+ nLeft, nTop, _
+ rc.Right - nWidthPanel, nHeightTabControl, _
+ SWP_SHOWWINDOW or SWP_NOZORDER )
+ frmTopTabs_PositionWindows()
+ end if
+
+
+ ' Set the Output pane into place if applicable
+ if IsWindowVisible(HWND_FRMOUTPUT) then
+ SetWindowPos( HWND_FRMOUTPUT, 0, _
+ nLeft, rc.Bottom - nHeightStatusbar - nHeightOutput, _
+ rc.Right - nLeft, _
+ nHeightOutput, _
+ SWP_NOZORDER or SWP_SHOWWINDOW )
+ Else
+ nHeightOutput = 0
+ end if
+
+ if pDoc = 0 then frmMain_HideScrollBars()
+
+ if pDoc then
+ ' Position the Scintilla child edit windows
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ dim as RECT rcDoc
+ ' Reduce the height of the client area by the size of the statusbar and menubar.
+ rcDoc.left = nLeft
+ rcDoc.top = nTop + nHeightTabControl
+ rcDoc.right = rc.Right
+ rcDoc.bottom = rc.bottom - nHeightStatusBar - nHeightOutput
+
+ dim as long nDesignCodeTabHeight = 0
+ if pDoc->IsDesigner then
+ nDesignCodeTabHeight = pWindow->ScaleY(DESIGNTABS_HEIGHT)
+ end if
+
+ dim as long lStyle = SWP_SHOWWINDOW or SWP_NOZORDER or SWP_NOOWNERZORDER or _
+ SWP_NOACTIVATE or SWP_NOCOPYBITS
+
+ if pDoc->IsDesigner then
+ SetWindowPos( HWND_FRMMAIN_DESIGNTABS, 0, _
+ rcDoc.left, _
+ rcDoc.bottom - nDesignCodeTabHeight, _
+ rcDoc.right, _
+ nDesignCodeTabHeight, _
+ lStyle )
+ AfxRedrawWindow( HWND_FRMMAIN_DESIGNTABS )
+ else
+ ShowWindow( HWND_FRMMAIN_DESIGNTABS, SW_HIDE )
+ end if
+
+ dim as long nShowVScrollBars = iif(pDoc->DesignTabsCurSel = 0, SW_HIDE, SW_SHOW)
+ ' Only hide vertical scrollbars because hiding the horizontal could
+ ' result in endless loop during mouseover test in modMsgPump.
+ ShowWindow( HWND_FRMEDITOR_VSCROLLBAR(0), nShowVScrollBars )
+ ShowWindow( HWND_FRMEDITOR_VSCROLLBAR(1), nShowVScrollBars )
+
+ if (pDoc->IsDesigner) andalso (IsDesignerView(pDoc)) then
+ ' if the DesignView has been set to show the visual designer rather than the code
+ ' window then ensure that DesignMain is shown.
+ SetWindowPos( pDoc->hWndDesigner, 0, _
+ rcDoc.left, rcDoc.top, _
+ rcDoc.right - rcDoc.left, _
+ rcDoc.bottom - rcDoc.top - nDesignCodeTabHeight, _
+ lStyle )
+
+ ' Display the ToolBox/PropertyList
+ frmVDToolbox_Show( HWND_FRMMAIN, SW_SHOW )
+ DisplayPropertyList( pDoc )
+ ShowWindow( HWND_FRMVDTOOLBOX, SW_SHOWNORMAL )
+ ShowWindow( pDoc->hWindow(0), SW_HIDE )
+ ShowWindow( pDoc->hWindow(1), SW_HIDE )
+ else
+
+ ShowWindow( pDoc->hWndDesigner, SW_HIDE )
+ ShowWindow( HWND_FRMVDTOOLBOX, SW_HIDE )
+
+ dim as long nSplitSize = pWindow->ScaleY(SPLITSIZE)
+ dim as long iVScrollbarWidth = AfxGetWindowWidth(HWND_FRMEDITOR_VSCROLLBAR(0))
+ dim as long iHScrollbarHeight
+
+ ' TOP EDIT WINDOW (optional)
+ if pDoc->bEditorIsSplit = false then
+ ShowWindow( pDoc->hWindow(1), SW_HIDE )
+ ShowWindow( HWND_FRMEDITOR_VSCROLLBAR(1), SW_HIDE )
+ ShowWindow( HWND_FRMEDITOR_HSCROLLBAR(1), SW_HIDE )
+ nSplitSize = 0
+ Else
+ ' Position the TOP split editor window
+ iHScrollbarHeight = AfxGetWindowHeight(HWND_FRMEDITOR_HSCROLLBAR(1))
+ if IsWindowVisible(HWND_FRMEDITOR_HSCROLLBAR(1)) = 0 then iHScrollbarHeight = 0
+ SetWindowPos( pDoc->hWindow(1), 0, _
+ rcDoc.left, rcDoc.top, _
+ rcDoc.right - rcDoc.left - iVScrollbarWidth, _
+ pDoc->SplitY - rcDoc.top - iHScrollbarHeight, _
+ lStyle )
+
+ ' Position the TOP view horizontal scroll bar
+ if IsWindowVisible(HWND_FRMEDITOR_HSCROLLBAR(1)) then
+ SetWindowPos( HWND_FRMEDITOR_HSCROLLBAR(1), 0, _
+ rcDoc.left, pDoc->SplitY - iHScrollbarHeight, _
+ rcDoc.right - rcDoc.left - iVScrollbarWidth, iHScrollbarHeight, _
+ SWP_NOZORDER )
+ end if
+
+ ' Position the TOP view vertical scroll bar
+ ' Determine if the VScrollBar should be displayed
+ if pDoc->GetLineCount > pDoc->LinesPerPage(1) then
+ SetWindowPos( HWND_FRMEDITOR_VSCROLLBAR(1), 0, _
+ rcDoc.right - iVScrollbarWidth, rcDoc.top, _
+ iVScrollbarWidth, pDoc->SplitY - rcDoc.top, _
+ lStyle )
+ end if
+ end if
+
+ ' BOTTOM (MAIN) EDIT WINDOW
+ dim as long nTop = Max( rcDoc.top, pDoc->SplitY + nSplitSize )
+ iHScrollbarHeight = AfxGetWindowHeight(HWND_FRMEDITOR_HSCROLLBAR(0))
+ if IsWindowVisible(HWND_FRMEDITOR_HSCROLLBAR(0)) = 0 then iHScrollbarHeight = 0
+
+ SetWindowPos( pDoc->hWindow(0), 0, _
+ rcDoc.left, nTop, _
+ rcDoc.right - rcDoc.left - iVScrollbarWidth, _
+ rcDoc.bottom - nTop - nDesignCodeTabHeight - iHScrollbarHeight, _
+ lStyle )
+
+ ' Position the MAIN view horizontal scroll bar
+ if IsWindowVisible(HWND_FRMEDITOR_HSCROLLBAR(0)) then
+ SetWindowPos( HWND_FRMEDITOR_HSCROLLBAR(0), 0, _
+ rcDoc.left, rcDoc.bottom - nDesignCodeTabHeight - iHScrollbarHeight, _
+ rcDoc.right - rcDoc.left - iVScrollbarWidth, iHScrollbarHeight, _
+ SWP_NOZORDER )
+ end if
+
+ ' Position the MAIN view vertical scroll bar
+ ' Determine if the VScrollBar should be displayed
+ if pDoc->GetLineCount > pDoc->LinesPerPage(0) then
+ SetWindowPos( HWND_FRMEDITOR_VSCROLLBAR(0), 0, _
+ rcDoc.right - iVScrollbarWidth, nTop + SPLITSIZE, _
+ iVScrollbarWidth, _
+ rcDoc.bottom - nTop - nDesignCodeTabHeight, _
+ lStyle )
+ else
+ ShowWindow( HWND_FRMEDITOR_VSCROLLBAR(0), SW_HIDE )
+ end if
+
+ ' Update editor vertical scrollbars
+ frmEditorVScroll_calcVThumbRect( pDoc )
+
+ ' if the FIND/REPLACE window is open then ensure that it is positioned correctly
+ ' especially important if the Main window is resized.
+ frmFindReplace_PositionWindows
+
+ end if
+ end if
+
+ ' Ensure that the correct notes are shown
+ frmOutput_ShowNotes
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Attempt to open specified project.
+' ========================================================================================
+function frmMain_OpenProjectSafely( _
+ byval HWnd as HWnd, _
+ byref wszProjectFileName as const wstring _
+ ) as boolean
+
+ ' if a Project is not active then we need to save the current non-project notes
+ ' when this file is closed. It is possible that this file is being closed and
+ ' a project is being opened.
+ if gApp.IsProjectActive = false then
+ gApp.NonProjectNotes = AfxGetWindowText(GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES))
+ gConfig.SaveConfigFile
+ end if
+
+ ' if a project is open then close any files that may be open in the editor. No need to
+ ' do this if a new project is being created/opened because that function has already
+ ' performed this operation. Doing so again will cause the Recent Files/Projects panel
+ ' to flash on the screen.
+ if gApp.IsNewProjectFlag = false then
+ if gApp.IsProjectActive then
+ if OnCommand_ProjectClose(hwnd) = false then exit function
+ else
+ if OnCommand_FileClose(HWnd, EFC_CLOSEALL) = false then exit function
+ end if
+ ' Clear any previous info from the Output windows
+ frmOutput_ResetAllControls()
+ end if
+
+ ' Open the project
+ if gConfig.ProjectLoadFromFile(wszProjectFileName) then
+ ' Update the most recently used project list
+ UpdateMRUProjectList(wszProjectFileName)
+ end if
+ gApp.IsProjectActive = true
+
+ ' Position all of the controls into place
+ frmPanel_PositionWindows
+ frmMain_PositionWindows
+
+ function = true
+end function
+
+
+' ========================================================================================
+' Attempt to open specified file. if it exists then position to Tab if applicable
+' ========================================================================================
+function frmMain_OpenFileSafely( _
+ byval HWnd as HWnd, _
+ byval bIsNewFile as boolean, _
+ byval bIsTemplate as boolean, _
+ byval bShowInTab as boolean, _
+ byval bIsInclude as boolean, _
+ byref wszName as wstring, _
+ byval pDocIn as clsDocument ptr, _
+ byval bIsDesigner as boolean = false, _
+ byval wszFileType as CWSTR = FILETYPE_UNDEFINED _
+ ) as clsDocument ptr
+
+ dim as long iTab = -1
+ dim pDoc as clsDocument ptr
+
+ ' This function opens/creates various types of files depending on the situation.
+ ' - New documents
+ ' - Open document from disk (after WinFBE has been loaded)
+ ' - Display document that is already loaded and has valid Scintilla loaded control.
+ ' - Display document that is already loaded but does not have a valid Scintilla loaded control.
+
+ ' if the incoming pDocIn is null then we need to create a new pDoc and add it to the collection.
+ if pDocIn = 0 then
+ ' Create a new pDoc
+ pDoc = gApp.AddNewDocument()
+ pDoc->IsDesigner = bIsDesigner
+ if bIsNewFile then
+ pDoc->CreateCodeWindow( HWnd, true ) ' Create the new Scintilla window
+ else
+ wszName = OnCommand_FileAutoSaveFileCheck( wszName )
+ pDoc->CreateCodeWindow( HWnd, false, bIsTemplate, wszName )
+ pDoc->bNeedsParsing = true
+ pDoc->ParseDocument()
+ end if
+ pDoc->ProjectFileType = wszFileType
+ if gApp.IsProjectLoading = false then
+ LoadExplorerFiles()
+ LoadFunctionsFiles()
+ end if
+ else
+ pDoc = pDocIn
+ end if
+
+ ' Set the default build configuration for this document. If no IsDefault option
+ ' has been checked then we simply use whatever the current selected build is.
+ if pDoc->DocumentBuild = "" then
+ pDoc->DocumentBuild = frmBuildConfig_GetDefaultBuildGUID()
+ if pDoc->DocumentBuild = "" then
+ pDoc->DocumentBuild = frmBuildConfig_GetSelectedBuildGUID()
+ end if
+ end if
+
+ if bShowInTab then
+ if gApp.IsProjectLoading = false then
+ ' if the document is already open and loaded then simply switch to
+ ' that document in the top tabcontrol, otherwise load the Explorer
+ ' files list, create a new tab, and switch to it.
+ iTab = gTTabCtl.GetTabIndexFromFilename( pDoc->DiskFilename )
+ if iTab = -1 then
+ LoadExplorerFiles()
+ iTab = gTTabCtl.AddTab( pDoc ) ' Add the new document to the top tabcontrol
+ end if
+ gTTabCtl.SetFocusTab(iTab)
+ end if
+ end if
+
+ ' if a Menu, ToolBar or StatusBar exists on the Form then ensure that it
+ ' resizes to the new Form width.
+ if pDoc->IsDesigner then
+ frmMenuEditor_CreateFakeMainMenu(pDoc)
+ frmToolBarEditor_CreateFakeToolBar(pDoc)
+ frmStatusBarEditor_CreateFakeStatusBar(pDoc)
+ end if
+
+ if gApp.IsProjectLoading = false then
+ frmMain_PositionWindows
+ frmMain_SetFocusToCurrentCodeWindow
+ end if
+
+ ' Post a custom message in order to check if this now opened file needs
+ ' to be upgraded to new 3.0.2 form format.
+ if pDoc->IsDesigner then
+ postmessage( HWND_FRMMAIN, MSG_USER_UPGRADE302FORM, 0, cast(LPARAM, pDoc) )
+ end if
+
+ function = pDoc
+end Function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnCreate( _
+ byval HWnd as HWnd, _
+ byval lpCreateStructPtr as LPCREATESTRUCT _
+ ) as boolean
+ ' Enable drag and drop files
+ DragAcceptFiles HWnd, CTRUE
+
+ ' Message cracker macro expects a true to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ return true
+end Function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnSize( _
+ byval HWnd as HWnd, _
+ byval state as UINT, _
+ byval cx as long, _
+ byval cy as long _
+ ) as LRESULT
+ if state <> SIZE_MINIMIZED then
+ ' Position all of the child windows
+ frmMain_PositionWindows
+ end if
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Process WM_NOTIFY message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnNotify( _
+ byval HWnd as HWnd, _
+ byval id as long, _
+ byval pNMHDR as NMHDR ptr _
+ ) as LRESULT
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ if pDoc->IsValidScintillaID(id) then
+ ' Process Scintilla control notification messages. First, check to see if the notifications
+ ' have been suppressed by a bulk modification activity that should only update the screen
+ ' at the end of its process (eg. moving large numbers of selected lines up or down).
+ if gApp.SuppressNotify then exit function
+ Scintilla_OnNotify HWnd, cast(SCNOTIFICATION ptr, pNMHDR)
+ exit function
+ end if
+ end if
+
+
+ select case pNMHDR->code
+
+ case TCN_SELCHANGING
+ select case id
+ case IDC_DESIGNTABCTRL
+ frmMain_PositionWindows
+ end select
+
+ case TCN_SELCHANGE
+ select case id
+ case IDC_DESIGNTABCTRL
+ frmMain_PositionWindows
+ PostMessage(hwnd, MSG_USER_GENERATECODE, 0, 0)
+ end select
+
+ end select
+
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Process WM_ACTIVATEAPP message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnActivateApp( _
+ byval HWnd as HWnd, _
+ byval fActivate as boolean, _
+ byval dwThreadId as DWORD _
+ ) as LRESULT
+
+ if gApp.PreventActivateApp then exit function
+
+ dim pDoc as clsDocument ptr
+
+ ' if the application is losing focus then validate any currently editing property
+ ' in the ToolBox PropertyList and destroy any popup topmenus.
+ if fActivate = false then
+ killAllPopupMenus()
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then DisplayPropertyList(pDoc)
+ exit function
+ end if
+
+ static bInActivateApp as boolean
+ if bInActivateApp then exit function
+
+ ' if the application is gaining focus then determine if any of the loaded
+ ' documents have been modified by an external application. if yes, then ask
+ ' the user if wish to reload.
+ if fActivate = true then
+ if gApp.GetDocumentCount = 0 then exit function
+
+ ' Search all loaded documents
+ dim as FILETIME ft
+ dim as long i, idx, nDocumentCount
+ dim as double nSerial
+ dim as string sText
+
+ bInActivateApp = true
+
+ ' Load all pDoc into array and then process. For each pDoc if the user chooses
+ ' not to reload or wants to bypass, then set the pDoc to zero until eventually
+ ' all pDocs are processed.
+ dim pDocs( gApp.GetDocumentCount - 1) as clsDocument ptr
+ idx = 0
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ if AfxFileExists(pDoc->DiskFilename) then
+ pDoc->DeletedButKeep = false
+ end if
+ pDocs(idx) = pDoc
+ idx = idx + 1
+ pDoc = pDoc->pDocNext
+ loop
+
+ do
+ idx = -1
+ for i as long = 0 to ubound(pDocs)
+ if pDocs(i) then
+ idx = i: exit for
+ end if
+ next
+ if idx = -1 then exit do
+ pDoc = pDocs(idx)
+
+ ' Bypass any 'new' untitled files.
+ if pDoc->IsNewFlag then
+ pDocs(idx) = 0: continue do
+ end if
+
+ ' Has the external file been deleted or is now not available
+ if AfxFileExists(pDoc->DiskFilename) = false then
+ if pDoc->DeletedButKeep = false then
+ ' Ensure that the file is open and displayed
+ frmMain_OpenFileSafely(HWND_FRMMAIN, _
+ false, _ ' bIsNewFile
+ false, _ ' bIsTemplate
+ true, _ ' bShowInTab
+ false, _ ' bIsInclude
+ "", _ ' wszName
+ pDoc ) ' pDocIn
+ if MessageBox( HWND_FRMMAIN, _
+ pDoc->DiskFilename & vbCrLf & _
+ L(286, "This document has been deleted...?"), _
+ L(267, "File Changed"), MB_ICONQUESTION or MB_YESNO) = IDYES then
+ ' Keep the file open and simply mark it as dirty so it can be prompted to be saved.
+ pDoc->UserModified = true
+ else
+ ' No. Close the file.
+ frmMain_OnCommand(HWND_FRMMAIN, IDM_REMOVEFILEFROMPROJECT, 0, 0)
+ pDocs(idx) = 0
+ continue do
+ end if
+ end if
+ pDoc->DeletedButKeep = true
+
+ else
+
+ ' Compare the disk file date time to the value currently
+ ' stored in document class.
+ ft = AfxGetFileLastWriteTime(pDoc->DiskFilename)
+ if AfxFileTimeToVariantTime(ft) <> AfxFileTimeToVariantTime(pDoc->DateFileTime) then
+ OpenSelectedDocument( pDoc->DiskFilename, "" )
+ if MessageBox( HWND_FRMMAIN, _
+ pDoc->DiskFilename & vbCrLf & _
+ L(266, "File was changed by another application. Reload it?"), _
+ L(267, "File Changed"), MB_ICONQUESTION or MB_YESNO) = IDYES then
+
+ dim as CWSTR wszFilename = pDoc->DiskFilename
+ dim as CWSTR wszFileType = pDoc->ProjectFileType
+
+ ' Remove the current file and open the changed file.
+ frmMain_OnCommand(HWND_FRMMAIN, IDM_REMOVEFILEFROMPROJECT, 0, 0)
+
+ ' Ensure that the file is open and displayed
+ dim as clsDocument ptr pDocLoad = _
+ frmMain_OpenFileSafely( HWND_FRMMAIN, _
+ false, _ ' bIsNewFile
+ false, _ ' bIsTemplate
+ true, _ ' bShowInTab
+ false, _ ' bIsInclude
+ wszFilename, _ ' wszName
+ 0 ) ' pDocIn
+
+ pDocLoad->ProjectFileType = wszFileType
+ end if
+ end if
+ pDoc->DateFileTime = AfxGetFileLastWriteTime( pDoc->DiskFilename )
+ end if
+
+ pDocs(idx) = 0
+ loop
+
+ bInActivateApp = false
+
+ end if
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Process WM_CONTEXTMENU message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnContextMenu( _
+ byval HWnd as HWnd, _
+ byval hwndContext as HWnd, _
+ byval xPos as long, _
+ byval yPos as long _
+ ) as LRESULT
+ dim hPopupMenu as HMENU
+ dim pt as POINT
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc = 0 then return 0
+
+ SetFocus hWndContext
+ pt.x = xPos
+ pt.y = yPos
+ ScreenToClient hWndContext, @pt
+ if IsDesignerView(pDoc) then
+ ' Right-click popup menu for visual design form is
+ ' handled in the HandleDesignerRButtonDown function.
+ else
+ hPopupMenu = CreateScintillaContextMenu()
+ end if
+ GetCursorPos @pt
+ TrackPopupMenu hPopupMenu, 0, pt.x, pt.y, 0, HWnd, 0
+ DestroyMenu hPopupMenu
+
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Process WM_DROPFILES message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnDropFiles( _
+ byval HWnd as HWnd, _
+ byval hDrop as HDROP _
+ ) as LRESULT
+
+ ' Get the number of dropped files
+ dim as long nCount = DragQueryFile(hDrop, &HFFFFFFFF, Null, 0)
+ if nCount = 0 then exit function
+
+ dim as long i, nLen
+ dim wszPath as wstring * MAX_PATH
+ dim wFileExt as wstring * MAX_PATH
+
+ For i = 0 To nCount - 1
+ nLen = DragQueryFile(hDrop, i, @wszPath, MAX_PATH)
+ ' Make sure it's a file, not a folder
+ dim fd as WIN32_FIND_DATAW
+ dim hFind as HANDLE = FindFirstFileW(@wszPath, @fd)
+ if hFind <> INVALID_HANDLE_VALUE then
+ FindClose hFind
+ if (fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY then
+ ' Determine what type of file is being dropped. if it is a project file .wfbe then
+ ' use the OpenProject routines, otherwise open it as a regular file.
+ wFileExt = AfxStrPathname( "EXTN", wszPath)
+ wFileExt = Ucase(wFileExt)
+ if wFileExt = ".WFBE" then
+ frmMain_OpenProjectSafely(HWND_FRMMAIN, wszPath)
+ Else
+ ' Test to see if the file is already loaded in the editor. if it is, then
+ ' bypass loading it again thereby creating multiple ghost instances.
+ dim pDoc as clsDocument ptr
+ dim pDocIn as clsDocument ptr
+ pDoc = gApp.GetDocumentPtrByFilename(wszPath)
+ if pDoc then
+ if pDoc->GetActiveScintillaPtr = 0 then pDocIn = pDoc
+ end if
+ if (pDoc = 0) orelse (pDocIn <> 0) then
+ pDoc = frmMain_OpenFileSafely(HWnd, _
+ false, _ ' bIsNewFile
+ false, _ ' bIsTemplate
+ true, _ ' bShowInTab
+ false, _ ' bIsInclude
+ wszPath, _ ' wszName
+ pDocIn, _ ' pDocIn
+ IsFormFilename(wszPath) _
+ )
+
+ ' Give this document a default project type depending on its file extension
+ if (pDoc->IsNewFlag = false) andalso (pDoc->ProjectFileType = FILETYPE_UNDEFINED) then
+ if ( gApp.IsProjectActive = true ) orelse ( gApp.IsProjectLoading = true ) then
+ if pDoc->IsDesigner then
+ pDoc->ProjectFileType = FILETYPE_NORMAL
+ else
+ gApp.ProjectSetFileType( pDoc, pDoc->ProjectFileType )
+ end if
+ end if
+ end if
+
+ end if
+ end if
+ end if
+ end if
+ Next
+
+ DragFinish hDrop
+
+ LoadExplorerFiles()
+ LoadFunctionsFiles()
+
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnClose( byval HWnd as HWnd ) as LRESULT
+
+ ' if configuration option to confirm closing editor is active then ask now.
+ if gConfig.AskExit then
+ if MessageBox( HWND_FRMMAIN, L(275,"Are you sure you want to exit?"), L(276,"Confirm"), _
+ MB_YESNOCANCEL or MB_ICONQUESTION or MB_DEFBUTTON1 ) <> IDYES then
+ return true
+ end if
+ end if
+
+ ' Set global shutdown flag that will bypass removing nodes from project
+ ' treeview, etc. Those tasks simply slow down the exiting of the program.
+ gApp.IsShutdown = true
+
+ ' Save whether the Panel should be shown the next time the program is run.
+ ' Also save the panel width.
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND)
+ gConfig.ShowPanel = IsWindowVisible(HWND_FRMPANEL)
+ gConfig.ShowPanelWidth = pWindow->UnScaleX(AfxGetWindowWidth( HWND_FRMPANEL ))
+
+ ' if a project(s) is already open then save/close it.
+ if gApp.IsProjectActive then
+ if OnCommand_ProjectClose(HWnd) = 0 then return 0
+ end if
+
+ ' Close any open files asking to save any that are dirty
+ if OnCommand_FileClose(HWnd, EFC_CLOSEALL) = 0 then return 0
+
+ DestroyWindow(HWnd)
+
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnDestroy( byval HWnd as HWnd ) as LRESULT
+
+ ' Kill any existing AutoSave timer
+ OnCommand_FileAutoSaveKillTimer()
+
+ ' Output the config settings to disk file
+ gConfig.SaveConfigFile
+
+ ' Disable drag and drop files
+ DragAcceptFiles HWnd, False
+
+ PostQuitMessage(0)
+ function = 0
+end Function
+
+
+' ========================================================================================
+' Process WM_MOUSEMOVE message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnMouseMove( _
+ byval HWnd as HWnd, _
+ byval x as long, _
+ byval y as long, _
+ byval keyflags as UINT _
+ ) as long
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr( HWND_FRMMAIN )
+ if pWindow = 0 then exit function
+
+ dim as RECT rcClient
+ GetClientRect( hwnd, @rcClient )
+
+ ' HITTEST (DOCUMENT SPLITTER)
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ dim as Rect rc
+ dim as Point pt = (x, y)
+ if pDoc->bSizing then
+ if pt.y <> pDoc->ptPrev.y then
+ pDoc->SplitY = pDoc->SplitY + (pt.y - pDoc->ptPrev.y)
+ ' Don't let the split go all the way to the bottom of the edit window
+ if pDoc->SplitY + pWindow->ScaleY(40) >= rcClient.bottom then
+ else
+ frmMain_PositionWindows
+ pDoc->ptPrev.y = pt.y
+ end if
+ end if
+ else
+ if PtInRect(@pDoc->rcSplitButton, pt) then
+ SetCursor( ghCursorSizeNS )
+ end if
+ end if
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_LBUTTONDOWN message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnLButtonDown( _
+ byval HWnd as HWnd, _
+ byval fDoubleClick as boolean, _
+ byval x as long, _
+ byval y as long, _
+ byval keyflags as UINT _
+ ) as long
+
+ ' if main window area clicked then close any active top menus
+ killAllPopupMenus()
+
+ ' HITTEST (DOCUMENT SPLITTER)
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ dim as Rect rc
+ dim as POINT pt = (x, y)
+ if PtInRect(@pDoc->rcSplitButton, pt) then
+ pDoc->bSizing = true
+ pDoc->SplitY = pDoc->rcSplitButton.top
+ pDoc->ptPrev.y = pt.y
+ SetCursor( ghCursorSizeNS )
+ SetCapture( HWND_FRMMAIN )
+ end if
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_LBUTTONUP message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnLButtonUp( _
+ byval HWnd as HWnd, _
+ byval x as long, _
+ byval y as long, _
+ byval keyflags as UINT _
+ ) as long
+
+ ' HITTEST (DOCUMENT SPLITTER)
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ if pDoc->bSizing then
+ pDoc->bSizing = false
+ ReleaseCapture
+ ' if we try to split before the start of the code window then simply
+ ' stop the splitting altogether.
+ dim as RECT rc = AfxGetWindowRect( pDoc->hWindow(1) )
+ MapWindowPoints( HWND_DESKTOP, HWND_FRMMAIN, cast(POINT ptr, @rc), 2 )
+ if pDoc->SplitY <= rc.top then
+ pDoc->SplitY = 0
+ pDoc->bEditorIsSplit = false
+ frmMain_PositionWindows()
+ end if
+ end if
+ end if
+ SetCursor( LoadCursor( null, IDC_ARROW ))
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_LBUTTONDBLCLK message for window/dialog: frmMain
+' ========================================================================================
+function frmMain_OnLButtonDblClk( _
+ byval HWnd as HWnd, _
+ byval fDoubleClick as boolean, _
+ byval x as long, _
+ byval y as long, _
+ byval keyflags as UINT _
+ ) as long
+
+ if gApp.bDragActive = false then
+ ' Are we over a split edit area (toggle off the split)
+ dim as POINT pt = (x, y)
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ if PtInRect(@pDoc->rcSplitButton, pt) then
+ pDoc->bSizing = false
+ pDoc->SplitY = 0
+ pDoc->bEditorIsSplit = false
+ ReleaseCapture
+ frmMain_PositionWindows
+ end if
+ end if
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmMain Window procedure
+' ========================================================================================
+function frmMain_WndProc( _
+ byval HWnd as HWnd, _
+ byval uMsg as UINT, _
+ byval wParam as WPARAM, _
+ byval lParam as LPARAM _
+ ) as LRESULT
+
+ select case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmMain_OnCreate)
+ HANDLE_MSG (HWnd, WM_PAINT, frmMain_OnPaint)
+ HANDLE_MSG (HWnd, WM_SIZE, frmMain_OnSize)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmMain_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmMain_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmMain_OnCommand)
+ HANDLE_MSG (HWnd, WM_NOTIFY, frmMain_OnNotify)
+ HANDLE_MSG (HWnd, WM_ACTIVATEAPP, frmMain_OnActivateApp)
+ HANDLE_MSG (HWnd, WM_CONTEXTMENU, frmMain_OnContextMenu)
+ HANDLE_MSG (HWnd, WM_DROPFILES, frmMain_OnDropFiles)
+ HANDLE_MSG (HWnd, WM_LBUTTONDOWN, frmMain_OnLButtonDown)
+ HANDLE_MSG (HWnd, WM_LBUTTONUP, frmMain_OnLButtonUp)
+ HANDLE_MSG (HWnd, WM_MOUSEMOVE, frmMain_OnMouseMove)
+ HANDLE_MSG (HWnd, WM_LBUTTONDBLCLK, frmMain_OnLButtonDblClk)
+
+ case WM_ERASEBKGND
+ return true ' prevents painting the background
+
+ case WM_MOVE
+ ' Ensure that if the Find/Replace dialog is open that it moves with
+ ' underlying main WinFBE window.
+ frmFindReplace_PositionWindows
+
+ case WM_NCACTIVATE
+ ' Ensure that the caption bar for any DesignerForm retains its active
+ ' state. This looks better than having it lose and gain active colors.
+ if wParam then
+ ' The DesignerForm never receives the WM_NCACTIVATE message because it
+ ' is a child form. We need to manually send it the message whenever the
+ ' focus of the Designer form changes (i.e. whenever we switch back and
+ ' forth away from the main application window).
+ PostMessage HWND, MSG_USER_SETFOCUS, 0, 0
+ end if
+
+ ' if wParam is false then the system wants to draw an inactive title bar. we
+ ' will prevent this action if a popup menu from the menubar is active.
+ if wParam = false then
+ if gPrevent_WM_NCACTIVATE then return false
+ end if
+
+ case WM_SYSCOMMAND
+ if (wParam and &HFFF0) = SC_CLOSE then
+ SendMessage( HWND, WM_CLOSE, wParam, lParam )
+ exit function
+ end if
+
+ case WM_SETCURSOR
+ if gApp.bDragActive = true then
+ ' Either the horiz or vert splitter bar is being resized. We handle
+ ' setting the mouse cursor in the splitter_mousemove function.
+ return true
+
+ elseif gApp.bDragTabActive = true then
+ ' We handle the cursor in the TabControl subclass. Don't allow the
+ ' main window to change our cursor. return true.
+ return true
+
+ elseif (gApp.IsCompiling = true) or _
+ (gApp.IsProjectLoading = true) or _
+ (gApp.IsFileLoading = true) then
+ SetCursor( LoadCursor(0, IDC_WAIT) )
+ return true
+ end if
+
+ case WM_CAPTURECHANGED
+ gApp.bDragTabActive = false
+
+ case WM_SETFOCUS
+ frmMain_SetFocusToCurrentCodeWindow
+
+ case WM_COPYDATA ' used during processing of commandline
+ dim pDataToGet as COPYDATASTRUCT ptr
+ dim pwszArg as wstring ptr
+ dim wszExt as wstring * MAX_PATH
+
+ pDataToGet = cast(COPYDATASTRUCT ptr, lParam)
+ pwszArg = pDataToGet->lpData
+
+ ' We have a valid filename so determine what type it is.
+ wszExt = AfxStrPathname( "EXTN", *pwszArg )
+ wszExt = ucase(wszExt)
+
+ select case wszExt
+ case ".WFBE" ' project file
+ ' Pass the info to our generic project open function to handle everything.
+ frmMain_OpenProjectSafely(HWND_FRMMAIN, *pwszArg)
+
+ case else ' .bas, .bi, .rc, etc...
+ dim pDoc as clsDocument ptr
+ pDoc = frmMain_OpenFileSafely( HWND, _
+ false, _ ' bIsNewFile
+ false, _ ' bIsTemplate
+ true, _ ' bShowInTab
+ false, _ ' bIsInclude
+ *pwszArg, _ ' pwszName
+ 0 ) ' pDocIn
+ if pDoc then UpdateMRUList(pDoc->DiskFilename)
+ end select
+
+
+ '' CUSTOM MESSAGES
+
+ case MSG_USER_UPGRADE302FORM
+ ' After a form file is loaded a PostMessage is made using this custom message
+ ' in order to initiate an upgrade check on that file.
+ if lParam then
+ dim pDoc as clsDocument ptr = cast(clsDocument ptr, lParam)
+ FormUpgrade302Format( pDoc )
+ end if
+
+ case MSG_USER_TOPTABS_CHANGING
+ ' Hide the current tab
+ gTTabCtl.DisplayScintilla( gTTabCtl.CurSel, false )
+ exit function
+
+ case MSG_USER_TOPTABS_CHANGED
+ ' Show the new tab
+ gTTabCtl.DisplayScintilla( gTTabCtl.CurSel, true )
+ frmMain_PositionWindows
+ dim pDoc as clsDocument ptr = gTTabCtl.tabs(gTTabCtl.CurSel).pDoc
+ if pDoc then
+ AfxRedrawWindow( pdoc->hWindow(0) ) ' makes the code window display quicker especially when loading Project.
+ if pDoc->IsDesigner andalso IsDesignerView(pDoc) then
+ DisplayPropertyList( pDoc )
+ end if
+ end if
+ ' Set the focus to the Scintilla window. This will call frmMain_SetStatusbar.
+ frmMain_SetFocusToCurrentCodeWindow()
+ exit function
+
+ case MSG_USER_SETFOCUS
+ ' Set focus to current Scintilla window and update the document
+ ' display such as Line#, Col#, Filename, etc.
+ frmMain_SetStatusbar
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ if pDoc->IsDesigner then
+ SendMessage pDoc->hWndForm, WM_NCACTIVATE, true, 0
+ end if
+ SetFocus( pDoc->hWndActiveScintilla )
+ end if
+
+ case MSG_USER_PROCESS_COMMANDLINE
+ ' process any command line arguments that may have been passed to the program.
+ frmMain_ProcessCommandLine(HWnd)
+
+ case MSG_USER_PROCESS_UPDATECHECK
+ ' perform an update check one per day if the option has been set by the user.
+ if gConfig.CheckForUpdates then
+ dim as long curJulian = JulianDateNow
+ if gConfig.LastUpdateCheck <> curJulian then
+ DoCheckForUpdates( hwnd, true ) ' no messages if up to date
+ end if
+ ' Save the config file so that other editor instances will not also do update checks again
+ gConfig.LastUpdateCheck = curJulian
+ gConfig.SaveConfigFile
+ end if
+
+ case MSG_USER_PROCESS_STARTUPUSERTOOLS
+ ' process any User Tools that must display immediately after the main WinFBE
+ ' user interface is created and displayed.
+
+ ' Wait a bit to ensure that the WinFBE window is visible... This loop
+ ' is mostly never necessary but better to check just to be consistent.
+ dim as double nStartTime = timer
+ do
+ if IsWindowVisible( HWND_FRMMAIN ) then exit do
+ ' if we've waited more than 5 seconds then break out to avoid
+ ' an infite loop.
+ if (timer - nStartTime) > 5 then exit do
+ loop
+
+ ' Only invoke any User Tools that have action for startup
+ for y as long = lbound(gConfig.Tools) to ubound(gConfig.Tools)
+ if gConfig.Tools(y).Action = USERTOOL_ACTION_WINFBESTARTUP then
+ frmUserTools_ExecuteUserTool(y)
+ end if
+ NEXT
+
+
+ case MSG_USER_GENERATECODE
+ dim pDoc as clsDocument ptr
+ if lParam = 0 then
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ else
+ pDoc = cast(clsDocument ptr, lParam)
+ end if
+ if pDoc then
+ pDoc->bRegenerateCode = true
+ if IsDesignerView(pDoc) = false then ' clicked on the code window
+ dim as hwnd hEdit = pDoc->hWindow(0)
+ dim as long nFirstLine = SendMessage( hEdit, SCI_GETFIRSTVISIBLELINE, 0, 0)
+ dim as long curPos = SendMessage( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ GenerateFormCode(pDoc)
+ if curPos >=0 then SendMessage( hEdit, SCI_GOTOPOS, curPos, 0)
+ if nFirstLine >=0 then SendMessage( hEdit, SCI_SETFIRSTVISIBLELINE, nFirstLine, 0)
+ else
+ GenerateFormCode(pDoc)
+ end if
+ end if
+
+ case MSG_USER_SHOWAUTOCOMPLETE
+ return ShowAutocompleteList()
+
+ case MSG_USER_APPENDEQUALSSIGN
+ ' The = key was used to terminate a popup autocomplete. Take that
+ ' character and format it with a space before and a space after.
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ dim as long nPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ dim as string sWord = " = "
+ SciExec( hEdit, SCI_SETSEL, nPos-1, nPos)
+ SciExec( hEdit, SCI_REPLACESEL, 0, cast(LPARAM, Strptr(sWord)))
+ nPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ SciExec( hEdit, SCI_SETSEL, nPos, nPos)
+ end if
+
+
+ '-------------------------------------------------------------------------------
+ ' Scrollbar Handler
+ '-------------------------------------------------------------------------------
+ case WM_VSCROLL
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc = 0 then return 0
+
+' dim as long OldPos = pDoc->ScrInfo.nPos
+
+' select case loword(wParam)
+' case SB_THUMBTRACK
+' GetScrollInfo(pDoc->hScrollbar, SB_CTL, @pDoc->ScrInfo)
+' pDoc->ScrInfo.nPos = pDoc->ScrInfo.nTrackPos
+' case SB_LINEDOWN: pDoc->ScrInfo.nPos += 1
+' case SB_LINEUP: pDoc->ScrInfo.nPos -= 1
+' case SB_PAGEDOWN: pDoc->ScrInfo.nPos += pDoc->ScrInfo.nPage - 1
+' case SB_PAGEUP: pDoc->ScrInfo.nPos -= pDoc->ScrInfo.nPage - 1
+' end select
+
+' ' if the current position hasn't changed, do nothing.
+' if pDoc->ScrInfo.nPos = oldPos then return true
+
+' ' Don't exceed range boundries
+' if pDoc->ScrInfo.nPos < pDoc->ScrInfo.nMin then
+' pDoc->ScrInfo.nPos = pDoc->ScrInfo.nMin
+' end if
+' if pDoc->ScrInfo.nPos > pDoc->ScrInfo.nMax - pDoc->ScrInfo.nPage + 1 then
+' pDoc->ScrInfo.nPos = pDoc->ScrInfo.nMax - pDoc->ScrInfo.nPage + 1
+' end if
+
+' dim as long lParm = pDoc->ScrInfo.nPos - oldPos ' Amount/direction to V scroll
+' SciExec(pDoc->hWindow(0), SCI_LINESCROLL, 0, lParm)
+' SetScrollInfo(pDoc->hScrollbar, SB_CTL, @pDoc->ScrInfo, true)
+
+ end select
+
+ ' for messages that we don't deal with
+ function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+end Function
+
+
+' ========================================================================================
+' frmMain_Show
+' ========================================================================================
+function frmMain_Show( byval hWndParent as HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ dim pWindow as CWindow ptr = new CWindow("WinFBE_Class")
+ ' Comment out the next line to let WinFBE use the current active system DPI setting.
+ 'pWindow->DPI = 144 ' eg. 144 or any other value (96 is default)
+
+ HWND_FRMMAIN = pWindow->Create( null, APPNAME, @frmMain_WndProc )
+
+ ' Load the currently selected theme (this needs a valid pWindow HWND_FRMMAIN to exists)
+ LoadThemeFile()
+
+ ' Set the small and large icon for the main window (must be set after main window is created)
+ pWindow->BigIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 32, 32, LR_SHARED)
+ pWindow->SmallIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 16, 16, LR_SHARED)
+
+ ' Load the good and bad compile "icons"
+ ghIconGood = 1
+ ghIconBad = 2
+
+ ' Load the tick and untick icons
+ dim cx as long = 16 * (pWindow->DPI \ 96)
+ ghIconTick = LoadImage( pWindow->InstanceHandle, "IMAGE_TICK", IMAGE_ICON, cx, cx, LR_DEFAULTCOLOR )
+ ghIconNoTick = LoadImage( pWindow->InstanceHandle, "IMAGE_NOTICK", IMAGE_ICON, cx, cx, LR_DEFAULTCOLOR )
+
+ ' Load the North/South and East/West cursor images
+ ghCursorSizeNS = LoadImage( Null, MAKEINTRESOURCEW(OCR_SIZENS), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or LR_SHARED )
+ ghCursorSizeWE = LoadImage( Null, MAKEINTRESOURCEW(OCR_SIZEWE), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or LR_SHARED )
+
+ ' Build the keyboard accelerators
+ frmKeyboard_BuildAcceleratorTable
+
+ ' Create the main application topmenu menubar
+ frmMenuBar_Show( HWND_FRMMAIN )
+
+ ' Create the main application top tabs control
+ frmTopTabs_Show( HWND_FRMMAIN )
+
+ ' Create the main application design tabs control
+ frmDesignTabs_Show( HWND_FRMMAIN )
+
+ ' Create the main application statusbar
+ frmStatusBar_Show( HWND_FRMMAIN )
+
+ ' Create the various child windows
+ frmPanel_Show( HWND_FRMMAIN )
+ frmPanelVScroll_Show( HWND_FRMMAIN )
+ frmOutput_Show( HWND_FRMMAIN )
+ frmEditorHScroll_Show( HWND_FRMMAIN )
+ frmEditorVScroll_Show( HWND_FRMMAIN )
+
+ ' Create the UserTools accelerator table
+ frmUserTools_CreateAcceleratorTable
+
+ ' SET STARTUP POSITION
+ ' if no valid window size exists then set to the default working area of the screen
+ if (gConfig.StartupRight = 0) orelse (gConfig.StartupBottom = 0) then
+ ' Retrieve the size of the working area
+ dim rc as Rect = pWindow->GetWorkArea
+ gConfig.StartupRight = rc.Right
+ gConfig.StartupBottom = rc.Bottom
+ end if
+
+ dim WinPla as WINDOWPLACEMENT
+ with WinPla
+ .Length = sizeof(WinPla)
+ .rcNormalPosition.Left = gConfig.StartupLeft
+ .rcNormalPosition.Top = gConfig.StartupTop
+ .rcNormalPosition.Right = gConfig.StartupRight
+ .rcNormalPosition.Bottom = gConfig.StartupBottom
+ .showCmd = iif( gConfig.StartupMaximized, SW_MAXIMIZE, SW_SHOWNORMAL )
+ end with
+ SetWindowPlacement( pWindow->hWindow, @WinPla )
+
+ ' Ensure the window is placed on screen should the user had changed
+ ' the logical ordering of a multiple display setup.
+ AfxForceVisibleDisplay( pWindow->hWindow )
+
+ UpdateWindow( pWindow->hWindow )
+
+ ' Post a message to process the application's command line as applicable.
+ PostMessage( pWindow->hWindow, MSG_USER_PROCESS_COMMANDLINE, 0, 0 )
+
+ ' Only restore session if that option is active. The session file may contain
+ ' a reference to a project if the last session was a project.
+ if gConfig.RestoreSession then
+ if AfxFileExists( gConfig.wszLastActiveSession ) then
+ gConfig.LoadSessionFile( gConfig.wszLastActiveSession )
+ end if
+ end if
+
+ ' Post a message to process any User Tools that must start after WinFBE displays.
+ PostMessage( pWindow->hWindow, MSG_USER_PROCESS_STARTUPUSERTOOLS, 0, 0 )
+
+ ' Post a message to do an update check (if applicable)
+ PostMessage( pWindow->hWindow, MSG_USER_PROCESS_UPDATECHECK, 0, 0 )
+
+ ' Start AutoSave timer if that option is enabled
+ OnCommand_FileAutoSaveStartTimer()
+
+ ' Process windows events
+ dim uMsg as MSG
+
+ ' Message loop
+ do while GetMessage(@uMsg, null, 0, 0)
+
+ if handleMouseScrollBar(uMsg) then continue do
+ if handleMouseShowScrollBar(uMsg) then continue do
+ if handleMouseTopMenu(uMsg) then continue do
+ if handleAltKeyMenuBar(uMsg) then continue do
+
+ ' Processes accelerator keys for menu commands
+ if (pWindow->AccelHandle = 0) orelse (TranslateAccelerator(pWindow->hWindow, pWindow->AccelHandle, @uMsg) = 0) then
+
+ if (ghAccelUserTools = 0) orelse (TranslateAccelerator(pWindow->hWindow, ghAccelUserTools, @uMsg) = 0) then
+
+ ' Prevent any < asc(32) characters from making their way to Scintilla where they
+ ' get shown as an embedded control graphic. Allow backspace.
+ if (uMsg.message = WM_CHAR) then
+ if (uMsg.wParam < 32) andalso (uMsg.wParam <> 8) then continue do
+ ' Save the pdoc->LastCharTyped to use in our autocomplete popups
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 then pdoc->LastCharTyped = uMsg.wParam
+ end if
+
+ ' Save the pdoc->LastCharTyped to use in our autocomplete popups
+ if (uMsg.message = WM_KEYDOWN) then
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then pdoc->LastCharTyped = uMsg.wParam
+ end if
+
+ ' if topmenus or menubar are active then process all keyboard input for them rather than
+ ' passing it off to the system to process.
+ if handleKeysTopMenu(uMsg) then continue do
+
+ ' Was ENTER key pressed while scrolling the Explorer listbox via keyboard
+ if handleKeysExplorerListBox(uMsg) then continue do
+
+ ' Close with ESC key: Find/Replace, FindInFiles, FunctionList window
+ if handleEscKeyModeless(uMsg) then continue do
+
+ ' Handle any keypress that would move or resize control(s) on a Designer Form.
+ if handleKeysVisualDesigner(uMsg) then continue do
+
+ ' Handle ENTER key for active FindReplace dialog
+ if handleKeysFindReplace(uMsg) then continue do
+
+ ' Check for any QuickRun exes that can be deleted.
+ gApp.CheckQuickRunExe()
+
+ ' Check if the WinFBE.ini file was changed by an external program.
+ ' Reload the config file in case a user has automated a change to it since
+ ' the application started (for example, changing the compiler path).
+ gConfig.ReloadConfigFileTest()
+
+ ' Determines whether a message is intended for the specified
+ ' dialog box and, if it is, processes the message.
+ ' Ensure keystrokes like TAB are properly handled by the modeless dialogs
+ if AfxCAxHostForwardMessage(GetFocus, @uMsg) = false then
+ if IsDialogMessage( HWND_FRMFINDREPLACE, @uMsg ) then Continue Do
+ if IsDialogMessage( HWND_FRMHELPVIEWER, @uMsg ) then Continue Do
+
+ if IsDialogMessage(pWindow->hWindow, @uMsg) = 0 then
+ TranslateMessage @uMsg ' Translates virtual-key messages into character messages.
+ DispatchMessage @uMsg ' Dispatches a message to a window procedure.
+ end if
+ end if
+
+ end if 'accelerator user tools
+ end if ' accelerators
+ loop ' message loop
+
+ function = uMsg.wParam
+
+ if ghIconTick then DestroyIcon( ghIconTick )
+ if ghIconNoTick then DestroyIcon( ghIconNoTick )
+
+ if ghAccelUserTools then DestroyAcceleratorTable( ghAccelUserTools )
+
+ ' delete the allocated memory for the various child windows
+ pWindow = AfxCWindowPtr( HWND_FRMHELPVIEWER ): delete pWindow
+ pWindow = AfxCWindowPtr( HWND_FRMPANEL ): delete pWindow
+ pWindow = AfxCWindowPtr( HWND_FRMPANEL_VSCROLLBAR ): delete pWindow
+ pWindow = AfxCWindowPtr( HWND_FRMEDITOR_HSCROLLBAR(0) ): delete pWindow
+ pWindow = AfxCWindowPtr( HWND_FRMEDITOR_HSCROLLBAR(1) ): delete pWindow
+ pWindow = AfxCWindowPtr( HWND_FRMEDITOR_VSCROLLBAR(0) ): delete pWindow
+ pWindow = AfxCWindowPtr( HWND_FRMEDITOR_VSCROLLBAR(1) ): delete pWindow
+ pWindow = AfxCWindowPtr( HWND_FRMOUTPUT ): delete pWindow
+ pWindow = AfxCWindowPtr( HWND_FRMMAIN ): delete pWindow
+
+end function
+
diff --git a/src/frmMainCompile.inc b/src/frmMainCompile.inc
index 72782808..2cc11170 100644
--- a/src/frmMainCompile.inc
+++ b/src/frmMainCompile.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMainCompile.inc.bak b/src/frmMainCompile.inc.bak
new file mode 100644
index 00000000..72782808
--- /dev/null
+++ b/src/frmMainCompile.inc.bak
@@ -0,0 +1,38 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMain.bi"
+#include once "clsDocument.bi"
+
+' ========================================================================================
+' Compile common actions
+' ========================================================================================
+function OnCommand_CompileCommon( byval id as long ) as LRESULT
+
+ select case id
+ Case IDM_BUILDEXECUTE, IDM_COMPILE, IDM_REBUILDALL, IDM_QUICKRUN
+ code_Compile( id )
+
+ Case IDM_RUNEXE
+ RunExe( _
+ GetRunExecutableFilename, _
+ iif( gApp.IsProjectActive, gApp.ProjectCommandLine, gApp.wszCommandLine ) _
+ )
+
+ Case IDM_COMMANDLINE
+ frmCommandLine_Show( HWND_FRMMAIN )
+ end select
+
+ function = 0
+end function
+
diff --git a/src/frmMainDesigner.inc b/src/frmMainDesigner.inc
index 3956da04..2185008c 100644
--- a/src/frmMainDesigner.inc
+++ b/src/frmMainDesigner.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMainDesigner.inc.bak b/src/frmMainDesigner.inc.bak
new file mode 100644
index 00000000..3956da04
--- /dev/null
+++ b/src/frmMainDesigner.inc.bak
@@ -0,0 +1,570 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMain.bi"
+#include once "clsDocument.bi"
+
+
+' ========================================================================================
+' Show Visual Designer ToolBox
+' ========================================================================================
+Function OnCommand_DesignerToolBox( ByVal HWnd As HWnd ) As LRESULT
+ frmVDToolbox_Show( HWnd ) ' toggle show/hide
+ function = 0
+end function
+
+' ========================================================================================
+' Show Visual Designer Menu Editor
+' ========================================================================================
+Function OnCommand_DesignerMenuEditor( _
+ ByVal HWnd As HWnd, _
+ byval pDoc as clsDocument ptr _
+ ) As LRESULT
+ frmMenuEditor_Show( HWND )
+ if pDoc then frmMenuEditor_CreateFakeMainMenu( pDoc )
+ function = 0
+end function
+
+' ========================================================================================
+' Show Visual Designer ToolBar Editor
+' ========================================================================================
+Function OnCommand_DesignerToolBarEditor( _
+ ByVal HWnd As HWnd, _
+ byval pDoc as clsDocument ptr _
+ ) As LRESULT
+ frmToolBarEditor_Show( HWND )
+ if pDoc then frmToolBarEditor_CreateFakeToolBar( pDoc )
+ function = 0
+end function
+
+' ========================================================================================
+' Show Visual Designer StatusBar Editor
+' ========================================================================================
+Function OnCommand_DesignerStatusBarEditor( _
+ ByVal HWnd As HWnd, _
+ byval pDoc as clsDocument ptr, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+ ' If a Panel was clicked on then WPARAM would have been set to the
+ ' ControlID and panel index. When message cracked, that value would show as the
+ ' incoming codeNotify for this message.
+ ' Do a check to ensure that the panel click index is within the
+ ' acceptable ranges.
+ if pDoc then
+ dim as long nIndex = cast(long, codeNotify)
+ if (nIndex < lbound(pDoc->PanelItems)) or _
+ (nIndex > ubound(pDoc->PanelItems)) then
+ nIndex = 0
+ end if
+ frmStatusBarEditor_Show( HWND, nIndex )
+ frmStatusBarEditor_CreateFakeStatusBar( pDoc )
+ end if
+ function = 0
+end function
+
+' ========================================================================================
+' Show Visual Designer Image Manager
+' ========================================================================================
+Function OnCommand_DesignerImageManager( _
+ ByVal HWnd As HWnd, _
+ byval pDoc as clsDocument ptr _
+ ) As LRESULT
+ frmImageManager_Show( HWND, 0 )
+ function = 0
+end function
+
+' ========================================================================================
+' Visual Designer Snap Lines
+' ========================================================================================
+Function OnCommand_DesignerSnapLines( byval pDoc as clsDocument ptr ) As LRESULT
+ if pDoc then
+ pDoc->bSnapLines = not pDoc->bSnapLines
+ pDoc->UserModified = true
+ frmMain_SetStatusbar
+ end if
+ function = 0
+end function
+
+' ========================================================================================
+' Visual Designer Lock Controls
+' ========================================================================================
+Function OnCommand_DesignerLockControls( byval pDoc as clsDocument ptr ) As LRESULT
+ if pDoc then
+ pDoc->bLockControls = not pDoc->bLockControls
+ pDoc->UserModified = true
+ AfxRedrawWindow(pDoc->hWndFrame)
+ AfxRedrawWindow(pDoc->hWndForm)
+ frmMain_SetStatusbar
+ end if
+ function = 0
+end function
+
+
+' ========================================================================================
+' Create a new visual designer window
+' ========================================================================================
+Function OnCommand_DesignerNewForm( ByVal HWnd As HWnd ) As LRESULT
+ frmMain_OpenFileSafely( HWnd, _
+ True, _ ' bIsNewFile
+ False, _ ' bIsTemplate
+ True, _ ' bShowInTab
+ false, _ ' bIsInclude
+ "", _ ' wszName
+ 0, _ ' pDocIn
+ true ) ' Create a visual designer
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Horizonal Spacing (controls on the form)
+' ========================================================================================
+function OnCommand_DesignerHorizSpacing( _
+ byval HWND as HWND, _
+ byval id as long _
+ ) as LRESULT
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc = 0 THEN exit function
+
+ dim pCtrlActive as clsControl ptr = pDoc->Controls.GetActiveControl()
+ if pCtrlActive = 0 THEN exit function
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(hwnd)
+ if pWindow = 0 then exit function
+
+ dim pCtrl as clsControl ptr
+ dim as RECT rcCtrl, rcActive
+
+ dim as long NumSelected = pDoc->Controls.SelectedControlsCount
+ dim as long nTotalRectWidth, nLeft
+
+ ' Load all selected controls into array for easy processing
+ dim pCtrls( 1 to NumSelected ) as clsControl ptr
+
+ dim as long nextCtrl = 1
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->IsSelected THEN
+ rcCtrl = GetControlRECT(pCtrl)
+ nTotalRectWidth = nTotalRectWidth + (rcCtrl.right - rcCtrl.left)
+ pCtrls(nextCtrl) = pCtrl
+ nextCtrl = nextCtrl + 1
+ END IF
+ next
+
+ ' Sort the array based on Left (small to large)(bubble sort)
+ dim done as long
+ do
+ done = 0
+ For i as long = 1 To NumSelected - 1
+ If val(GetControlProperty(pCtrls(i), "LEFT")) > val(GetControlProperty(pCtrls(i+1), "LEFT")) Then
+ Swap pCtrls(i), pCtrls(i+1)
+ done = 1
+ End If
+ Next
+ Loop Until done = 0
+
+ dim as RECT rcCtrlLeft = GetControlRECT(pCtrls(1))
+ dim as RECT rcCtrlRight = GetControlRECT(pCtrls(NumSelected))
+ dim as long nFreeSpace = rcCtrlRight.right - rcCtrlLeft.left - nTotalRectWidth
+ dim as long nEqualSpace = nFreeSpace / (NumSelected - 1)
+
+ If id = IDM_HORIZREMOVE Then nEqualSpace = 0
+
+ ' Determine the position in the array of the active control
+ dim as long nActiveControlIndex = 0
+ for i as long = 1 to NumSelected
+ if pCtrls(i) = pCtrlActive then
+ nActiveControlIndex = i: exit for
+ end if
+ next
+
+ ' Adjust all of the controls to the left of the active control and then adjust
+ ' all of the controls to the right of the active control.
+ for i as long = nActiveControlIndex - 1 to 1 step -1
+ pCtrl = pCtrls(i)
+ if IsControlLocked(pDoc, pCtrl) then continue for
+
+ ' Get coordinates of current (Left) and (Right) controls
+ rcCtrlLeft = GetControlRECT( pCtrls(i) )
+ rcCtrlRight = GetControlRECT( pCtrls(i+1) )
+
+ select case id
+ case IDM_HORIZEQUAL, IDM_HORIZREMOVE
+ nLeft = rcCtrlLeft.left + (rcCtrlRight.left - rcCtrlLeft.right) - nEqualSpace
+ case IDM_HORIZINCREASE
+ nLeft = rcCtrlLeft.left - 8
+ case IDM_HORIZDECREASE
+ nLeft = rcCtrlLeft.left + 8
+ end select
+
+ SetControlProperty( pCtrl, "LEFT", str(nLeft) )
+ ApplyControlProperties( pDoc, pCtrl )
+ next
+
+ for i as long = nActiveControlIndex + 1 to NumSelected
+ pCtrl = pCtrls(i)
+ if IsControlLocked(pDoc, pCtrl) then continue for
+
+ ' Get coordinates of current (Left) and (Right) controls
+ rcCtrlLeft = GetControlRECT( pCtrls(i-1) )
+ rcCtrlRight = GetControlRECT( pCtrls(i) )
+
+ select case id
+ case IDM_HORIZEQUAL, IDM_HORIZREMOVE
+ nLeft = rcCtrlRight.left + nEqualSpace - (rcCtrlRight.left - rcCtrlLeft.right)
+ case IDM_HORIZINCREASE
+ nLeft = rcCtrlRight.left + 8
+ case IDM_HORIZDECREASE
+ nLeft = rcCtrlRight.left - 8
+ end select
+
+ SetControlProperty( pCtrl, "LEFT", str(nLeft) )
+ ApplyControlProperties( pDoc, pCtrl )
+ next
+
+ ' Ensure the grab handles are redrawn
+ AfxRedrawWindow(pDoc->hWndForm)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Vertical Spacing (controls on the form)
+' ========================================================================================
+function OnCommand_DesignerVertSpacing( _
+ byval HWND as HWND, _
+ byval id as long _
+ ) as LRESULT
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc = 0 THEN exit function
+
+ dim pCtrlActive as clsControl ptr = pDoc->Controls.GetActiveControl()
+ if pCtrlActive = 0 THEN exit function
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(hwnd)
+ if pWindow = 0 then exit function
+
+ dim pCtrl as clsControl ptr
+ dim as RECT rcCtrl, rcActive
+
+ dim as long NumSelected = pDoc->Controls.SelectedControlsCount
+ dim as long nTotalRectHeight, nTop
+
+ ' Load all selected controls into array for easy processing
+ dim pCtrls( 1 to NumSelected ) as clsControl ptr
+
+ dim as long nextCtrl = 1
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->IsSelected THEN
+ rcCtrl = GetControlRECT(pCtrl)
+ nTotalRectHeight = nTotalRectHeight + (rcCtrl.bottom - rcCtrl.top)
+ pCtrls(nextCtrl) = pCtrl
+ nextCtrl = nextCtrl + 1
+ END IF
+ next
+
+ ' Sort the array based on top (small to large)(bubble sort)
+ dim done as long
+ do
+ done = 0
+ For i as long = 1 To NumSelected - 1
+ If val(GetControlProperty(pCtrls(i), "TOP")) > val(GetControlProperty(pCtrls(i+1), "TOP")) Then
+ Swap pCtrls(i), pCtrls(i+1)
+ done = 1
+ End If
+ Next
+ Loop Until done = 0
+
+ dim as RECT rcCtrlTop = GetControlRECT(pCtrls(1))
+ dim as RECT rcCtrlBottom = GetControlRECT(pCtrls(NumSelected))
+ dim as long nFreeSpace = rcCtrlBottom.bottom - rcCtrlTop.top - nTotalRectHeight
+ dim as long nEqualSpace = nFreeSpace / (NumSelected - 1)
+
+ If id = IDM_VERTREMOVE Then nEqualSpace = 0
+
+ ' Determine the position in the array of the active control
+ dim as long nActiveControlIndex = 0
+ for i as long = 1 to NumSelected
+ if pCtrls(i) = pCtrlActive then
+ nActiveControlIndex = i: exit for
+ end if
+ next
+
+ ' Adjust all of the controls above the active control and then adjust
+ ' all of the controls below the active control.
+ for i as long = nActiveControlIndex - 1 to 1 step -1
+ pCtrl = pCtrls(i)
+ if IsControlLocked(pDoc, pCtrl) then continue for
+
+ ' Get coordinates of current (Left) and (Right) controls
+ rcCtrlTop = GetControlRECT( pCtrls(i) )
+ rcCtrlBottom = GetControlRECT( pCtrls(i+1) )
+
+ select case id
+ case IDM_VERTEQUAL, IDM_VERTREMOVE
+ nTop = rcCtrlTop.top + (rcCtrlBottom.top - rcCtrlTop.bottom) - nEqualSpace
+ case IDM_VERTINCREASE
+ nTop = rcCtrlTop.top - 8
+ case IDM_VERTDECREASE
+ nTop = rcCtrlTop.top + 8
+ end select
+
+ SetControlProperty( pCtrl, "TOP", str(nTop) )
+ ApplyControlProperties( pDoc, pCtrl )
+ next
+
+ for i as long = nActiveControlIndex + 1 to NumSelected
+ pCtrl = pCtrls(i)
+ if IsControlLocked(pDoc, pCtrl) then continue for
+
+ ' Get coordinates of current (Left) and (Right) controls
+ rcCtrlTop = GetControlRECT( pCtrls(i-1) )
+ rcCtrlBottom = GetControlRECT( pCtrls(i) )
+
+ select case id
+ case IDM_VERTEQUAL, IDM_VERTREMOVE
+ nTop = rcCtrlBottom.top + nEqualSpace - (rcCtrlBottom.top - rcCtrlTop.bottom)
+ case IDM_VERTINCREASE
+ nTop = rcCtrlBottom.top + 8
+ case IDM_VERTDECREASE
+ nTop = rcCtrlBottom.top - 8
+ end select
+
+ SetControlProperty( pCtrl, "TOP", str(nTop) )
+ ApplyControlProperties( pDoc, pCtrl )
+ next
+
+ ' Ensure the grab handles are redrawn
+ AfxRedrawWindow(pDoc->hWndForm)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Align controls on the form
+' ========================================================================================
+function OnCommand_DesignerAlign( _
+ byval HWND as HWND, _
+ byval id as long _
+ ) as LRESULT
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc = 0 THEN exit function
+
+ dim pCtrlActive as clsControl ptr = pDoc->Controls.GetActiveControl()
+ dim pCtrl as clsControl ptr
+ dim as RECT rcCtrl, rcActive
+
+ dim as long nWidth, nHeight
+ dim as long nWidthActive, nHeightActive
+
+ if pCtrlActive = 0 THEN exit function
+ rcActive = GetControlRECT(pCtrlActive)
+ nWidthActive = rcActive.Right - rcActive.Left
+ nHeightActive = rcActive.Bottom - rcActive.Top
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->IsSelected THEN
+ if IsControlLocked(pDoc, pCtrl) then continue for
+ ' Skip processing the active control because that is unnecessary.
+ if pCtrl = pCtrlActive THEN continue for
+ rcCtrl = GetControlRECT(pCtrl)
+ nWidth = rcCtrl.Right - rcCtrl.Left
+ nHeight = rcCtrl.Bottom - rcCtrl.Top
+ select CASE id
+ case IDM_ALIGNLEFTS
+ SetControlProperty(pCtrl, "LEFT", str(rcActive.left))
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_ALIGNTOPS
+ SetControlProperty(pCtrl, "TOP", str(rcActive.top))
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_ALIGNRIGHTS
+ SetControlProperty(pCtrl, "LEFT", str(rcCtrl.left + (rcActive.right-rcCtrl.right)) )
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_ALIGNBOTTOMS
+ SetControlProperty(pCtrl, "TOP", str(rcCtrl.top + (rcActive.bottom-rcCtrl.bottom)) )
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_ALIGNCENTERS
+ SetControlProperty(pCtrl, "LEFT", _
+ str(rcActive.Left + (nWidthActive / 2) - ( nWidth / 2 )) )
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_ALIGNMIDDLES
+ SetControlProperty(pCtrl, "TOP", _
+ str(rcActive.Top + (nHeightActive / 2) - ( nHeight / 2 )) )
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_SAMEWIDTHS
+ SetControlProperty(pCtrl, "WIDTH", str(nWidthActive))
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_SAMEHEIGHTS
+ SetControlProperty(pCtrl, "HEIGHT", str(nHeightActive))
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_SAMEBOTH
+ pCtrl->SuspendLayout = true
+ SetControlProperty(pCtrl, "WIDTH", str(nWidthActive))
+ SetControlProperty(pCtrl, "HEIGHT", str(nHeightActive))
+ ApplyControlProperties(pDoc, pCtrl)
+ pCtrl->SuspendLayout = false
+ END SELECT
+ END IF
+ next
+
+ ' Ensure the grab handles are redrawn
+ AfxRedrawWindow(pDoc->hWndForm)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Center controls on the form
+' ========================================================================================
+function OnCommand_DesignerCenter( _
+ byval HWND as HWND, _
+ byval id as long _
+ ) as LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(hWnd)
+ If pWindow = 0 Then Exit Function
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc = 0 THEN exit function
+
+ dim pCtrl as clsControl ptr
+
+ dim as RECT rcCtrl, rcForm
+ dim as long nLeft, nTop, nMaxRight, nMaxBottom
+ dim as long nHorizSpacing, nVertSpacing, nFormWidth, nFormHeight
+ dim as long nMinLeft = 999999999
+ dim as long nMinTop = 999999999
+
+ ' Calculate the total distance from the far left (or top) control to the far
+ ' right (or bottom) control and subtract the widths of each control. This will
+ ' give us the amount of 'white' space. Divide that white space by
+ ' half to determine the amount to put on the left/top and right/bottom of the
+ ' group of controls.
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType = CTRL_FORM THEN continue for
+ if pCtrl->IsSelected = false THEN continue for
+ rcCtrl = GetControlRECT(pCtrl)
+ nMinLeft = Min( nMinLeft, rcCtrl.left )
+ nMaxRight = Max( nMaxRight, rcCtrl.right )
+ nMinTop = Min( nMinTop, rcCtrl.top )
+ nMaxBottom = Max( nMaxBottom, rcCtrl.bottom )
+ next
+
+ ' Get the client area of the design form
+ GetClientRect(pDoc->hWndForm, @rcForm)
+ nFormWidth = (rcForm.right - rcForm.left) / pWindow->rxRatio
+ nFormHeight = (rcForm.bottom - rcForm.top) / pWindow->ryRatio
+
+ ' Determine the value by which the group of controls needs to be shifted by.
+ nHorizSpacing = nMinLeft - ( (nFormWidth - (nMaxRight - nMinLeft)) / 2)
+ nVertSpacing = nMinTop - ( (nFormHeight - (nMaxBottom - nMinTop) ) / 2)
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType = CTRL_FORM THEN continue for
+ if pCtrl->IsSelected = false THEN continue for
+ if IsControlLocked(pDoc, pCtrl) then continue for
+ select CASE id
+ case IDM_CENTERHORIZ
+ nLeft = val(GetControlProperty(pCtrl, "LEFT"))
+ SetControlProperty(pCtrl, "LEFT", str(nLeft-nHorizSpacing))
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_CENTERVERT
+ nTop = val(GetControlProperty(pCtrl, "TOP"))
+ SetControlProperty(pCtrl, "TOP", str(nTop-nVertSpacing))
+ ApplyControlProperties(pDoc, pCtrl)
+ case IDM_CENTERBOTH
+ nLeft = val(GetControlProperty(pCtrl, "LEFT"))
+ nTop = val(GetControlProperty(pCtrl, "TOP"))
+ pCtrl->SuspendLayout = true
+ SetControlProperty(pCtrl, "LEFT", str(nLeft-nHorizSpacing))
+ SetControlProperty(pCtrl, "TOP", str(nTop-nVertSpacing))
+ ApplyControlProperties(pDoc, pCtrl)
+ pCtrl->SuspendLayout = false
+ END SELECT
+ next
+
+ ' Ensure the grab handles are redrawn
+ AfxRedrawWindow(pDoc->hWndForm)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Delete a control (DEL key was pressed while control(s) selected)
+' ========================================================================================
+function OnCommand_DesignerDeleteKey( byval pDoc as clsDocument ptr ) as LRESULT
+
+ dim pCtrl as clsControl ptr
+ ' Need to test if any of the selected controls are locked. If any of them are then
+ ' we need to abort the deleting process.
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->IsSelected THEN
+ ' Test to ensure that the specific control Locked property is not set, or
+ ' the global Locked setting for the entire form is not set.
+ if IsControlLocked(pDoc, pCtrl) then
+ ' Maybe put a messagebox here indicating that can not delete because locked?
+ exit function
+ end if
+ end if
+ next
+
+ ' Delete selected controls
+ do until pDoc->Controls.SelectedControlsCount = 0
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->IsSelected THEN
+ ' If this was a BUTTON control then we need to potentially update the form ACCEPTBUTTON
+ ' or CANCELBUTTON properties that depend on this button name.
+ if pCtrl->ControlType = CTRL_BUTTON then
+ dim as CWSTR wszCtrlName = GetControlProperty(pCtrl, "NAME")
+ dim pCtrlForm as clsControl ptr = GetFormCtrlPtr(pDoc)
+ if pCtrlForm then
+ If GetControlProperty(pCtrlForm, "ACCEPTBUTTON") = wszCtrlName then
+ SetControlProperty(pCtrlForm, "ACCEPTBUTTON", "")
+ end if
+ If GetControlProperty(pCtrlForm, "CANCELBUTTON") = wszCtrlName then
+ SetControlProperty(pCtrlForm, "CANCELBUTTON", "")
+ end if
+ end if
+ end if
+ pDoc->Controls.Remove(pCtrl)
+ pDoc->bRegenerateCode = true
+ pDoc->UserModified = true
+ exit for
+ END IF
+ NEXT
+ loop
+ ' Ensure the grab handles of form and controls are redrawn or hidden
+ pDoc->Controls.SetActiveControl(pDoc->hWndForm)
+ AfxRedrawWindow(pDoc->hWndFrame)
+ AfxRedrawWindow(pDoc->hWndForm)
+ frmMain_SetStatusbar
+ DisplayPropertyList(pDoc)
+
+ function = 0
+end function
+
+
diff --git a/src/frmMainEdit.inc b/src/frmMainEdit.inc
index 57036493..68622a9b 100644
--- a/src/frmMainEdit.inc
+++ b/src/frmMainEdit.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMainEdit.inc.bak b/src/frmMainEdit.inc.bak
new file mode 100644
index 00000000..57036493
--- /dev/null
+++ b/src/frmMainEdit.inc.bak
@@ -0,0 +1,511 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMain.bi"
+#include once "clsDocument.bi"
+
+
+' ========================================================================================
+' Edit action Cut
+' ========================================================================================
+function OnCommand_EditCut( _
+ byval pDoc as clsDocument ptr, _
+ ByVal hEdit as HWND _
+ ) as LRESULT
+
+ ' Check if the Compiler log file or Notes windows or Snippets have
+ ' input focus. If they do then select that text rather than Scintilla.
+ select case GetFocus()
+ case GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES), _
+ GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTLOGFILE), _
+ GetDlgItem(HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTCODE), _
+ GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND), _
+ GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE), _
+ HWND_PROPLIST_EDIT
+ SendMessage( GetFocus, WM_CUT, 0, 0 )
+ case else
+ if IsDesignerView(pDoc) then
+ SendMessage(HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_COPY, 0), 0)
+ SendMessage(HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_DELETE, 0), 0)
+ else
+ SciExec( GetFocus(), Iif(GetFocus()=hEdit, SCI_CUT, WM_CUT), 0, 0)
+ frmMain_PositionWindows() ' ensure custom scrollbars display
+ end if
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Edit action Copy
+' ========================================================================================
+function OnCommand_EditCopy( _
+ byval pDoc as clsDocument ptr, _
+ ByVal hEdit as HWND _
+ ) as LRESULT
+
+ ' Check if the Compiler log file or Notes windows or Snippets have
+ ' input focus. If they do then select that text rather than Scintilla.
+ select case GetFocus()
+ case GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES), _
+ GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTLOGFILE), _
+ GetDlgItem(HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTCODE), _
+ GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND), _
+ GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE), _
+ HWND_PROPLIST_EDIT
+ SendMessage( GetFocus, WM_COPY, 0, 0 )
+ case else
+ if IsDesignerView(pDoc) then
+ dim as long NumControls = pDoc->Controls.SelectedControlsCount
+ if NumControls = 0 THEN exit function
+ redim gCopyControls(NumControls-1) as clsControl
+
+ dim as long NextControl = 0
+ dim pCtrl as clsControl ptr
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->IsSelected THEN
+ gCopyControls(NextControl) = *pCtrl
+ NextControl = NextControl + 1
+ END IF
+ NEXT
+ else
+ SciExec( GetFocus(), Iif(GetFocus()=hEdit, SCI_COPY, WM_COPY), 0, 0)
+ end if
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Edit action Paste
+' ========================================================================================
+function OnCommand_EditPaste( _
+ byval pDoc as clsDocument ptr, _
+ ByVal hEdit as HWND _
+ ) as LRESULT
+
+ ' Check if the Compiler log file or Notes windows or Snippets have
+ ' input focus. If they do then select that text rather than Scintilla.
+ select case GetFocus()
+ case GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES), _
+ GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTLOGFILE), _
+ GetDlgItem(HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTCODE), _
+ GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND), _
+ GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE), _
+ HWND_PROPLIST_EDIT
+ SendMessage( GetFocus, WM_PASTE, 0, 0 )
+ case else
+ if IsDesignerView(pDoc) then
+ dim pCtrl as clsControl ptr
+ dim rc as RECT
+ dim as long nLeft, nTop, nLeftActive = 99999, nTopActive = 99999
+ dim as long nCurLeft, nCurTop
+
+ ' Need to get the Left/Top properties for least top/left in the copy group
+ for i as long = lbound(gCopyControls) to ubound(gCopyControls)
+ nCurLeft = val(GetControlProperty(@gCopyControls(i), "LEFT"))
+ nCurTop = val(GetControlProperty(@gCopyControls(i), "TOP"))
+ if nCurLeft < nLeftActive then nLeftActive = nCurLeft
+ if nCurTop < nTopActive then nTopActive = nCurTop
+ exit for
+ next
+
+ ' Create the control and copy the properties to it
+ for i as long = lbound(gCopyControls) to ubound(gCopyControls)
+ pCtrl = CreateToolboxControl(pDoc, gCopyControls(i).ControlType, rc)
+ gCopyControls(i).hWindow = pCtrl->hWindow
+
+ for ii as long = lbound(gCopyControls(i).Properties) to ubound(gCopyControls(i).Properties)
+ select case ucase(gCopyControls(i).Properties(ii).wszPropName)
+ case "NAME" ' don't copy b/c we will then have duplicate control names
+ continue for
+ case "LEFT": nLeft = val(gCopyControls(i).Properties(ii).wszPropValue)
+ case "TOP": nTop = val(gCopyControls(i).Properties(ii).wszPropValue)
+ case "GROUPNAME"
+ ' Copy the GroupName and then increment the Index property
+ pCtrl->Properties(ii) = gCopyControls(i).Properties(ii)
+ continue for
+ CASE "TABINDEX"
+ continue for
+ END select
+ pCtrl->Properties(ii) = gCopyControls(i).Properties(ii)
+ NEXT
+
+ ' Set the left/top properties relative to the current insert position
+ dim pt as point
+ GetCursorPos(@pt)
+ ' Map the point to the client area coordinates
+ MapWindowPoints(0, pDoc->hWndForm, cast(point ptr, @pt), 1)
+
+ ' Ensure that the point is within the client area
+ dim rc as RECT
+ GetWindowRect(pDoc->hWndForm, @rc)
+ MapWindowPoints(0, pDoc->hWndForm, cast(point ptr, @rc), 2)
+ if PtInRect(@rc, pt) = 0 then
+ pt.x = 10: pt.y = 10
+ end if
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ if pWindow then
+ pt.x = pWindow->UnScaleX(pt.x)
+ pt.y = pWindow->UnScaleY(pt.y)
+ end if
+ SetControlProperty(pCtrl, "LEFT", str(pt.x + (nLeft-nLeftActive)))
+ SetControlProperty(pCtrl, "TOP", str(pt.y + (nTop-nTopActive)))
+
+ pCtrl->SuspendLayout = true
+ ApplyControlProperties( pDoc, pCtrl )
+ pCtrl->SuspendLayout = false
+ NEXT
+
+ ' Select all of the newly created controls
+ for i as long = lbound(gCopyControls) to ubound(gCopyControls)
+ pDoc->Controls.SelectControl( gCopyControls(i).hWindow )
+ next
+
+ pDoc->bRegenerateCode = true
+ pDoc->UserModified = true
+ AfxRedrawWindow(pDoc->hWndFrame)
+ AfxRedrawWindow(pDoc->hWndForm)
+ frmMain_SetStatusbar
+ DisplayPropertyList(pDoc)
+ else
+ SciExec( GetFocus(), Iif(GetFocus()=hEdit, SCI_PASTE, WM_PASTE), 0, 0)
+ frmMain_PositionWindows() ' ensure custom scrollbars display
+ SetFocus( hEdit ) ' ensure that the original edit window has not lost focus
+ end if
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Edit action Indent Block
+' ========================================================================================
+function OnCommand_EditIndentBlock( _
+ byval pDoc as clsDocument ptr, _
+ ByVal hEdit as HWND _
+ ) as LRESULT
+
+ if (pDoc->IsDesigner) andalso (IsDesignerView(pDoc)) then exit function
+
+ ' If a TAB was pressed then manually terminate any active autocomplete.
+ if SciExec(hEdit, SCI_AUTOCACTIVE, 0, 0) then
+ SciExec(hEdit, SCI_AUTOCCOMPLETE, 0, 0)
+ end if
+ if GetFocus = GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND) then
+ if gFind.bExpanded then SetFocus GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE)
+ elseif GetFocus = GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE) then
+ if gFind.bExpanded then SetFocus GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND)
+ elseif AfxGetFormHandle(GetFocus) = HWND_FRMFINDINFILES then
+ Dim As HWnd hCtrl = GetNextDlgTabItem( HWND_FRMFINDINFILES, GetFocus, false )
+ SetFocus(hCtrl)
+ else
+ ' Determine if a Snippet can be inserted. This takes precedence over doing a block indent.
+ if frmSnippets_DoInsertSnippet( pDoc ) = false then
+ ' No snippet to insert, do a block indent instead.
+ gApp.SuppressNotify = true
+ SetWindowRedraw( hEdit, false )
+ Function = SciExec(hEdit, SCI_TAB, 0, 0)
+ SetWindowRedraw( hEdit, true )
+ gApp.SuppressNotify = false
+ AfxRedrawWindow( hEdit )
+ end if
+ frmMain_SetStatusbar
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Edit action UnIndent Block
+' ========================================================================================
+function OnCommand_EditUnIndentBlock( _
+ byval pDoc as clsDocument ptr, _
+ ByVal hEdit as HWND _
+ ) as LRESULT
+
+ if (pDoc->IsDesigner) andalso (IsDesignerView(pDoc)) then exit function
+
+ if GetFocus = GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND) then
+ if gFind.bExpanded then SetFocus GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE)
+ elseif GetFocus = GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE) then
+ if gFind.bExpanded then SetFocus GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND)
+ elseif AfxGetFormHandle(GetFocus) = HWND_FRMFINDINFILES then
+ Dim As HWnd hCtrl = GetNextDlgTabItem( HWND_FRMFINDINFILES, GetFocus, true )
+ SetFocus(hCtrl)
+ else
+ gApp.SuppressNotify = true
+ SetWindowRedraw( hEdit, false )
+ Function = SciExec(hEdit, SCI_BACKTAB, 0, 0)
+ SetWindowRedraw( hEdit, true )
+ gApp.SuppressNotify = false
+ AfxRedrawWindow( hEdit )
+ frmMain_SetStatusbar
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Edit action Select All
+' ========================================================================================
+function OnCommand_EditSelectAll( _
+ byval pDoc as clsDocument ptr, _
+ ByVal hEdit as HWND _
+ ) as LRESULT
+
+ ' Check if the Compiler log file or Notes windows or Snippets have
+ ' input focus. If they do then select that text rather than Scintilla.
+ select case GetFocus()
+ case GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES), _
+ GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTLOGFILE), _
+ GetDlgItem(HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTCODE), _
+ GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND), _
+ GetDlgItem(HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE), _
+ HWND_PROPLIST_EDIT
+ Edit_SetSel( GetFocus, 0, -1 )
+ case else
+ if IsDesignerView(pDoc) THEN
+ pDoc->Controls.SelectAllControls
+ ' Ensure the grab handles of form and controls are redrawn or hidden
+ AfxRedrawWindow(pDoc->hWndFrame)
+ AfxRedrawWindow(pDoc->hWndForm)
+ else
+ SciExec(hEdit, SCI_SELECTALL, 0, 0)
+ END IF
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Edit action File Encoding
+' ========================================================================================
+function OnCommand_EditEncoding( _
+ ByVal id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ select case id
+ case IDM_ANSI
+ if pDoc->FileEncoding <> FILE_ENCODING_ANSI THEN
+ pDoc->UserModified = true
+ ' Convert buffer to ANSI and redisplay the text in the editor
+ ConvertTextBuffer(pDoc, FILE_ENCODING_ANSI)
+ end if
+ pDoc->FileEncoding = FILE_ENCODING_ANSI
+
+ case IDM_UTF8BOM
+ if pDoc->FileEncoding <> FILE_ENCODING_UTF8_BOM THEN
+ pDoc->UserModified = true
+ ConvertTextBuffer(pDoc, FILE_ENCODING_UTF8_BOM)
+ end if
+ pDoc->FileEncoding = FILE_ENCODING_UTF8_BOM
+
+ case IDM_UTF16BOM
+ if pDoc->FileEncoding <> FILE_ENCODING_UTF16_BOM THEN
+ pDoc->UserModified = true
+ ConvertTextBuffer(pDoc, FILE_ENCODING_UTF16_BOM)
+ end if
+ end select
+
+ frmMain_SetStatusbar
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Edit action Find
+' ========================================================================================
+function OnCommand_EditFindDialog() as LRESULT
+ frmFindReplace_Show( HWND_FRMMAIN, false )
+ function = 0
+end function
+
+' ========================================================================================
+' Edit action Replace
+' ========================================================================================
+function OnCommand_EditReplaceDialog() as LRESULT
+ frmFindReplace_Show( HWND_FRMMAIN, true )
+ function = 0
+end function
+
+' ========================================================================================
+' Edit action Find in Files
+' ========================================================================================
+function OnCommand_EditFindInFiles( byval hEdit as HWND ) as LRESULT
+ if hEdit = 0 then hEdit = HWND_FRMMAIN ' possible no files are open
+ frmFindInFiles_Show( hEdit )
+ function = 0
+end function
+
+' ========================================================================================
+' Edit action Find actions
+' ========================================================================================
+function OnCommand_EditFindActions( _
+ ByVal id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ dim as HWND hEdit = pDoc->hWndActiveScintilla
+
+ select case id
+ case IDM_FINDPREV
+ if (GetForeGroundWindow = HWND_FRMFINDREPLACE) then
+ if gFind.foundCount = 0 then exit function
+ dim as long startPos = SendMessage( hEdit, SCI_GETANCHOR, 0, 0)
+ if frmFindReplace_NextSelection(startPos, false, true) then pDoc->CenterCurrentLine
+ AfxRedrawWindow( HWND_FRMFINDREPLACE )
+ end if
+
+ case IDM_FINDNEXT
+ if (GetForeGroundWindow = HWND_FRMFINDREPLACE) then
+ if gFind.foundCount = 0 then exit function
+ dim as long startPos = SendMessage( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ if frmFindReplace_NextSelection(startPos, true, true) then pDoc->CenterCurrentLine
+ AfxRedrawWindow( HWND_FRMFINDREPLACE )
+ end if
+
+ Case IDM_FINDNEXTACCEL, IDM_FINDPREVACCEL ' F3/Shift+F3
+ dim as long startPos, endPos, curPos, mainSel, r
+ Dim As String sFindText = pDoc->GetSelText
+
+ if len(sFindText) = 0 then
+ if len(gFind.txtFind) then
+ sFindText = gFind.txtFind
+ end if
+ end if
+ gFind.txtFind = sFindText
+
+ if len(sFindText) then
+ curPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ if id = IDM_FINDNEXTACCEL then
+ startPos = curPos + 1
+ endPos = SciExec( hEdit, SCI_GETTEXTLENGTH, 0, 0)
+ SciExec( hEdit, SCI_SETTARGETSTART, startPos, 0)
+ SciExec( hEdit, SCI_SETTARGETEND, endPos, 0)
+ ' Search for the text to find
+ r = SciExec( hEdit, SCI_SEARCHINTARGET, Len(sFindText), Strptr(sFindText))
+ If r = -1 Then
+ ' No match found. Do search starting from the beginning of the file.
+ SciExec( hEdit, SCI_SETTARGETSTART, 0, 0)
+ r = SciExec( hEdit, SCI_SEARCHINTARGET, Len(sFindText), Strptr(sFindText))
+ end if
+ If r <> -1 Then
+ SciExec( hEdit, SCI_SETSEL, r, r + len(sFindText))
+ pDoc->CenterCurrentLine
+ end if
+
+ elseif id = IDM_FINDPREVACCEL then
+ startPos = curPos - 1
+ endPos = 0
+ SciExec( hEdit, SCI_SETTARGETSTART, startPos, 0)
+ SciExec( hEdit, SCI_SETTARGETEND, endPos, 0)
+ ' Search for the text to find
+ r = SciExec( hEdit, SCI_SEARCHINTARGET, Len(sFindText), Strptr(sFindText))
+ If r = -1 Then
+ ' No match found. Do search starting from the end of the file.
+ startPos = SciExec( hEdit, SCI_GETTEXTLENGTH, 0, 0)
+ SciExec( hEdit, SCI_SETTARGETSTART, startPos, 0)
+ r = SciExec( hEdit, SCI_SEARCHINTARGET, Len(sFindText), Strptr(sFindText))
+ end if
+ If r <> -1 Then
+ SciExec( hEdit, SCI_SETSEL, r, r + len(sFindText))
+ pDoc->CenterCurrentLine
+ end if
+ end if
+ end if
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Edit action Replace actions
+' ========================================================================================
+function OnCommand_EditReplaceActions( _
+ ByVal id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ dim as HWND hEdit = pDoc->hWndActiveScintilla
+
+ select case id
+ Case IDM_REPLACENEXT, IDM_REPLACEPREV, IDM_REPLACEALL
+ if (GetForeGroundWindow = HWND_FRMFINDREPLACE) then
+ if gFind.foundCount = 0 then exit function
+ if id = IDM_REPLACEPREV then
+ frmFindReplace_DoReplace( false, false )
+ elseif id = IDM_REPLACENEXT then
+ frmFindReplace_DoReplace( false, true )
+ elseif id = IDM_REPLACEALL then
+ frmFindReplace_DoReplace( true, true )
+ end if
+ frmFindReplace_HighlightSearches( true )
+ pDoc->CenterCurrentLine
+ AfxRedrawWindow( HWND_FRMFINDREPLACE )
+ end if
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Edit action Common actions
+' ========================================================================================
+function OnCommand_EditCommon( _
+ ByVal id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ dim as HWND hEdit = pDoc->hWndActiveScintilla
+
+ select case id
+ Case IDM_REDO: SciExec( hEdit, SCI_REDO, 0, 0)
+ Case IDM_UNDO, WM_UNDO: SciExec( hEdit, SCI_UNDO, 0, 0)
+ Case WM_UNDO: SciExec( GetFocus(), WM_UNDO, 0, 0)
+ Case IDM_DELETELINE: SciExec(hEdit, SCI_LINECUT, 0, 0)
+ Case IDM_INSERTFILE: pDoc->InsertFile()
+ Case IDM_COMMENTBLOCK: pDoc->BlockComment(True)
+ Case IDM_UNCOMMENTBLOCK: pDoc->BlockComment(False)
+ Case IDM_DUPLICATELINE: pDoc->LineDuplicate()
+ Case IDM_MOVELINEUP: pDoc->MoveCurrentLines(False)
+ Case IDM_MOVELINEDOWN: pDoc->MoveCurrentLines(True)
+ Case IDM_NEWLINEBELOWCURRENT: pDoc->NewLineBelowCurrent()
+ Case IDM_TOUPPERCASE: pDoc->ChangeSelectionCase(1)
+ Case IDM_TOLOWERCASE: pDoc->ChangeSelectionCase(2)
+ Case IDM_TOMIXEDCASE: pDoc->ChangeSelectionCase(3)
+ Case IDM_EOLTOCRLF: pDoc->ConvertEOL(SC_EOL_CRLF)
+ Case IDM_EOLTOCR: pDoc->ConvertEOL(SC_EOL_CR)
+ Case IDM_EOLTOLF: pDoc->ConvertEOL(SC_EOL_LF)
+ Case IDM_TABSTOSPACES: pDoc->TabsToSpaces()
+ Case IDM_SELECTLINE: pDoc->SelectLine(-1)
+ end select
+
+ function = 0
+end function
+
+
+
diff --git a/src/frmMainFile.inc b/src/frmMainFile.inc
index a9a4bdf0..7e45796b 100644
--- a/src/frmMainFile.inc
+++ b/src/frmMainFile.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMainFile.inc.bak b/src/frmMainFile.inc.bak
new file mode 100644
index 00000000..a9a4bdf0
--- /dev/null
+++ b/src/frmMainFile.inc.bak
@@ -0,0 +1,557 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMain.bi"
+#include once "clsDocument.bi"
+
+' ========================================================================================
+' Create a new editing window
+' ========================================================================================
+Function OnCommand_FileNew( ByVal HWnd As HWnd ) As clsDocument ptr
+ function = frmMain_OpenFileSafely(HWnd, _
+ True, _ ' bIsNewFile
+ False, _ ' bIsTemplate
+ True, _ ' bShowInTab
+ false, _ ' bIsInclude
+ "", _ ' wszName
+ 0 ) ' pDocIn
+End Function
+
+
+' ========================================================================================
+' Open one or more files for editing
+' ========================================================================================
+Function OnCommand_FileOpen( _
+ ByVal HWnd As HWnd, _
+ byval bShowInTab as Boolean = true _
+ ) As LRESULT
+
+ dim pDoc as clsDocument ptr
+ dim pDocIn as clsDocument ptr
+
+ ' Display the Open File Dialog
+ Dim pItems As IShellItemArray Ptr = AfxIFileOpenDialogMultiple(HWnd, IDM_FILEOPEN)
+ If pItems = Null Then Exit Function
+ Dim dwItemCount As Long, i As Long, pItem As IShellItem Ptr, pwszName As WString Ptr
+ pItems->lpVtbl->GetCount(pItems, @dwItemCount)
+
+ ' Variable length array to hold sequence of TabCtrl tabs to open. We save the sequence
+ ' here and open them only after all over documents have been loaded. This will look
+ ' visually more appealing for those files that will display in the top Tab Control.
+ Dim pDocTabs(dwItemCount - 1) As clsDocument Ptr
+
+ SetCursor( LoadCursor(0, IDC_WAIT) )
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc THEN SciExec( pDoc->hWindow(0), SCI_SETCURSOR, SC_CURSORWAIT, 0 )
+
+ ' Prevent the constant updating of the app caption bar with filename
+ gApp.IsFileLoading = true
+ gApp.FileLoadingCount = 0
+
+ For i = 0 To dwItemCount - 1
+ pItems->lpVtbl->GetItemAt(pItems, i, @pItem)
+ If pItem Then
+ pItem->lpVtbl->GetDisplayName(pItem, SIGDN_FILESYSPATH, @pwszName)
+ If pwszName Then
+ ' Save the folder where this file was opened from into the gApp.wszLastOpenFolder
+ ' variable so that subsequent uses of the File Open dialog will default to
+ ' this folder.
+ gApp.wszLastOpenFolder = AfxStrPathName( "PATH", *pwszName )
+
+ ' Test to see if the file is already loaded in the editor. If it is, then
+ ' bypass loading it again thereby creating multiple ghost instances.
+ pDoc = gApp.GetDocumentPtrByFilename(*pwszName)
+ if pDoc then
+ if pDoc->GetActiveScintillaPtr = 0 then pDocIn = pDoc
+ end if
+ if (pDoc = 0) orelse (pDocIn <> 0) then
+ pDoc = frmMain_OpenFileSafely(HWnd, _
+ false, _ ' bIsNewFile
+ false, _ ' bIsTemplate
+ false, _ ' bShowInTab
+ false, _ ' bIsInclude
+ *pwszName, _ ' pwszName
+ pDocIn, _ ' pDocIn
+ IsFormFilename(*pwszName) _
+ )
+ end if
+
+ ' Give this document a default project type depending on its file extension
+ if (pDoc->IsNewFlag = false) andalso (pDoc->ProjectFileType = FILETYPE_UNDEFINED) then
+ if ( gApp.IsProjectActive = true ) orelse ( gApp.IsProjectLoading = true ) then
+ if pDoc->IsDesigner then
+ pDoc->ProjectFileType = FILETYPE_NORMAL
+ else
+ gApp.ProjectSetFileType( pDoc, pDoc->ProjectFileType )
+ end if
+ end if
+ end if
+
+ if bShowInTab then pDocTabs(i) = pDoc
+ CoTaskMemFree(pwszName)
+ pwszName = Null
+ End If
+ pItem->lpVtbl->Release(pItem)
+ pItem = Null
+ End If
+ Next
+ pItems->lpVtbl->Release(pItems)
+
+ LoadExplorerFiles()
+ LoadFunctionsFiles()
+
+ ' Display all of the tabs
+ dim as long iTab = -1
+ For i = LBound(pDocTabs) To UBound(pDocTabs)
+ if pDocTabs(i) = 0 then continue for
+ iTab = gTTabCtl.GetTabIndexByDocumentPtr(pDocTabs(i))
+ if iTab = -1 then iTab = gTTabCtl.AddTab(pDocTabs(i)) ' Add the new document to the top tabcontrol
+ Next
+ if iTab > -1 then gTTabCtl.SetFocusTab(iTab)
+
+ gApp.IsFileLoading = false
+
+ gApp.wszPanelText = "" ' reset filename text that displays in StatusBar panel
+ frmMain_SetStatusbar
+
+ ' Update the MRU list. Do this after the tabs are loaded because IsProjectLoading
+ ' will prevent the list from updating.
+ if gApp.IsProjectActive = false then
+ For i = LBound(pDocTabs) To UBound(pDocTabs)
+ if pDocTabs(i) then UpdateMRUList(pDocTabs(i)->DiskFilename)
+ Next
+ end if
+
+ SetCursor( LoadCursor(0, IDC_ARROW) )
+ ResetScintillaCursors
+ frmMain_PositionWindows
+ frmMain_SetFocusToCurrentCodeWindow
+
+ Function = 0
+
+End Function
+
+
+' ========================================================================================
+' Save the incoming pDoc file to disk
+' ========================================================================================
+function OnCommand_FileTemplates( ByVal HWnd As HWnd ) as LRESULT
+ frmTemplates_Show( Hwnd )
+ function = 0
+end function
+
+
+' ========================================================================================
+' Save the incoming pDoc file to disk
+' ========================================================================================
+function OnCommand_FileSave( _
+ ByVal HWnd As HWnd, _
+ byval pDoc as clsDocument ptr, _
+ ByVal bSaveAs As boolean, _
+ ByVal bSaveAll As boolean _
+ ) As LRESULT
+
+ if gApp.GetDocumentCount = 0 then exit function
+
+ Dim as long i, iStart, iEnd
+
+ if bSaveAll then
+ ' Save All
+ iStart = 0
+ iEnd = gTTabCtl.GetItemCount - 1
+ else
+ ' Save
+ iStart = gTTabCtl.GetTabIndexByDocumentPtr(pDoc)
+ iEnd = iStart
+ end if
+
+ For i = iStart to iEnd
+ ' Get the document pointer and then save file to disk
+ if gTTabCtl.IsSafeIndex(i) then
+ pDoc = gTTabCtl.tabs(i).pDoc
+ if pDoc = 0 then continue for
+ end if
+
+ ' Do the actual saving to disk
+ dim wszFilename as CWSTR = pDoc->DiskFilename
+ If pDoc->SaveFile(bSaveAs) Then
+ pDoc->ApplyProperties
+ pDoc->ParseDocument()
+ ' Apply document properties to this file because the file extension may have
+ ' changed. For example from Untitled to *.bas
+ if pDoc->DiskFilename <> wszFilename then
+ If gApp.IsProjectActive Then
+ gApp.ProjectSetFileType( pDoc, pDoc->ProjectFileType )
+ end if
+ end if
+ end if
+
+ ' Ensure that the Tab displays the correct filename in case it was changed
+ gTTabCtl.SetTabText(-1)
+ next
+
+ LoadExplorerFiles()
+ LoadFunctionsFiles()
+
+ frmMain_SetFocusToCurrentCodeWindow
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Save all open files to disk
+' ========================================================================================
+Function OnCommand_FileSaveAll( ByVal HWnd As HWnd ) As LRESULT
+
+ If gTTabCtl.GetItemCount = 0 Then Exit Function
+
+ function = OnCommand_FileSave( HWnd, 0, false, true )
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Close current (or all) open file(s)
+' ========================================================================================
+Function OnCommand_FileClose( _
+ ByVal HWnd As HWnd, _
+ ByVal veFileClose As eFileClose, _
+ byval nTabNum as long = -1 _
+ ) As LRESULT
+
+ Dim wText As WString * MAX_PATH
+ Dim pDoc As clsDocument Ptr
+ Dim As Long r
+
+ ' If a Project is not active then we need to save the current non-project notes
+ ' when this file is closed. It is possible that this file is being closed and
+ ' a project is being opened.
+ if gApp.IsProjectActive = false then
+ gApp.NonProjectNotes = AfxGetWindowText(GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES))
+ end if
+
+ ' Build a list of files to check
+ dim as long nCurSel
+ ' If the incoming nTabNum is -1 then we want to close the current
+ ' active document, otherwise close the specified tab.
+ if nTabNum = -1 then
+ nCurSel = gTTabCtl.CurSel
+ else
+ nCurSel = nTabNum
+ end if
+
+ dim as long nCount = gTTabCtl.GetItemCount
+
+ if nCount = 0 then return true
+
+ redim bCloseIndex(nCount - 1) as boolean
+
+ for i as long = 0 to nCount - 1
+ SELECT CASE veFileClose
+ case EFC_CLOSEALL: bCloseIndex(i) = true
+ case EFC_CLOSECURRENT: bCloseIndex(i) = iif(i = nCurSel, true, false)
+ case EFC_CLOSEALLOTHERS: bCloseIndex(i) = iif(i <> nCurSel, true, false)
+ case EFC_CLOSEALLFORWARD: bCloseIndex(i) = iif(i > nCurSel, true, false)
+ case EFC_CLOSEALLBACKWARD: bCloseIndex(i) = iif(i < nCurSel, true, false)
+ end select
+ next
+
+ ' Save the pDoc of the current active document in case we need to us it after
+ ' the deletes are done to restore the correct tab index.
+ dim as clsDocument ptr pDocActive = gTTabCtl.tabs(gTTabCtl.CurSel).pDoc
+
+ ' Must do everything in reverse order because when Tabs are removed
+ ' then the indexes would be out of sync if done in ascending order.
+ for i as long = nCount - 1 to 0 step -1
+ if bCloseIndex(i) = false then continue for
+
+ pDoc = gTTabCtl.GetDocumentPtr(i)
+ If pDoc = 0 Then Return true
+
+ If cbool(SciExec( pDoc->hWindow(0), SCI_GETMODIFY, 0, 0 )) or pDoc->UserModified Then
+ gTTabCtl.SetFocusTab(i)
+ r = MessageBox( HWnd, L(76,"Save current changes?") & WStr(" ") & wText, @WStr(APPNAME), _
+ MB_YESNOCANCEL Or MB_ICONQUESTION)
+ If r = IDCANCEL Then Exit Function
+ If r = IDYES Then
+ r = pDoc->SaveFile()
+ If r = False Then Exit Function ' save was cancelled
+ elseif r = IDNO then
+ ' Delete any existing AutoSave file because at this point the user doesn't
+ ' care about any unsaved changes.
+ if AfxFileExists(pDoc->AutoSaveFilename) THEN AfxDeleteFile(pDoc->AutoSaveFilename)
+ End If
+ End If
+
+ ' Hide the Scintilla editing windows
+ for ii as long = lbound(pDoc->hWindow) to ubound(pDoc->hWindow)
+ ShowWindow( pDoc->hWindow(ii), SW_HIDE)
+ NEXT
+ SetRectEmpty( @pDoc->rcSplitButton )
+ ' Hide visual designer window
+ if pDoc->IsDesigner THEN
+ ShowWindow(pDoc->hWndDesigner, SW_HIDE)
+ ShowWindow(HWND_FRMVDTOOLBOX, SW_HIDE)
+ END IF
+
+ ' remove tab from gTTabCtl.tabs() array
+ gTTabCtl.RemoveElement(i)
+
+ ' Only remove this document from the global collection if it is not
+ ' part of any active Project or if it is new/unsaved file. Files that are part of a project are
+ ' all closed (tabs/nodes) automatically in one shot rather than individually.
+ dim as Boolean bRemoveFile
+ if pDoc->IsNewFlag = true then
+ bRemoveFile = true
+ else
+ bRemoveFile = iif( gApp.IsProjectActive, false, true )
+ end if
+
+ if bRemoveFile then
+ ' Remove all references from the gdb2 database. Only remove the reference
+ ' if the file is not part of an active project, otherwise, we will lose
+ ' references to function names, etc.
+ gdb2.dbDelete( pDoc->DiskFilename )
+ gApp.RemoveDocument( pDoc )
+ LoadExplorerFiles()
+ end if
+ next
+
+ ' Set the active tab to the closest tab to the one just removed if it was the
+ ' current active tab that was removed.
+ if (veFileClose = EFC_CLOSECURRENT) andalso (nCurSel = gTTabCtl.CurSel) then
+ dim as long idx = gTTabCtl.CurSel - 1
+ gTTabCtl.CurSel = -1 ' it is no longer valid
+ if idx < lbound(gTTabCtl.tabs) then idx = lbound(gTTabCtl.tabs)
+ if gTTabCtl.IsSafeIndex( idx ) then
+ gTTabCtl.CurSel = gTTabCtl.SetFocusTab( idx )
+ end if
+ else
+ ' we need to set our gTTabCtl.CurSel to the correct array index because
+ ' the array has been resized and the cursel would no longer be valid.
+ gTTabCtl.CurSel = -1 ' it is no longer valid
+ if pDoc then gTTabCtl.CurSel = gTTabCtl.SetTabIndexByDocumentPtr(pDocActive)
+ end if
+
+ frmMain_PositionWindows
+ frmExplorer_PositionWindows
+ frmTopTabs_PositionWindows
+
+ ' important to repaint the workspace to remove any separator bar and splitter
+ ' rectangle should all documents be closed. Removes screen artifacts.
+ AfxRedrawWindow( HWND_FRMMAIN )
+
+ Function = true
+End Function
+
+
+' ========================================================================================
+' Message received from Explorer popup menu
+' ========================================================================================
+function OnCommand_FileExplorerMessage( _
+ byval id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ if id = IDM_FILEOPEN_EXPLORERLISTBOX then
+ OpenSelectedDocument( pDoc->DiskFilename, "" )
+
+ elseif id = IDM_FILESAVE_EXPLORERLISTBOX then
+ OnCommand_FileSave( HWND_FRMMAIN, pDoc, False )
+
+ elseif id = IDM_FILESAVEAS_EXPLORERLISTBOX then
+ OnCommand_FileSave( HWND_FRMMAIN, pDoc, true )
+
+ elseif IDM_FILECLOSE_EXPLORERLISTBOX then
+ dim as long nCurSel = gTTabCtl.GetTabIndexByDocumentPtr( pDoc )
+ if nCurSel <> -1 then
+ OnCommand_FileClose( HWND_FRMMAIN, EFC_CLOSECURRENT, nCurSel )
+ end if
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Generate an AutoSave filename based on the incoming full path DiskFilename
+' ========================================================================================
+function OnCommand_FileAutoSaveGenerateFilename( byval wszInFilename as CWSTR ) as CWSTR
+ dim as CWSTR wszFilePath = AfxStrPathname( "PATH", wszInFilename )
+ dim as CWSTR wszFilename = AfxStrPathname( "NAMEX", wszInFilename )
+ if len(wszFilename) = 0 then return ""
+ dim as CWSTR wszAutoSaveFilename = wszFilePath & "#" & wszFilename & "#"
+ return wszAutoSaveFilename
+end function
+
+
+' ========================================================================================
+' Check the incoming filename to determine if a newer AutoSave file already exists. If
+' yes, then ask the user if he wants to use the AutoSave file. If yes, then copy then
+' delete the original file and rename the AutoSave file to the original returning the
+' original filename.
+' ========================================================================================
+function OnCommand_FileAutoSaveFileCheck( byval wszInFilename as CWSTR ) as CWSTR
+ dim as FILETIME ftOriginal
+ dim as FILETIME ftAutoSave
+ dim as CWSTR wszAutoSaveFilename = OnCommand_FileAutoSaveGenerateFilename(wszInFilename)
+ dim as long nResult
+
+ ftOriginal = AfxGetFileLastWriteTime( wszInFilename )
+ ftAutoSave = AfxGetFileLastWriteTime( wszAutoSaveFilename )
+
+ if AfxFileTimeToVariantTime(ftAutoSave) > AfxFileTimeToVariantTime(ftOriginal) then
+ nResult = MessageBox( HWND_FRMMAIN, _
+ L(428,"An automatically saved version the following file is more recent:") & vbcrlf & _
+ chr(34) & wszInFilename & chr(34) & vbcrlf & vbcrlf & _
+ L(429,"Would you like to load the auto save version instead?"), _
+ L(427, "Auto Save"), MB_ICONQUESTION or MB_YESNO)
+
+ if nResult = IDYES then
+ ' User wants to re-use the previously saved AutoSave file. Delete the
+ ' incoming filename and rename the AutoSave to the original name.
+ AfxDeleteFile( wszInFilename )
+ AfxRenameFile( wszAutoSaveFilename, wszInFilename )
+ elseif nResult = IDNO then
+ ' User does not want to use the existing AutoSave file so simply delete it.
+ AfxDeleteFile( wszAutoSaveFilename )
+ end if
+
+ end if
+
+ ' No matter if the original or autosave file is selected by the
+ ' user, the filename being returned will inevitably be the same
+ ' as the incoming filename.
+ function = wszInFilename
+end function
+
+
+' ========================================================================================
+' Enable/Disable File auto save features
+' ========================================================================================
+Function OnCommand_FileAutoSaveTimerProc( _
+ ByVal hWndTimer as HWnd, _
+ ByVal uMsg as Long, _
+ ByVal idEvent as Long, _
+ ByVal dwTime as Long _
+ ) as Long
+
+ ' Iterate all of the documents and determine which ones need to have
+ ' the special #filename# temporary file created.
+ if gConfig.AutoSaveFiles = false then exit function
+
+ dim pDoc as clsDocument ptr
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ if pDoc->AutoSaveRequired then
+ if len(pDoc->AutoSaveFilename) then
+ pDoc->SaveFile( false, true )
+ pDoc->AutoSaveRequired = false
+ end if
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+
+ Function = 0
+End function
+
+' ========================================================================================
+' Kill AutoSave timer that checks for file changes between saves. This function
+' is called whenever the AutoSave menu item is clicked or when WinFBE closes.
+' ========================================================================================
+function OnCommand_FileAutoSaveKillTimer() as LRESULT
+ KillTimer( HWND_FRMMAIN, gConfig.idAutoSaveTimer )
+ function = 0
+end function
+
+' ========================================================================================
+' Start AutoSave timer that checks for file changes between saves. This function
+' is called whenever the AutoSave menu item is clicked or when the application
+' starts and gConfig.AutoSaveFiles = true
+' ========================================================================================
+function OnCommand_FileAutoSaveStartTimer() as LRESULT
+ if gConfig.AutoSaveFiles = false then exit function
+ OnCommand_FileAutoSaveKillTimer()
+ SetTimer( HWND_FRMMAIN, gConfig.idAutoSaveTimer, _
+ gConfig.AutoSaveInterval * 1000, _
+ Cast(TimerProc, @OnCommand_FileAutoSaveTimerProc) )
+ function = 0
+end function
+
+' ========================================================================================
+' Enable/Disable File auto save features
+' ========================================================================================
+function OnCommand_FileAutoSave( byval HWnd As HWnd ) as LRESULT
+ ' Toggle the AutoSave state (when the menuitem is clicked)
+ gConfig.AutoSaveFiles = not gConfig.AutoSaveFiles
+ gConfig.SaveConfigFile
+
+ ' if AutoSave is enabled then start timer that checks for AutoSave conditions
+ if gConfig.AutoSaveFiles then
+ ' any files that were dirty prior to Autosave being enabled should
+ ' now get processed by the new timer when it fires.
+ OnCommand_FileAutoSaveStartTimer()
+
+ elseif gConfig.AutoSaveFiles = false then
+ ' If AutoSave is disabled then delete any existing #filename# temporary files
+ OnCommand_FileAutoSaveKillTimer()
+ ' Delete any temporary ## files
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ AfxDeleteFile( pDoc->AutoSaveFilename )
+ pDoc = pDoc->pDocNext
+ loop
+
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Load a previously saved session
+' ========================================================================================
+function OnCommand_FileLoadSession( byval HWnd As HWnd ) as LRESULT
+ ' Display the Open File Dialog
+ Dim pwszName As WString Ptr = AfxIFileOpenDialogW(HWnd, IDM_LOADSESSION)
+ If pwszName Then
+ if gApp.IsProjectActive then
+ if OnCommand_ProjectClose(hwnd) = false then exit function
+ else
+ if OnCommand_FileClose(HWnd, EFC_CLOSEALL) = false then exit function
+ end if
+ ' Clear any previous info from the Output windows
+ frmOutput_ResetAllControls()
+ gConfig.LoadSessionFile(*pwszName)
+ CoTaskMemFree(pwszName)
+ End If
+ function = 0
+end function
+
+
+' ========================================================================================
+' Save a session
+' ========================================================================================
+function OnCommand_FileSaveSession( byval HWnd As HWnd ) as LRESULT
+ Dim wszFilename As WString * MAX_PATH = ""
+ Dim wszExtension As WString * MAX_PATH = "session"
+ Dim pwszName As WString Ptr = AfxIFileSaveDialog(HWND_FRMMAIN, @wszFilename, @wszExtension, IDM_SAVESESSION)
+ If pwszName Then
+ gConfig.SaveSessionFile(*pwszName)
+ CoTaskMemFree(pwszName)
+ End If
+ function = 0
+end function
+
\ No newline at end of file
diff --git a/src/frmMainOnCommand.bi b/src/frmMainOnCommand.bi
index 8ba8de24..653f59b2 100644
--- a/src/frmMainOnCommand.bi
+++ b/src/frmMainOnCommand.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMainOnCommand.bi.bak b/src/frmMainOnCommand.bi.bak
new file mode 100644
index 00000000..8ba8de24
--- /dev/null
+++ b/src/frmMainOnCommand.bi.bak
@@ -0,0 +1,100 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+enum eFileClose
+ EFC_CLOSECURRENT
+ EFC_CLOSEALL
+ EFC_CLOSEALLFORWARD
+ EFC_CLOSEALLOTHERS
+ EFC_CLOSEALLBACKWARD
+end enum
+
+Declare Function OnCommand_FileNew( ByVal HWnd As HWnd ) As clsDocument ptr
+Declare Function OnCommand_FileOpen( ByVal HWnd As HWnd, byval bShowInTab as Boolean = true ) As LRESULT
+declare function OnCommand_FileTemplates( ByVal HWnd As HWnd ) as LRESULT
+Declare Function OnCommand_FileSave( ByVal HWnd As HWnd, byval pDoc as clsDocument ptr, ByVal bSaveAs As BOOLEAN = False, ByVal bSaveAll As BOOLEAN = False ) As LRESULT
+Declare Function OnCommand_FileSaveDeclares( ByVal HWnd As HWnd ) As LRESULT
+Declare Function OnCommand_FileSaveAll( ByVal HWnd As HWnd ) As LRESULT
+Declare Function OnCommand_FileClose( ByVal HWnd As HWnd, ByVal veFileClose As eFileClose, byval nTabNum as long = -1 ) As LRESULT
+declare function OnCommand_FileExplorerMessage( byval id as long, byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_FileAutoSave( byval HWnd As HWnd ) as LRESULT
+declare function OnCommand_FileAutoSaveStartTimer() as LRESULT
+declare function OnCommand_FileAutoSaveKillTimer() as LRESULT
+declare function OnCommand_FileAutoSaveGenerateFilename( byval wszFilename as CWSTR ) as CWSTR
+declare function OnCommand_FileAutoSaveFileCheck( byval wszFilename as CWSTR ) as CWSTR
+declare function OnCommand_FileLoadSession( byval HWnd As HWnd ) as LRESULT
+declare function OnCommand_FileSaveSession( byval HWnd As HWnd ) as LRESULT
+
+declare function OnCommand_EditRedo( ByVal hEdit as HWND ) as LRESULT
+declare function OnCommand_EditUndo( ByVal hEdit as HWND ) as LRESULT
+declare function OnCommand_EditCut( byval pDoc as clsDocument ptr, ByVal hEdit as HWND ) as LRESULT
+declare function OnCommand_EditCopy( byval pDoc as clsDocument ptr, ByVal hEdit as HWND ) as LRESULT
+declare function OnCommand_EditPaste( byval pDoc as clsDocument ptr, ByVal hEdit as HWND ) as LRESULT
+declare function OnCommand_EditFindDialog() as LRESULT
+declare function OnCommand_EditReplaceDialog() as LRESULT
+declare function OnCommand_EditFindInFiles( byval hEdit as HWND ) as LRESULT
+declare function OnCommand_EditFindActions( ByVal id as long, byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_EditReplaceActions( ByVal id as long, byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_EditIndentBlock( byval pDoc as clsDocument ptr, ByVal hEdit as HWND ) as LRESULT
+declare function OnCommand_EditUnIndentBlock( byval pDoc as clsDocument ptr, ByVal hEdit as HWND ) as LRESULT
+declare function OnCommand_EditSelectAll( byval pDoc as clsDocument ptr, ByVal hEdit as HWND ) as LRESULT
+declare function OnCommand_EditEncoding( ByVal id as long, byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_EditCommon( ByVal id as long, byval pDoc as clsDocument ptr ) as LRESULT
+
+declare function OnCommand_SearchGotoDefinition( byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_SearchGotoLastPosition() as LRESULT
+declare function OnCommand_SearchGotoCompileError( byval bMoveNext as boolean ) as long
+declare function OnCommand_SearchGotoFile( ByVal id as long, byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_SearchBookmarks( ByVal id as long, byval pDoc as clsDocument ptr ) as LRESULT
+
+declare function OnCommand_ViewFunctionList() as LRESULT
+declare function OnCommand_ViewBookmarksList() as LRESULT
+declare function OnCommand_ViewExplorer() as LRESULT
+declare function OnCommand_ViewOutput() as LRESULT
+declare function OnCommand_ViewFold( ByVal id as long, byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_ViewZoom( ByVal id as long, byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_ViewToDo() as LRESULT
+declare function OnCommand_ViewNotes() as LRESULT
+declare function OnCommand_ViewRestoreMain() as LRESULT
+
+Declare Function OnCommand_ProjectSave( ByVal HWnd As HWnd, ByVal bSaveAs As BOOLEAN = False ) As LRESULT
+Declare Function OnCommand_ProjectClose( ByVal HWnd As HWnd ) As LRESULT
+Declare Function OnCommand_ProjectNew( ByVal HWnd As HWnd ) As LRESULT
+Declare Function OnCommand_ProjectOpen( ByVal HWnd As HWnd ) As LRESULT
+declare function OnCommand_ProjectFilesAdd( byval HWnd As HWnd ) as LRESULT
+declare function OnCommand_ProjectSetFileType( byval id as long, byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_ProjectRemove( byval id as long, byval pDoc as clsDocument ptr ) as LRESULT
+
+declare function OnCommand_CompileCommon( byval id as long ) as LRESULT
+
+Declare Function OnCommand_DesignerNewForm( ByVal HWnd As HWnd ) As LRESULT
+Declare Function OnCommand_DesignerAlign( byval HWND as HWND, byval id as long ) as LRESULT
+Declare Function OnCommand_DesignerCenter( byval HWND as HWND, byval id as long ) as LRESULT
+declare function OnCommand_DesignerHorizSpacing( byval HWND as HWND, byval id as long ) as LRESULT
+declare function OnCommand_DesignerVertSpacing( byval HWND as HWND, byval id as long ) as LRESULT
+declare function OnCommand_DesignerDeleteKey( byval pDoc as clsDocument ptr ) as LRESULT
+declare function OnCommand_DesignerToolBox( byval HWnd as HWND ) as LRESULT
+declare function OnCommand_DesignerMenuEditor( ByVal HWnd As HWnd, byval pDoc as clsDocument ptr ) As LRESULT
+declare function OnCommand_DesignerToolBarEditor( ByVal HWnd As HWnd, byval pDoc as clsDocument ptr ) As LRESULT
+declare function OnCommand_DesignerStatusBarEditor( ByVal HWnd As HWnd, byval pDoc as clsDocument ptr, ByVal codeNotify As UINT ) As LRESULT
+declare function OnCommand_DesignerImageManager( ByVal HWnd As HWnd, byval pDoc as clsDocument ptr ) As LRESULT
+declare function OnCommand_DesignerSnapLines( byval pDoc as clsDocument ptr ) As LRESULT
+declare function OnCommand_DesignerLockControls( byval pDoc as clsDocument ptr ) As LRESULT
+
+declare Function frmMain_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
diff --git a/src/frmMainOnCommand.inc b/src/frmMainOnCommand.inc
index e22f7407..471b8eb6 100644
--- a/src/frmMainOnCommand.inc
+++ b/src/frmMainOnCommand.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMainOnCommand.inc.bak b/src/frmMainOnCommand.inc.bak
new file mode 100644
index 00000000..e22f7407
--- /dev/null
+++ b/src/frmMainOnCommand.inc.bak
@@ -0,0 +1,300 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMainOnCommand.bi"
+
+#include once "frmOutput.bi"
+#include once "clsApp.bi"
+#include once "clsDocument.bi"
+#include once "frmMain.bi"
+#include once "frmFunctions.bi"
+
+
+' Global array to hold cut/copy/paste controls
+dim shared gCopyControls(any) as clsControl
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmMain
+' ========================================================================================
+Function frmMain_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+ Dim As HWnd hEdit
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ select case codeNotify
+ case SCEN_SETFOCUS
+ pDoc->hWndActiveScintilla = hwndCtl
+
+ ' Remove any markers set in the document that highlights
+ ' entire lines (used for Selected text searching).
+ pDoc->RemoveMarkerHighlight
+
+ end select
+ hEdit = pDoc->hWndActiveScintilla
+ End If
+
+ ' If the popup Help Viewer window has focus then exit function because we don't
+ ' want accelerator keys to act on the code editor.
+ if IsWindow( HWND_FRMHELPVIEWER ) then
+ if GetForegroundWindow() = HWND_FRMHELPVIEWER then
+ if id = IDM_FIND then
+ frmHelpViewer_OnCommand(HWND_FRMHELPVIEWER, IDC_FRMHELPVIEWER_FIND, 0, BN_CLICKED)
+ end if
+ exit function
+ end if
+ end if
+
+ ' Kill any currently displayed topmenu whenever a popup dialog is about to be activated
+ Select Case id
+ case IDM_FILEOPEN, IDM_FILEOPENTEMPLATES, IDM_FILESAVEAS, _
+ IDM_SAVESESSION, IDM_LOADSESSION, IDM_CATEGORIES, _
+ IDM_KEYBOARDSHORTCUTS, IDM_USERTOOLSDIALOG, IDM_OPTIONSDIALOG, IDM_BUILDCONFIG, _
+ IDM_USERSNIPPETS, IDM_FIND, IDM_FINDINFILES, IDM_PROJECTOPEN, IDM_PROJECTSAVEAS, _
+ IDM_PROJECTOPTIONS, IDM_COMMANDLINE, IDM_ABOUT
+ killAllPopupMenus()
+ end select
+
+ Select Case id
+ ' show any topmenu that were activated via keyboard Alt+ sequences
+ case IDC_MENUBAR_FILE to IDC_MENUBAR_HELP
+ killAllPopupMenus()
+ dim as HWND hCtrl = GetDlgItem(HWND_FRMMAIN_MENUBAR, id)
+ ghWndActiveMenuBarButton = hCtrl
+ SendMessage( hCtrl, WM_LBUTTONDOWN, 0, 0)
+ setNextMenuItemTabIndex(false)
+
+ case IDM_PROJECTFILETYPE
+ dim as HMENU hPopupMenu = CreateStatusBarFileTypeContextMenu()
+ dim as POINT pt: GetCursorPos @pt
+ TrackPopupMenu(hPopUpMenu, 0, pt.x, pt.y, 0, HWnd, ByVal Null)
+ DestroyMenu hPopUpMenu
+
+ case IDM_FILEENCODING
+ dim as HMENU hPopupMenu = CreateStatusBarFileEncodingContextMenu()
+ dim as POINT pt: GetCursorPos @pt
+ TrackPopupMenu(hPopUpMenu, TPM_RIGHTALIGN, pt.x, pt.y, 0, HWnd, ByVal Null)
+ DestroyMenu hPopUpMenu
+
+ case IDM_LINEENDINGS
+ dim as HMENU hPopupMenu = CreateStatusBarLineEndingsContextMenu()
+ dim as POINT pt: GetCursorPos @pt
+ TrackPopupMenu(hPopUpMenu, TPM_RIGHTALIGN, pt.x, pt.y, 0, HWnd, ByVal Null)
+ DestroyMenu hPopUpMenu
+
+ case IDM_SPACES
+ dim as HMENU hPopupMenu = CreateStatusBarSpacesContextMenu()
+ dim as POINT pt: GetCursorPos @pt
+ dim as long idMenu = TrackPopupMenu(hPopUpMenu, TPM_RETURNCMD, pt.x, pt.y, 0, HWnd, ByVal Null)
+ DestroyMenu hPopUpMenu
+ if (idMenu >= IDM_SPACES) andalso (idMenu <= IDM_SPACES + 8) then
+ gConfig.TabSize = idMenu - IDM_SPACES
+ gSBPanels(4).wszText = "Spaces: " & gConfig.TabSize
+ frmStatusBar_PositionWindows
+ Dim pDoc As clsDocument Ptr = gApp.pDocList
+ do until pDoc = 0
+ pDoc->ApplyProperties
+ pDoc = pDoc->pDocNext
+ loop
+ end if
+
+ case IDM_CLOSEPANEL
+ ShowWindow( HWND_FRMPANEL, SW_HIDE )
+ frmMain_PositionWindows()
+
+ case IDM_OPENINCLUDE: OpenSelectedDocument( gApp.IncludeFilename )
+ case IDM_SETFOCUSEDITOR: frmMain_SetFocusToCurrentCodeWindow()
+ case IDM_EXPLORER_EXPANDALL: frmExplorer_ExpandAll()
+ case IDM_EXPLORER_COLLAPSEALL: frmExplorer_CollapseAll()
+ case IDM_FUNCTIONS_EXPANDALL: frmFunctions_ExpandAll()
+ case IDM_FUNCTIONS_COLLAPSEALL: frmFunctions_CollapseAll()
+ case IDM_BOOKMARKS_EXPANDALL: frmBookmarks_ExpandAll()
+ case IDM_BOOKMARKS_COLLAPSEALL: frmBookmarks_CollapseAll()
+ case IDM_FUNCTIONS_VIEWASTREE: frmFunctions_ViewAsTree()
+ case IDM_FUNCTIONS_VIEWASLIST: frmFunctions_ViewAsList()
+
+
+ '' FILE MENU
+ Case IDM_FILENEW: OnCommand_FileNew( HWnd )
+ Case IDM_FILEOPEN: OnCommand_FileOpen( HWnd, true )
+ Case IDM_FILEOPENTEMPLATES: OnCommand_FileTemplates( HWnd )
+ Case IDM_FILESAVE: OnCommand_FileSave( HWnd, pDoc, false, false )
+ Case IDM_FILESAVEAS: OnCommand_FileSave( HWnd, pDoc, true, false )
+ Case IDM_FILECLOSE: OnCommand_FileClose( HWnd, EFC_CLOSECURRENT )
+ Case IDM_FILESAVEALL: OnCommand_FileSaveAll( HWnd )
+ case IDM_AUTOSAVE: OnCommand_FileAutoSave( HWnd )
+ case IDM_LOADSESSION: OnCommand_FileLoadSession( HWnd )
+ case IDM_SAVESESSION: OnCommand_FileSaveSession( HWnd )
+ Case IDM_FILECLOSEALL: OnCommand_FileClose( HWnd, EFC_CLOSEALL )
+ Case IDM_FILECLOSEALLOTHERS: OnCommand_FileClose( HWnd, EFC_CLOSEALLOTHERS )
+ Case IDM_CLOSEALLFORWARD: OnCommand_FileClose( HWnd, EFC_CLOSEALLFORWARD )
+ Case IDM_CLOSEALLBACKWARD: OnCommand_FileClose( HWnd, EFC_CLOSEALLBACKWARD )
+ Case IDM_KEYBOARDSHORTCUTS: frmKeyboard_Show( HWnd )
+ Case IDM_OPTIONSDIALOG: frmOptions_Show( HWnd )
+ case IDM_BUILDCONFIG: frmBuildConfig_Show( HWND )
+ case IDM_USERTOOLSDIALOG: frmUserTools_Show( HWND )
+ case IDM_USERSNIPPETS: frmSnippets_Show( HWND )
+ case IDM_CATEGORIES: frmCategories_Show( HWND )
+ Case IDM_MRUCLEAR: ClearMRUlist( id )
+
+ Case IDM_MRUBASE To (IDM_MRUBASE + 10)
+ OpenMRUFile( HWnd, id )
+
+ Case IDM_USERTOOLSBASE To (IDM_USERTOOLSBASE + UBound(gConfig.Tools))
+ frmUserTools_ExecuteUserTool( id - IDM_USERTOOLSBASE )
+
+ Case IDM_EXIT
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+
+
+ '' EDIT MENU
+ Case IDM_CUT, WM_CUT: OnCommand_EditCut( pDoc, hEdit )
+ Case IDM_COPY, WM_COPY: OnCommand_EditCopy( pDoc, hEdit )
+ Case IDM_PASTE, WM_PASTE: OnCommand_EditPaste( pDoc, hEdit )
+ Case IDM_SELECTALL: OnCommand_EditSelectAll( pDoc, hEdit )
+ Case IDM_FIND: OnCommand_EditFindDialog()
+ case IDM_REPLACE: OnCommand_EditReplaceDialog()
+ Case IDM_FINDINFILES: OnCommand_EditFindInFiles( hEdit )
+ case IDM_INDENTBLOCK: OnCommand_EditIndentBlock( pDoc, hEdit )
+ case IDM_UNINDENTBLOCK: OnCommand_EditUnIndentBlock( pDoc, hEdit )
+
+ Case IDM_FINDNEXT, IDM_FINDPREV, _
+ IDM_FINDNEXTACCEL, IDM_FINDPREVACCEL ' F3/Shift+F3
+ OnCommand_EditFindActions( id, pDoc )
+
+ Case IDM_REPLACENEXT, IDM_REPLACEPREV, IDM_REPLACEALL
+ OnCommand_EditReplaceActions( id, pDoc )
+
+ case IDM_ANSI, IDM_UTF8BOM, IDM_UTF16BOM
+ OnCommand_EditEncoding( id, pDoc )
+
+ Case IDM_DELETELINE, IDM_INSERTFILE, IDM_COMMENTBLOCK, _
+ IDM_UNCOMMENTBLOCK, IDM_DUPLICATELINE, IDM_MOVELINEUP, _
+ IDM_MOVELINEDOWN, IDM_TOUPPERCASE, IDM_NEWLINEBELOWCURRENT, _
+ IDM_TOLOWERCASE, IDM_TOMIXEDCASE, IDM_EOLTOCRLF, _
+ IDM_EOLTOCR, IDM_EOLTOLF, IDM_TABSTOSPACES, _
+ IDM_SELECTLINE, IDM_REDO, IDM_UNDO, _
+ WM_UNDO
+ OnCommand_EditCommon( id, pDoc )
+
+
+ '' SEARCH MENU
+ Case IDM_DEFINITION: OnCommand_SearchGotoDefinition( pDoc )
+ Case IDM_LASTPOSITION: OnCommand_SearchGotoLastPosition()
+ case IDM_GOTONEXTCOMPILEERROR: OnCommand_SearchGotoCompileError( true )
+ case IDM_GOTOPREVCOMPILEERROR: OnCommand_SearchGotoCompileError( false )
+
+ case IDM_GOTOHEADERFILE, IDM_GOTOSOURCEFILE, IDM_GOTOMAINFILE, _
+ IDM_GOTORESOURCEFILE, IDM_GOTO, IDM_GOTONEXTFUNCTION, _
+ IDM_GOTOPREVFUNCTION, IDM_GOTONEXTTAB, IDM_GOTOPREVTAB, _
+ IDM_CLOSETAB
+ OnCommand_SearchGotoFile( id, pDoc )
+
+ Case IDM_BOOKMARKTOGGLE, IDM_BOOKMARKNEXT, IDM_BOOKMARKPREV, _
+ IDM_BOOKMARKCLEARALL, IDM_BOOKMARKCLEARALLDOCS
+ OnCommand_SearchBookmarks( id, pDoc )
+
+
+ '' VIEW MENU
+ Case IDM_VIEWEXPLORER: OnCommand_ViewExplorer():
+ Case IDM_VIEWOUTPUT: OnCommand_ViewOutput():
+ Case IDM_FUNCTIONLIST: OnCommand_ViewFunctionList():
+ Case IDM_BOOKMARKSLIST: OnCommand_ViewBookmarksList():
+ case IDM_VIEWTODO: OnCommand_ViewToDo():
+ case IDM_VIEWNOTES: OnCommand_ViewNotes():
+ Case IDM_RESTOREMAIN: OnCommand_ViewRestoreMain():
+
+ Case IDM_FOLDTOGGLE, IDM_FOLDBELOW, IDM_FOLDALL, IDM_UNFOLDALL
+ OnCommand_ViewFold( id, pDoc )
+
+ Case IDM_ZOOMIN, IDM_ZOOMOUT
+ OnCommand_ViewZoom( id, pDoc )
+
+
+ '' PROJECT MENU
+ Case IDM_PROJECTNEW: OnCommand_ProjectNew( HWnd )
+ Case IDM_PROJECTSAVE: OnCommand_ProjectSave( HWnd, False )
+ Case IDM_PROJECTSAVEAS: OnCommand_ProjectSave( HWnd, True )
+ Case IDM_PROJECTOPEN: OnCommand_ProjectOpen( HWnd )
+ Case IDM_PROJECTFILESADD: OnCommand_ProjectFilesAdd( HWnd )
+ Case IDM_PROJECTCLOSE: OnCommand_ProjectClose( HWnd )
+ Case IDM_PROJECTOPTIONS: frmProjectOptions_Show( HWnd, false )
+ Case IDM_MRUPROJECTCLEAR: ClearMRUlist( id )
+ Case IDM_REMOVEFILEFROMPROJECT: OnCommand_ProjectRemove( id, pDoc )
+
+ Case IDM_SETFILENORMAL, IDM_SETFILEMODULE, IDM_SETFILEMAIN, _
+ IDM_SETFILERESOURCE, IDM_SETFILEHEADER
+ OnCommand_ProjectSetFileType( id, pDoc )
+
+ Case IDM_MRUPROJECTBASE To (IDM_MRUPROJECTBASE + 10)
+ OpenMRUProjectFile( HWnd, id )
+
+
+ '' COMPILE MENU
+ Case IDM_BUILDEXECUTE, IDM_COMPILE, IDM_REBUILDALL, IDM_QUICKRUN, _
+ IDM_RUNEXE, IDM_COMMANDLINE
+ OnCommand_CompileCommon( id )
+
+
+ '' DESIGNER MENU
+ case IDM_NEWFORM: OnCommand_DesignerNewForm( HWnd )
+ case IDM_DELETE: OnCommand_DesignerDeleteKey( pDoc )
+ case IDM_VIEWTOOLBOX: OnCommand_DesignerToolBox( HWnd )
+ case IDM_MENUEDITOR: OnCommand_DesignerMenuEditor( HWnd, pDoc )
+ case IDM_TOOLBAREDITOR: OnCommand_DesignerToolBarEditor( HWnd, pDoc )
+ case IDM_STATUSBAREDITOR: OnCommand_DesignerStatusBarEditor( HWnd, pDoc, codeNotify )
+ case IDM_IMAGEMANAGER: OnCommand_DesignerImageManager( HWnd, pDoc )
+ case IDM_SNAPLINES: OnCommand_DesignerSnapLines( pDoc )
+ case IDM_LOCKCONTROLS: OnCommand_DesignerLockControls( pDoc )
+
+ case IDM_ALIGNLEFTS, IDM_ALIGNCENTERS, IDM_ALIGNRIGHTS, _
+ IDM_ALIGNTOPS, IDM_ALIGNMIDDLES, IDM_ALIGNBOTTOMS, _
+ IDM_SAMEWIDTHS, IDM_SAMEHEIGHTS, IDM_SAMEBOTH
+ OnCommand_DesignerAlign( HWND, id )
+
+ case IDM_CENTERHORIZ, IDM_CENTERVERT, IDM_CENTERBOTH
+ OnCommand_DesignerCenter( HWND, id )
+
+ case IDM_HORIZEQUAL, IDM_HORIZINCREASE, IDM_HORIZDECREASE, IDM_HORIZREMOVE
+ OnCommand_DesignerHorizSpacing( hwnd, id )
+
+ case IDM_VERTEQUAL, IDM_VERTINCREASE, IDM_VERTDECREASE, IDM_VERTREMOVE
+ OnCommand_DesignerVertSpacing( hwnd, id )
+
+
+ '' HELP MENU
+ Case IDM_HELP, IDM_HELPSHORTCUTS, IDM_HELPWINFBE, IDM_HELPWINFBX
+ ShowContextHelp(id)
+
+ case IDM_CHECKFORUPDATES
+ DisableAllModeless()
+ DoCheckForUpdates( hwnd, false )
+ EnableAllModeless()
+
+ Case IDM_ABOUT
+ DisableAllModeless()
+ frmAbout_Show( hwnd )
+ EnableAllModeless()
+ frmMain_SetFocusToCurrentCodeWindow()
+
+ End Select
+
+ Function = 0
+End Function
+
+
diff --git a/src/frmMainProject.inc b/src/frmMainProject.inc
index 614fefd5..1cb0de6a 100644
--- a/src/frmMainProject.inc
+++ b/src/frmMainProject.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMainProject.inc.bak b/src/frmMainProject.inc.bak
new file mode 100644
index 00000000..614fefd5
--- /dev/null
+++ b/src/frmMainProject.inc.bak
@@ -0,0 +1,488 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMain.bi"
+#include once "clsDocument.bi"
+
+' ========================================================================================
+' Add one or more files to the project (but don't open them to Tabs)
+' ========================================================================================
+Function OnCommand_ProjectFilesAdd( byval HWnd As HWnd ) as LRESULT
+ OnCommand_FileOpen( HWnd, false )
+ LoadExplorerFiles()
+ function = 0
+end function
+
+
+' ========================================================================================
+' Save project file to disk
+' ========================================================================================
+Function OnCommand_ProjectSave( _
+ byval HWnd As HWnd, _
+ ByVal bSaveAs As BOOLEAN = False _
+ ) As LRESULT
+
+ ' Save all dirty files
+ OnCommand_FileSaveAll( HWnd )
+
+ ' Do the actual saving to disk of the Project file
+ gApp.SaveProject(bSaveAs)
+
+ frmMain_SetFocusToCurrentCodeWindow
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Close currently active project
+' ========================================================================================
+Function OnCommand_ProjectClose( ByVal HWnd As HWnd ) As LRESULT
+
+ ' Save the project configuration to disk and any dirty files
+ ' Do the actual saving to disk of the Project file
+ gApp.SaveProject(false)
+ if OnCommand_FileClose( HWnd, EFC_CLOSEALL ) = false then exit function
+
+ ' If the entire app is closing down then we do not have to process the
+ ' remaining project cleanup commands.
+ if gApp.IsShutdown then return true
+
+ ' If we get this far then we can safely remove all of the open pDocs
+ gApp.RemoveAllDocuments
+
+ ' If the Find/Replace window is open then close it.
+ DestroyWindow(HWND_FRMFINDREPLACE)
+ DestroyWindow(HWND_FRMVDTOOLBOX)
+
+ ' Reset the Project variables
+ gApp.IsProjectActive = false
+ gApp.ProjectName = ""
+ gApp.ProjectFilename = ""
+ gApp.ProjectBuild = ""
+ gApp.ProjectOther32 = ""
+ gApp.ProjectOther64 = ""
+ gApp.ProjectManifest = false
+ gApp.ProjectNotes = ""
+ gApp.ProjectCommandLine = ""
+ gApp.wszLastOpenFolder = ""
+ gApp.ProjectDefaultFont = "Segoe UI,9,400,0,0,0,1"
+
+ gApp.wszPanelText = ""
+ gApp.hIconPanel = 0
+
+ ' Clear any previous info from the Output windows
+ frmOutput_ResetAllControls
+
+ ' Reset the ProjectNotes text box with the generic non-project related notes
+ AfxSetWindowText(GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES), gApp.NonProjectNotes)
+
+ ' If the compiler Output window is open then ensure that it is now hidden
+ ShowWindow( HWND_FRMOUTPUT, SW_HIDE )
+
+ frmExplorer_PositionWindows
+ frmMain_PositionWindows
+ LoadExplorerFiles()
+
+ frmMain_SetStatusbar
+ frmMain_SetFocusToCurrentCodeWindow
+
+ Function = true
+End Function
+
+
+' ========================================================================================
+' Create a new project
+' ========================================================================================
+Function OnCommand_ProjectNew( ByVal HWnd As HWnd ) As LRESULT
+
+
+ ' Ensure that the Project Manager window has been created (show it now as well)
+ frmProjectOptions_Show( HWnd, true )
+
+ if gApp.IsNewProjectFlag then
+ ' Need to remove resource file (if created) from the document list otherwise it
+ ' will be loaded again and it will display twice in the Explorer.
+ gApp.RemoveAllDocuments()
+
+ ' Open the new project so it displays in the Explorer treeview. Pass the
+ ' variable wText because passing gApp.ProjectFilename will cause that variable
+ ' to get reset because the parameter is byref and eventually that variable
+ ' gets assigned a null.
+ dim as CWSTR wszText = gApp.ProjectFilename
+ frmMain_OpenProjectSafely(HWND_FRMMAIN, wszText)
+
+
+ dim pDoc as clsDocument ptr
+ dim pCtrl as clsControl ptr
+ dim as string szText
+ dim as string DQ = chr(34)
+
+
+ select case gApp.NewProjectTemplateType
+
+ case IDC_FRMPROJECTOPTIONS_OPTNONE
+ ' Do nothing
+
+ case IDC_FRMPROJECTOPTIONS_OPTBLANK
+ ' Add a new blank file to the project and set it as the Main by default
+ pDoc = OnCommand_FileNew(HWND_FRMMAIN)
+ if pDoc then
+ pDoc->ProjectFileType = FILETYPE_NORMAL
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_SETFILEMAIN, 0), 0)
+ end if
+
+
+ case IDC_FRMPROJECTOPTIONS_OPTVD
+ pDoc = OnCommand_FileNew(HWND_FRMMAIN)
+ if pDoc then
+ szText = _
+ "' " & string(88, asc("=")) & vbcrlf & _
+ "' WinFBE - FreeBASIC Editor (Windows 32/64 bit)" & vbcrlf & _
+ "' Visual Designer auto generated project" & vbcrlf & _
+ "' " & string(88, asc("=")) & vbcrlf & _
+ vbcrlf & _
+ "' Main application entry point." & vbcrlf & _
+ "' Place any additional global variables or #include files here." & vbcrlf & _
+ vbcrlf & _
+ "' For your convenience, below are some of the most commonly used WinFBX library" & vbcrlf & _
+ "' include files. Uncomment the files that you wish to use in the project or add" & vbcrlf & _
+ "' additional ones. Refer to the WinFBX Framework Help documentation for information" & vbcrlf & _
+ "' on how to use the various functions." & vbcrlf & _
+ vbcrlf & _
+ "' #Include Once " & DQ & "Afx\AfxFile.inc" & DQ & vbcrlf & _
+ "' #Include Once " & DQ & "Afx\AfxStr.inc" & DQ & vbcrlf & _
+ "' #Include Once " & DQ & "Afx\AfxTime.inc" & DQ & vbcrlf & _
+ "' #Include Once " & DQ & "Afx\CIniFile.inc" & DQ & vbcrlf & _
+ "' #Include Once " & DQ & "Afx\CMoney.inc" & DQ & vbcrlf & _
+ "' #Include Once " & DQ & "Afx\CPrint.inc" & DQ & vbcrlf & _
+ vbcrlf & _
+ vbcrlf & _
+ "Application.Run(frmMain)" & vbcrlf
+
+ pDoc->SetText( szText )
+ dim as any ptr pSci = pDoc->GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_GOTOLINE, 12, 0)
+
+ ' Make this the Main file
+ pDoc->ProjectFileType = FILETYPE_NORMAL
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_SETFILEMAIN, 0), 0)
+
+ ' Save the main file using the Project name and path
+ pDoc->IsNewFlag = false
+ pDoc->Diskfilename = AfxStrPathname( "PATH", gApp.ProjectFilename ) & _
+ AfxStrPathname( "NAME", gApp.ProjectFilename ) & _
+ ".bas"
+ pDoc->SaveFile
+
+ end if
+
+ ' Give a breather for the tab control and explorer node to update
+ AfxDoEvents()
+
+ ' Create the frmMain
+ OnCommand_DesignerNewForm(HWND_FRMMAIN)
+
+ pDoc = gTTabCtl.GetActiveDocumentPtr
+ if pDoc then
+ ' Set the Name property of the new form to frmMain
+ pCtrl = GetFormCtrlPtr(pDoc)
+ if pCtrl then SetControlProperty( pCtrl, "NAME", "frmMain" )
+
+ ' Force the new Form to move to the Normal tree branch
+ pDoc->ProjectFileType = ""
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_SETFILENORMAL, 0), 0)
+
+ pDoc->FileEncoding = FILE_ENCODING_ANSI
+
+ szText = "' frmMain form code file" & vbcrlf
+ pDoc->SetText( szText )
+
+ ' Save the form file using the Project name and path
+ pDoc->IsNewFlag = false
+ pDoc->Diskfilename = AfxStrPathname( "PATH", gApp.ProjectFilename ) & _
+ "frmMain.inc"
+ pDoc->SaveFile
+ end if
+
+
+ ' Change the Build Configuration to match the first "GUI" (non-debug) type of entry.
+ for i as long = lbound(gConfig.Builds) to ubound(gConfig.Builds)
+ if instr( " " & ucase(gConfig.Builds(i).wszOptions), " -S GUI") then
+ gApp.ProjectBuild = gConfig.Builds(i).id
+ exit for
+ end if
+ next
+
+
+ case IDC_FRMPROJECTOPTIONS_OPTCONSOLE
+ pDoc = OnCommand_FileNew(HWND_FRMMAIN)
+ if pDoc then
+ szText = _
+ "'#CONSOLE ON" & vbcrlf & _
+ "#Define UNICODE" & vbcrlf & _
+ "#Include Once " & DQ & "windows.bi" & DQ & vbcrlf & _
+ vbcrlf & _
+ vbcrlf & _
+ "Print" & vbcrlf & _
+ "Print " & DQ & "Press any key..." & DQ & vbcrlf & _
+ "Sleep" & vbcrlf
+
+ pDoc->SetText( szText )
+ dim as any ptr pSci = pDoc->GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_GOTOLINE, 4, 0)
+
+ ' Make this the Main file
+ pDoc->ProjectFileType = FILETYPE_NORMAL
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_SETFILEMAIN, 0), 0)
+
+ ' Save the main file using the Project name and path
+ pDoc->IsNewFlag = false
+ pDoc->Diskfilename = AfxStrPathname( "PATH", gApp.ProjectFilename ) & _
+ AfxStrPathname( "NAME", gApp.ProjectFilename ) & _
+ ".bas"
+ pDoc->SaveFile
+ end if
+ ' Change the Build Configuration to match the first "Console" (non-debug) type of entry.
+ for i as long = lbound(gConfig.Builds) to ubound(gConfig.Builds)
+ if instr( " " & ucase(gConfig.Builds(i).wszOptions), " -S CONSOLE") then
+ gApp.ProjectBuild = gConfig.Builds(i).id
+ exit for
+ end if
+ NEXT
+
+
+ case IDC_FRMPROJECTOPTIONS_OPTDLL
+ ' Change the Build Configuration to match the first "DLL" type of entry.
+ pDoc = OnCommand_FileNew(HWND_FRMMAIN)
+ if pDoc then
+ szText = _
+ vbcrlf & _
+ "Extern " & DQ & "windows" & DQ & vbcrlf & _
+ vbcrlf & _
+ "'' Windows DLL template code" & vbcrlf & _
+ vbcrlf & _
+ "'' Add two numbers together and return the result" & vbcrlf & _
+ "Public Function Add2 alias " & DQ & "Add2" & DQ & "( ByVal x As Integer, ByVal y As Integer ) As Integer Export" & vbcrlf & _
+ " Return( x + y )" & vbcrlf & _
+ "End Function" & vbcrlf & _
+ vbcrlf & _
+ "End Extern" & vbcrlf
+
+ pDoc->SetText( szText )
+ dim as any ptr pSci = pDoc->GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_GOTOLINE, 9, 0)
+
+ ' Make this the Main file
+ pDoc->ProjectFileType = FILETYPE_NORMAL
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_SETFILEMAIN, 0), 0)
+
+ ' Save the main file using the Project name and path
+ pDoc->IsNewFlag = false
+ pDoc->Diskfilename = AfxStrPathname( "PATH", gApp.ProjectFilename ) & _
+ AfxStrPathname( "NAME", gApp.ProjectFilename ) & _
+ ".bas"
+ pDoc->SaveFile
+
+ end if
+
+ ' Change the Build Configuration to match the first "DLL" type of entry.
+ for i as long = lbound(gConfig.Builds) to ubound(gConfig.Builds)
+ if instr( " " & ucase(gConfig.Builds(i).wszOptions), " -DLL") then
+ gApp.ProjectBuild = gConfig.Builds(i).id
+ exit for
+ end if
+ NEXT
+
+
+ case IDC_FRMPROJECTOPTIONS_OPTSTATIC
+ pDoc = OnCommand_FileNew(HWND_FRMMAIN)
+ if pDoc then
+ szText = _
+ vbcrlf & _
+ "Extern " & DQ & "windows" & DQ & vbcrlf & _
+ vbcrlf & _
+ "'' Static Library template code" & vbcrlf & _
+ vbcrlf & _
+ "'' Add two numbers together and return the result" & vbcrlf & _
+ "Public Function Add2( ByVal x As Integer, ByVal y As Integer ) As Integer" & vbcrlf & _
+ " Return( x + y )" & vbcrlf & _
+ "End Function" & vbcrlf & _
+ vbcrlf & _
+ "End Extern" & vbcrlf
+
+ pDoc->SetText( szText )
+ dim as any ptr pSci = pDoc->GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_GOTOLINE, 6, 0)
+
+ ' Make this the Main file
+ pDoc->ProjectFileType = FILETYPE_NORMAL
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_SETFILEMAIN, 0), 0)
+
+ ' Save the main file using the Project name and path
+ pDoc->IsNewFlag = false
+ pDoc->Diskfilename = AfxStrPathname( "PATH", gApp.ProjectFilename ) & _
+ AfxStrPathname( "NAME", gApp.ProjectFilename ) & _
+ ".bas"
+ pDoc->SaveFile
+ end if
+
+ ' Change the Build Configuration to match the first "LIB" type of entry.
+ for i as long = lbound(gConfig.Builds) to ubound(gConfig.Builds)
+ if instr( " " & ucase(gConfig.Builds(i).wszOptions), " -LIB") then
+ gApp.ProjectBuild = gConfig.Builds(i).id
+ exit for
+ end if
+ next
+
+ end select
+
+
+ select case gApp.NewProjectTemplateType
+ case IDC_FRMPROJECTOPTIONS_OPTDLL, IDC_FRMPROJECTOPTIONS_OPTSTATIC
+ ' Give a breather for the tab control and explorer node to update
+ AfxDoEvents()
+ pDoc = OnCommand_FileNew(HWND_FRMMAIN)
+ if pDoc then
+ szText = _
+ "#inclib " & DQ & AfxStrPathname( "NAME", gApp.ProjectFilename ) & DQ & vbcrlf & _
+ "Declare Function Add2( ByVal x As Integer, ByVal y As Integer ) As Integer" & vbcrlf
+
+ pDoc->SetText( szText )
+ dim as any ptr pSci = pDoc->GetActiveScintillaPtr()
+ SciMsg( pSci, SCI_GOTOLINE, 3, 0)
+
+ ' Make this the Main file
+ pDoc->ProjectFileType = FILETYPE_NORMAL
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_SETFILEHEADER, 0), 0)
+
+ ' Save the main file using the Project name and path
+ pDoc->IsNewFlag = false
+ pDoc->Diskfilename = AfxStrPathname( "PATH", gApp.ProjectFilename ) & _
+ AfxStrPathname( "NAME", gApp.ProjectFilename ) & _
+ ".bi"
+ pDoc->SaveFile
+ end if
+ end select
+
+ end if
+
+ gApp.IsNewProjectFlag = false
+ gApp.IsProjectLoading = FALSE
+
+ frmExplorer_PositionWindows
+ frmMain_PositionWindows
+
+ ' Refresh the Project Explorer file name list
+ LoadExplorerFiles()
+ LoadFunctionsFiles()
+
+ ' This will update the main window to show the project name in the window caption
+ frmMain_SetFocusToCurrentCodeWindow
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Open a Project
+' ========================================================================================
+Function OnCommand_ProjectOpen( ByVal HWnd As HWnd ) As LRESULT
+
+ ' Display the Open File Dialog
+ Dim pwszName As WString Ptr = AfxIFileOpenDialogW(HWnd, IDM_PROJECTOPEN)
+ If pwszName Then
+ ' Pass the info to our generic project open function to handle everything.
+ frmMain_OpenProjectSafely(HWND_FRMMAIN, *pwszName)
+ CoTaskMemFree(pwszName)
+ End If
+ frmMain_SetFocusToCurrentCodeWindow
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Set the file type based on file extension
+' ========================================================================================
+function OnCommand_ProjectSetFileType( _
+ byval id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ ' This code also handles right click messages from the Explorer Treeview.
+ dim as CWSTR wszFileType
+
+ select case id
+ case IDM_SETFILENORMAL, IDM_SETFILENORMAL_EXPLORERTREEVIEW
+ wszFileType = FILETYPE_NORMAL
+ case IDM_SETFILEMODULE, IDM_SETFILEMODULE_EXPLORERTREEVIEW
+ wszFileType = FILETYPE_MODULE
+ case IDM_SETFILEMAIN, IDM_SETFILEMAIN_EXPLORERTREEVIEW
+ wszFileType = FILETYPE_MAIN
+ case IDM_SETFILERESOURCE, IDM_SETFILERESOURCE_EXPLORERTREEVIEW
+ wszFileType = FILETYPE_RESOURCE
+ case IDM_SETFILEHEADER, IDM_SETFILEHEADER_EXPLORERTREEVIEW
+ wszFileType = FILETYPE_HEADER
+ case is > IDM_SETCATEGORY
+ wszFileType = gConfig.Cat(id-IDM_SETCATEGORY).idFileType
+ end select
+
+ if pDoc = 0 then exit function
+
+ if pDoc->ProjectFileType <> wszFileType then
+ ' If attempting to set MAIN or RESOURCE then we need to move any existing
+ ' pDoc that have that filetype over to the NORMAL branch.
+ if (wszFileType = FILETYPE_MAIN) or (wszFileType = FILETYPE_RESOURCE) then
+ dim pDoc2 as clsDocument ptr = iif(wszFileType = FILETYPE_MAIN, gApp.GetMainDocumentPtr, gApp.GetResourceDocumentPtr)
+ if pDoc2 then
+ pDoc2->ProjectFileType = FILETYPE_NORMAL
+ end if
+ end if
+ ' Set the new FileType for the currently selected document
+ gApp.ProjectSetFileType( pDoc, wszFileType )
+ LoadExplorerFiles()
+ ' Highlight the selected tab file in the Explorer listbox
+ frmExplorer_SelectItemData( pDoc )
+ frmMain_SetStatusbar
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Remove file from the project
+' ========================================================================================
+function OnCommand_ProjectRemove( _
+ byval id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ if pDoc = 0 then exit function
+ if gTTabCtl.SetTabIndexByDocumentPtr( pDoc ) <> -1 then
+ if OnCommand_FileClose( HWND_FRMMAIN, EFC_CLOSECURRENT ) = false then exit function
+ end if
+
+ ' File close succeeded. Remove this document from the project collection
+ gdb2.dbDelete( pDoc->DiskFilename )
+ gApp.RemoveDocument( pDoc )
+
+ LoadExplorerFiles()
+
+ if gTTabCtl.IsSafeIndex(gTTabCtl.CurSel) then
+ frmExplorer_SelectItemData( gTTabCtl.tabs(gTTabCtl.CurSel).pDoc )
+ end if
+
+ function = 0
+end function
diff --git a/src/frmMainSearch.inc b/src/frmMainSearch.inc
index 8728619a..97efc67e 100644
--- a/src/frmMainSearch.inc
+++ b/src/frmMainSearch.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMainSearch.inc.bak b/src/frmMainSearch.inc.bak
new file mode 100644
index 00000000..8728619a
--- /dev/null
+++ b/src/frmMainSearch.inc.bak
@@ -0,0 +1,259 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMain.bi"
+#include once "clsDocument.bi"
+
+' ========================================================================================
+' Move next/prev amongst the various compiler errors
+' ========================================================================================
+function OnCommand_SearchGotoCompileError( byval bMoveNext as boolean ) as long
+ ' Determine the current selection in the listview and move prev/next as needed
+ dim as HWND hLV = GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVRESULTS )
+ Dim As Long nCurSel = ListView_GetSelection(hLV)
+ If nCurSel < 0 Then Return 0
+
+ ' Determine how many lines in the listview so we can "wrap" around
+ dim as long nCount = ListView_GetItemCount(hLV)
+
+ if bMoveNext then
+ nCurSel = nCurSel + 1
+ else
+ nCurSel = nCurSel - 1
+ end if
+ if nCurSel > nCount - 1 then nCurSel = 0
+ if nCurSel < 0 then nCurSel = nCount - 1
+
+ ListView_SelectItem( hLV, nCurSel )
+ SetDocumentErrorPosition( hLV, gCompile.CompileID )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Save the current editor position so we can return to it should the user invoke
+' the Last Position (Shift+F6) option.
+' ========================================================================================
+function OnCommand_SearchSaveLastPosition( byval pDoc as clsDocument ptr ) as long
+ if pDoc = 0 then exit function
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ gLastPosition.pDoc = pDoc
+ gLastPosition.nFirstLine = SciExec( hEdit, SCI_GETFIRSTVISIBLELINE, 0, 0)
+ gLastPosition.nPosition = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ function = 0
+end function
+
+' ========================================================================================
+' Position editor to document/function/variable under the current caret position
+' ========================================================================================
+function OnCommand_SearchGotoDefinition( byval pDoc as clsDocument ptr ) as LRESULT
+
+ If pDoc = 0 Then Exit Function
+
+ dim pData as DB2_DATA ptr
+ dim as CWSTR wszFilename
+ dim as string sTypeName, sFunctionName, sLookFor, sTrigger
+ dim as long nLineNum = 0
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+
+ ' Version 1.8.8 added ability to open an underlying #Include file if such
+ ' a file exists on the current editing line.
+ if IsCurrentLineIncludeFilename() then
+ wszFilename = gApp.IncludeFilename
+ else
+
+ ' Determine the word at the current caret position if nothing is selected.
+ sFunctionName = trim(pDoc->GetSelText)
+ if len(sFunctionName) = 0 then sFunctionName = trim(pDoc->GetWord)
+
+ if len(sFunctionName) then
+ ' Determine if the function name is part of a class. This would be identified
+ ' by a preceeding "." or "->" symbol. eg pDoc->GetCurrentLineNumber
+ dim as long curPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ dim as long wordStartPos = SciExec( hEdit, SCI_WORDSTARTPOSITION, curPos, True)
+ sTrigger = right( pDoc->GetWord( wordStartPos - 1 ), 1 )
+ if sTrigger = ">" then sTrigger = "->"
+ if ( sTrigger = "." ) orelse ( sTrigger = "->" ) then
+ ' In the DereferenceLine function any "->" are converted to "." for simplicity.
+ pData = DereferenceLine( pDoc, sTrigger, wordStartPos - 1 )
+ if pData then
+ sTypeName = pData->VariableType
+ sLookFor = sTypeName & "." & sFunctionName
+ ' Set pData to null because it currently points at the TYPE definition and
+ ' we the gdb2 searches below to actually find the sub/function.
+ pData = 0
+ end if
+ end if
+
+ ' Search the list of TYPE Function names
+ if pData = 0 then pData = gdb2.dbFindFunctionTYPE( sTypeName, sLookFor )
+ ' Search the list of Function names
+ if pData = 0 then pData = gdb2.dbFindFunction( sFunctionName )
+ ' Search for variable definitions
+ if pData = 0 then pData = gdb2.dbFindVariable( "", sFunctionName )
+ ' Search for the TYPE definition
+ if pData = 0 then pData = gdb2.dbFindType( sTypeName )
+
+ end if
+
+ IF pData = 0 then
+ MessageBox( HWND_FRMMAIN, L(224,"Sub/Function definition not found."), @WStr(APPNAME), MB_ICONWARNING)
+ exit function
+ end if
+ wszFilename = pData->filename
+ nLineNum = pData->nLineStart
+
+ end if
+
+ ' Save our current position in case user invokes "Last Position" option,
+ OnCommand_SearchSaveLastPosition( pDoc )
+ OpenSelectedDocument( wszFilename, sFunctionName, nLineNum )
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Return to most previous position (invoked when "Last Position" is selected
+' ========================================================================================
+function OnCommand_SearchGotoLastPosition() as LRESULT
+
+ ' Is the pDoc pointer still valid
+ If gLastPosition.pDoc = 0 Then Exit Function
+
+ ' Position ourselves to the correct previous position.
+ frmMain_OpenFileSafely(HWND_FRMMAIN, _
+ False, _ ' bIsNewFile
+ False, _ ' bIsTemplate
+ True, _ ' bShowInTab
+ false, _ ' bIsInclude
+ gLastPosition.pDoc->DiskFilename, _ ' wszFileName
+ gLastPosition.pDoc ) ' pDocIn
+ SciExec( GetFocus, SCI_SETFIRSTVISIBLELINE, gLastPosition.nFirstLine, 0)
+ SciExec( GetFocus, SCI_GOTOPOS, gLastPosition.nPosition, 0)
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Position editor to Header/Source/Main/Resource document
+' ========================================================================================
+function OnCommand_SearchGotoFile( _
+ ByVal id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ If pDoc = 0 Then Exit Function
+
+ dim pDocFile as clsDocument ptr
+ dim as CWSTR wszFilename
+
+ dim as HWND hEdit = pDoc->hWndActiveScintilla
+
+ select case id
+ Case IDM_GOTO
+ frmGoto_Show( hEdit )
+ exit function
+
+ case IDM_GOTONEXTFUNCTION
+ pDoc->GotoNextFunction
+ exit function
+
+ case IDM_GOTOPREVFUNCTION
+ pDoc->GotoPrevFunction
+ exit function
+
+ Case IDM_GOTONEXTTAB
+ gTTabCtl.NextTab
+ exit function
+
+ Case IDM_GOTOPREVTAB
+ gTTabCtl.PrevTab
+ exit function
+
+ Case IDM_CLOSETAB
+ gTTabCtl.CloseTab
+ exit function
+
+ case IDM_GOTOMAINFILE
+ pDocFile = gApp.GetMainDocumentPtr
+ if pDocFile then wszFilename = pDocFile->DiskFilename
+
+ case IDM_GOTORESOURCEFILE
+ pDocFile = gApp.GetResourceDocumentPtr
+ if pDocFile then wszFilename = pDocFile->DiskFilename
+
+ case IDM_GOTOHEADERFILE
+ pDocFile = gApp.GetHeaderDocumentPtr( pDoc )
+ if pDocFile then wszFilename = pDocFile->DiskFilename
+
+ case IDM_GOTOSOURCEFILE
+ pDocFile = gApp.GetSourceDocumentPtr( pDoc )
+ if pDocFile then wszFilename = pDocFile->DiskFilename
+ end select
+
+ ' If the document when going to is the same as the one that we are
+ ' already in then no need to execute the movement.
+ if pDocFile = pDoc then exit function
+
+ ' Save our current position in case user invokes "Last Position" option,
+ gLastPosition.pDoc = pDoc
+ gLastPosition.nFirstLine = SciExec( hEdit, SCI_GETFIRSTVISIBLELINE, 0, 0)
+ gLastPosition.nPosition = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+
+ OpenSelectedDocument( wszFilename )
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Search action Common actions
+' ========================================================================================
+function OnCommand_SearchBookmarks( _
+ ByVal id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ dim as HWND hEdit = pDoc->hWndActiveScintilla
+
+ select case id
+ Case IDM_BOOKMARKNEXT: pDoc->NextBookmark
+ Case IDM_BOOKMARKPREV: pDoc->PrevBookmark
+
+ Case IDM_BOOKMARKCLEARALL
+ SciExec( hEdit, SCI_MARKERDELETEALL, -1, 0 )
+ LoadBookmarksFiles
+ AfxRedrawWindow( HWND_FRMBOOKMARKS )
+
+ Case IDM_BOOKMARKTOGGLE
+ pDoc->ToggleBookmark( pDoc->GetCurrentLineNumber )
+ LoadBookmarksFiles
+ AfxRedrawWindow( HWND_FRMBOOKMARKS )
+
+ case IDM_BOOKMARKCLEARALLDOCS
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ hEdit = pDoc->hWindow(0)
+ SciExec( hEdit, SCI_MARKERDELETEALL, -1, 0 )
+ pDoc = pDoc->pDocNext
+ loop
+ LoadBookmarksFiles
+ AfxRedrawWindow( HWND_FRMBOOKMARKS )
+ end select
+
+ function = 0
+end function
diff --git a/src/frmMainView.inc b/src/frmMainView.inc
index 60af7306..8a59c1a3 100644
--- a/src/frmMainView.inc
+++ b/src/frmMainView.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMainView.inc.bak b/src/frmMainView.inc.bak
new file mode 100644
index 00000000..60af7306
--- /dev/null
+++ b/src/frmMainView.inc.bak
@@ -0,0 +1,134 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMain.bi"
+#include once "clsDocument.bi"
+
+
+' ========================================================================================
+' View fold actions
+' ========================================================================================
+function OnCommand_ViewFold( _
+ ByVal id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ select case id
+ Case IDM_FOLDTOGGLE: pDoc->FoldToggle( pDoc->GetCurrentLineNumber() )
+ Case IDM_FOLDBELOW: pDoc->FoldToggleOnwards( pDoc->GetCurrentLineNumber() )
+ Case IDM_FOLDALL: pDoc->FoldAll()
+ Case IDM_UNFOLDALL: pDoc->UnFoldAll()
+ end select
+
+ function = 0
+end function
+
+' ========================================================================================
+' View zoom actions
+' ========================================================================================
+function OnCommand_ViewZoom( _
+ ByVal id as long, _
+ byval pDoc as clsDocument ptr _
+ ) as LRESULT
+
+ dim as HWND hEdit = pDoc->hWndActiveScintilla
+ select case id
+ Case IDM_ZOOMIN: SciExec(hEdit, SCI_ZOOMIN, 0, 0)
+ Case IDM_ZOOMOUT: SciExec(hEdit, SCI_ZOOMOUT, 0, 0)
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' View FunctionList, Explorer, Output, Bookmarks windows
+' ========================================================================================
+function OnCommand_ViewFunctionList() as LRESULT
+ ShowWindow( HWND_FRMPANEL, SW_SHOW )
+ gPanel.hActiveChild = HWND_FRMFUNCTIONS
+ frmPanel_PositionWindows
+ frmMain_PositionWindows
+ function = 0
+end function
+
+function OnCommand_ViewExplorer() as LRESULT
+ ShowWindow( HWND_FRMPANEL, SW_SHOW )
+ gPanel.hActiveChild = HWND_FRMEXPLORER
+ frmPanel_PositionWindows
+ frmMain_PositionWindows
+ function = 0
+end function
+
+function OnCommand_ViewBookmarksList() as LRESULT
+ ShowWindow( HWND_FRMPANEL, SW_SHOW )
+ gPanel.hActiveChild = HWND_FRMBOOKMARKS
+ frmPanel_PositionWindows
+ frmMain_PositionWindows
+ function = 0
+end function
+
+function OnCommand_ViewOutput() as LRESULT
+ ShowWindow( HWND_FRMOUTPUT, Iif(IsWindowVisible(HWND_FRMOUTPUT), SW_HIDE, SW_SHOW) )
+ frmMain_PositionWindows
+ function = 0
+end function
+
+' ========================================================================================
+' View Restore Main window size
+' ========================================================================================
+function OnCommand_ViewRestoreMain() as LRESULT
+ Dim rc As Rect
+ SystemParametersInfo( SPI_GETWORKAREA, 0, @rc, 0 )
+ MoveWindow( HWND_FRMMAIN, 0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top, CTRUE )
+ function = 0
+end function
+
+' ========================================================================================
+' View Todo, Notes
+' ========================================================================================
+function OnCommand_ViewToDo() as LRESULT
+ ' toggle close the Output window if it is open and already at ToDo
+ if IsWindowVisible(HWND_FRMOUTPUT) then
+ if gOutputTabsCurSel = 3 then
+ ShowWindow( HWND_FRMOUTPUT, SW_HIDE )
+ frmMain_PositionWindows
+ exit function
+ end if
+ else
+ ShowWindow( HWND_FRMOUTPUT, SW_SHOW )
+ end if
+ frmMain_PositionWindows
+ gOutputTabsCurSel = 3
+ frmOutput_PositionWindows
+ AfxRedrawWindow( GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TABS) )
+ function = 0
+end function
+
+function OnCommand_ViewNotes() as LRESULT
+ ' toggle close the Output window if it is open and already at Notes
+ if IsWindowVisible(HWND_FRMOUTPUT) then
+ if gOutputTabsCurSel = 4 then
+ ShowWindow( HWND_FRMOUTPUT, SW_HIDE )
+ frmMain_PositionWindows
+ exit function
+ end if
+ else
+ ShowWindow( HWND_FRMOUTPUT, SW_SHOW )
+ end if
+ frmMain_PositionWindows
+ gOutputTabsCurSel = 4
+ frmOutput_PositionWindows
+ AfxRedrawWindow( GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TABS) )
+ function = 0
+end function
diff --git a/src/frmMenuBar.inc b/src/frmMenuBar.inc
index a9548e0e..894e7f06 100644
--- a/src/frmMenuBar.inc
+++ b/src/frmMenuBar.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMenuBar.inc.bak b/src/frmMenuBar.inc.bak
new file mode 100644
index 00000000..a9548e0e
--- /dev/null
+++ b/src/frmMenuBar.inc.bak
@@ -0,0 +1,278 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+function frmMenuBar_PositionWindows() As LRESULT
+
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(HWND_FRMMAIN)
+ If pWindow = 0 Then Exit Function
+
+ dim as HWND hCtrl
+ dim as long nLeft, nTop, nWidth, nHeight
+ nLeft = pWindow->ScaleX(6)
+ nTop = 0
+ nHeight = AfxGetWindowHeight(HWND_FRMMAIN_MENUBAR)
+
+ ' position all of the child label buttons
+ for i as long = IDC_MENUBAR_FILE to IDC_MENUBAR_HELP
+ hCtrl = GetDlgItem( HWND_FRMMAIN_MENUBAR, i )
+ nWidth = AfxGetWindowWidth(hCtrl)
+ SetWindowPos( hCtrl, 0, nLeft, nTop, nWidth, nHeight, SWP_SHOWWINDOW Or SWP_NOZORDER )
+ AfxRedrawWindow( hCtrl )
+ nLeft = nLeft + nWidth
+ next
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmMenuBar
+' ========================================================================================
+function frmMenuBar_OnSize( _
+ ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+ If state <> SIZE_MINIMIZED Then
+ ' Position all of the child windows
+ frmMenuBar_PositionWindows
+ End If
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmMenuBar Window procedure
+' ========================================================================================
+function frmMenuBar_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_SIZE, frmMenuBar_OnSize)
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_PAINT
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDc
+ Dim As Rect rc
+
+ hDC = BeginPaint(hWnd, @ps)
+ GetClientRect(HWnd, @rc)
+ FillRect( hDC, @rc, ghMenuBar.hPanelBrush )
+ EndPaint hWnd, @ps
+
+ case WM_DRAWITEM
+ Dim memDC as HDC ' Double buffering
+ Dim hbit As HBITMAP ' Double buffering
+ Dim As RECT rc
+
+ dim lpdis As DRAWITEMSTRUCT Ptr = cast( DRAWITEMSTRUCT Ptr, lParam )
+ if lpdis = 0 then exit function
+
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(lpdis->hwndItem)
+ If pWindow = 0 Then Exit Function
+
+ if ( lpdis->itemAction = ODA_DRAWENTIRE ) orelse _
+ ( lpdis->itemAction = ODA_SELECT ) orelse _
+ ( lpdis->itemAction = ODA_FOCUS ) then
+
+ GetClientRect( lpdis->hwndItem, @rc )
+
+ dim as HFONT oldFont
+ dim as HBITMAP oldBmp
+
+ SaveDC(lpdis->hDC)
+
+ memDC = CreateCompatibleDC( lpdis->hDC )
+ hbit = CreateCompatibleBitmap( lpdis->hDC, rc.right, rc.bottom )
+
+ SaveDC(memDC)
+ oldBmp = SelectObject( memDC, hbit )
+ oldFont = SelectObject( memDC, ghMenuBar.hFontMenuBar )
+
+ dim as boolean IsHot = false
+ if lpdis->hwndItem = ghWndActiveMenuBarButton then IsHot = true
+
+ ' Paint the entire background
+ FillRect( memDC, @rc, iif( IsHot, ghMenuBar.hBackBrushHot, ghMenuBar.hBackBrush) )
+
+ ' Prepare and paint the text coloring
+ SetBkColor( memDC, iif( IsHot, ghMenuBar.BackColorHot, ghMenuBar.BackColor) )
+ SetTextColor( memDC, iif( IsHot, ghMenuBar.ForeColorHot, ghMenuBar.ForeColor) )
+
+ dim as long wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER or DT_SINGLELINE
+
+ ' pad the drawing rectangle to allow left and right margins
+ dim as RECT rcText = lpdis->rcItem
+ rcText.left = rcText.left + pWindow->ScaleX(4)
+ rcText.right = rcText.right - pWindow->ScaleX(4)
+
+ dim as CWSTR wszCaption = AfxGetWindowText( lpdis->hwndItem )
+ DrawText( memDC, wszCaption.sptr, -1, Cast(lpRect, @rcText), wsStyle )
+ SelectObject( memDC, oldFont )
+
+ BitBlt lpdis->hDC, 0, 0, rc.right, rc.bottom, memDC, 0, 0, SRCCOPY
+
+ SelectObject( memDC, oldBmp )
+
+ ' Cleanup
+ RestoreDC(memDC, -1)
+ if hbit then DeleteObject(hbit)
+ If memDC Then DeleteDC(memDC)
+ RestoreDC(lpdis->hDC, -1)
+ return true
+ end if
+
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmMenuBar_SubclassProc
+' ========================================================================================
+function frmMenuBar_SubclassProc ( _
+ ByVal hWin As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal _wParam As WPARAM, _ ' // First message parameter
+ ByVal _lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(hWin)
+
+ Select Case uMsg
+ Case WM_GETDLGCODE
+ ' Do not filter any types of messages. We want the dialog box manager to be
+ ' able to correctly handle TAB, arrows, and focus rectangles, etc.
+
+ Case WM_MOUSEMOVE
+ ' If we have moused over a new button then redraw the previous one so the hot
+ ' state can be properly rendered. We do it here because WM_MOUSELEAVE can not
+ ' be depended on to fire if we move quickly between adjacent menubar buttons.
+ dim as HWND prevCtrl = 0
+ if ghWndActiveMenuBarButton then prevCtrl = ghWndActiveMenuBarButton
+ ghWndActiveMenuBarButton = hWin
+ if prevCtrl then AfxRedrawWindow(prevCtrl)
+
+ IF ghWndActiveMenuBarButton <> prevCtrl THEN
+ ' A new menubar button has been moused over. If a previous popup
+ ' menu exists then we will automatically continue to show a popup menu
+ ' for the newly selected menubar button.
+ if IsWindowVisible(HWND_MENU(0)) then
+ frmPopupMenu_Show( ID_POPUP, 0, hWin )
+ end if
+ ' Track that we are over the control in order to catch the
+ ' eventual WM_MOUSELEAVE event
+ Dim tme As TrackMouseEvent
+ tme.cbSize = Sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER Or TME_LEAVE
+ tme.hwndTrack = hWin
+ TrackMouseEvent(@tme)
+ End If
+ ' refresh the label so that the Hot state can draw correctly
+ AfxRedrawWindow(hWin)
+
+ case WM_MOUSELEAVE
+ if IsWindow(HWND_MENU(0)) = 0 then
+ ghWndActiveMenuBarButton = 0
+ AfxRedrawWindow(hWin)
+ end if
+
+ case WM_LBUTTONDOWN
+ ' activate the popup menu or toggle an existing one off
+ if IsWindow(HWND_MENU(0)) then
+ killPopupMenus()
+ killPopupSubMenus()
+ else
+ frmPopupMenu_Show( ID_POPUP, 0, hWin )
+ end if
+ AfxRedrawWindow(hWin)
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hWin, @frmMenuBar_SubclassProc, uIdSubclass )
+ End Select
+
+ ' For messages that we don't deal with
+ Function = DefSubclassProc(hWin, uMsg, _wParam, _lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmMenuBar_CreateButton
+' ========================================================================================
+function frmMenuBar_CreateButton( _
+ byval isFirstControl as boolean, _
+ byval pWindow as CWindow ptr, _
+ byval CtrlID as long _
+ ) As HWND
+
+ dim as long dwStyle = WS_CHILD Or SS_NOTIFY or SS_OWNERDRAW or WS_VISIBLE
+ dim wszText as wstring * 200 = getMenuText(CtrlID)
+ dim as long nWidth = getTextWidth( HWND_FRMMAIN_MENUBAR, wszText, ghMenuBar.hFontMenuBar, 6 )
+
+ if isFirstControl then dwStyle = dwStyle or WS_GROUP
+ function = pWindow->AddControl ( "LABEL", , CtrlID, wszText, 0, 0, nWidth, 0, dwStyle, 0, 0, _
+ Cast(SUBCLASSPROC, @frmMenuBar_SubclassProc), CtrlID, Cast(DWORD_PTR, 0) )
+
+end function
+
+' ========================================================================================
+' frmMenuBar_Show
+' ========================================================================================
+function frmMenuBar_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMMAIN_MENUBAR = pWindow->Create( hWndParent, "", @frmMenuBar_WndProc, _
+ 0, 0, 0, MENUBAR_HEIGHT, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ frmMenuBar_CreateButton( true, pWindow, IDC_MENUBAR_FILE )
+ frmMenuBar_CreateButton( false, pWindow, IDC_MENUBAR_EDIT )
+ frmMenuBar_CreateButton( false, pWindow, IDC_MENUBAR_SEARCH )
+ frmMenuBar_CreateButton( false, pWindow, IDC_MENUBAR_VIEW )
+ frmMenuBar_CreateButton( false, pWindow, IDC_MENUBAR_PROJECT )
+ frmMenuBar_CreateButton( false, pWindow, IDC_MENUBAR_COMPILE )
+ frmMenuBar_CreateButton( false, pWindow, IDC_MENUBAR_DESIGNER )
+ frmMenuBar_CreateButton( false, pWindow, IDC_MENUBAR_HELP )
+
+ buildTopMenuDefinitions()
+
+ Function = 0
+
+End Function
+
diff --git a/src/frmMenuEditor.bi b/src/frmMenuEditor.bi
index 24c66f06..814c08ad 100644
--- a/src/frmMenuEditor.bi
+++ b/src/frmMenuEditor.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMenuEditor.bi.bak b/src/frmMenuEditor.bi.bak
new file mode 100644
index 00000000..24c66f06
--- /dev/null
+++ b/src/frmMenuEditor.bi.bak
@@ -0,0 +1,43 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#DEFINE IDC_FRMMENUEDITOR_LABEL1 1000
+#DEFINE IDC_FRMMENUEDITOR_LABEL2 1001
+#DEFINE IDC_FRMMENUEDITOR_LABEL3 1002
+#DEFINE IDC_FRMMENUEDITOR_TXTCAPTION 1003
+#DEFINE IDC_FRMMENUEDITOR_TXTNAME 1004
+#DEFINE IDC_FRMMENUEDITOR_CMBOSHORTCUT 1005
+#DEFINE IDC_FRMMENUEDITOR_CHKCHECKED 1006
+#DEFINE IDC_FRMMENUEDITOR_CHKGRAYED 1007
+#DEFINE IDC_FRMMENUEDITOR_CMDDELETE 1008
+#DEFINE IDC_FRMMENUEDITOR_CMDINSERT 1009
+#DEFINE IDC_FRMMENUEDITOR_CMDNEXT 1010
+#DEFINE IDC_FRMMENUEDITOR_CMDCANCEL 1011
+#DEFINE IDC_FRMMENUEDITOR_CMDOK 1012
+#DEFINE IDC_FRMMENUEDITOR_LABEL4 1013
+#DEFINE IDC_FRMMENUEDITOR_LSTDETAIL 1014
+#DEFINE IDC_FRMMENUEDITOR_CMDLEFT 1015
+#DEFINE IDC_FRMMENUEDITOR_CMDRIGHT 1016
+#DEFINE IDC_FRMMENUEDITOR_CMDUP 1017
+#DEFINE IDC_FRMMENUEDITOR_CMDDOWN 1018
+#Define IDC_FRMMENUEDITOR_CHKCTRL 1019
+#Define IDC_FRMMENUEDITOR_CHKALT 1020
+#Define IDC_FRMMENUEDITOR_CHKSHIFT 1021
+#Define IDC_FRMMENUEDITOR_LBLSHORTCUT 1022
+#Define IDC_FRMMENUEDITOR_LBLSTATE 1023
+#Define IDC_FRMMENUEDITOR_CHKDISPLAYONFORM 1024
+
+declare Function frmMenuEditor_CreateFakeMainMenu( ByVal pDoc as clsDocument ptr ) As Long
+declare Function frmMenuEditor_Show( ByVal hWndParent As HWnd ) as LRESULT
diff --git a/src/frmMenuEditor.inc b/src/frmMenuEditor.inc
index 2323e064..89ce5c82 100644
--- a/src/frmMenuEditor.inc
+++ b/src/frmMenuEditor.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmMenuEditor.inc.bak b/src/frmMenuEditor.inc.bak
new file mode 100644
index 00000000..2323e064
--- /dev/null
+++ b/src/frmMenuEditor.inc.bak
@@ -0,0 +1,710 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmMenuEditor.bi"
+#include once "clsMenuItem.bi"
+#include once "clsDocument.bi"
+
+
+' Temporary MenuItem array to hold items while they are being
+' edited in the Menu Editor.
+dim shared gMenuItems(any) as clsMenuItem
+
+
+' ========================================================================================
+' Create the "fake" topmenu to display on the Form
+' ========================================================================================
+function frmMenuEditor_CreateFakeMainMenu( ByVal pDoc as clsDocument ptr ) As Long
+
+ ' Rather than create a bunch of individual labels, create the one string
+ ' and then only one label. If the label is clicked, then display the Menu Editor.
+ ' Only create the mainmenu if menuitems actually exist.
+ if pDoc->MainMenuExists = false then
+ ShowWindow(pDoc->hWndFakeMenu, SW_HIDE)
+ exit function
+ end if
+
+ dim as CWSTR wszMenu = wspace(2)
+ for i as long = lbound(pDoc->MenuItems) to ubound(pDoc->MenuItems)
+ if pDoc->MenuItems(i).nIndent = 0 then
+ wszMenu = wszMenu & pDoc->MenuItems(i).wszCaption & wspace(4)
+ end if
+ next
+ AfxSetWindowText( pDoc->hWndFakeMenu, wszMenu )
+
+ dim ncm As NONCLIENTMETRICS
+ ncm.cbSize = SizeOf(ncm)
+ SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(ncm), @ncm, 0)
+ ' ncm.iMenuHeight ' holds the height of the mainmenu
+
+ dim rc as RECT
+ GetClientRect( pDoc->hWndForm, @rc)
+ SetWindowPos( pDoc->hWndFakeMenu, 0, 0, 0, rc.right-rc.left, ncm.iMenuHeight, SWP_NOZORDER or SWP_SHOWWINDOW)
+
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Display menu information for the specified line.
+' ========================================================================================
+function frmMenuEditor_ListBoxLine( byval nCurSel as long ) as CWSTR
+ dim as long nBullet, nDash
+ IF AfxWindowsVersion >= 600 AND CLNG(AfxIsProcessDpiAware) THEN
+ ' Segoe UI
+ nBullet = 183: nDash = 8211
+ ELSE
+ ' Tahoma
+ nBullet = 183: nDash = 8211
+ end if
+
+ dim as CWSTR wszLine = wstring(gMenuItems(nCurSel).nIndent * 4, nBullet)
+ dim as long nShow = SW_SHOW
+ if trim(gMenuItems(nCurSel).wszCaption) = "-" then
+ wszLine = wszLine & " " & wstring(4, nDash)
+ nShow = SW_HIDE
+ else
+ wszLine = wszLine & gMenuItems(nCurSel).wszCaption
+ end if
+
+ ShowWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_LBLSHORTCUT), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_LBLSTATE), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CMBOSHORTCUT), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKCTRL), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKALT), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKSHIFT), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKCHECKED), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKGRAYED), nShow )
+
+ function = wszLine
+end function
+
+
+' ========================================================================================
+' Determine if a blank entry should be added to the end of the listbox.
+' ========================================================================================
+function frmMenuEditor_EnsureLastLine() As Long
+
+ dim as HWND hListBox = GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_LSTDETAIL )
+ dim as long NumItems = Listbox_GetCount(hListBox)
+
+ If NumItems > 0 Then
+ ' Check the Caption and Name values for the last menu item. If
+ ' no value exists then no need to add a blank entry at the end.
+ If ( gMenuItems(NumItems-1).wszName = "" ) AndAlso ( gMenuItems(NumItems-1).wszCaption = "" ) Then
+ Exit Function
+ End If
+ End If
+
+ dim wszBlankLine as wstring * 10
+ ListBox_AddString( hListBox, @wszBlankLine )
+ redim preserve gMenuItems(NumItems + 1)
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Display the details of this MenuItem
+' ========================================================================================
+function frmMenuEditor_DisplayMenuItem() As Long
+
+ dim as long nCurSel
+ dim as Boolean bEnabled = true
+
+ nCurSel = Listbox_GetCurSel( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_LSTDETAIL) )
+ If nCurSel = -1 Then Exit Function
+
+ ' If this is a TopLevel Menu Item then disable the Shortcut key
+ If gMenuItems(nCurSel).nIndent = 0 Then
+ gMenuItems(nCurSel).wszShortcut = "" ' this will display (None)
+ gMenuItems(nCurSel).chkAlt = BST_UNCHECKED
+ gMenuItems(nCurSel).chkShift = BST_UNCHECKED
+ gMenuItems(nCurSel).chkCtrl = BST_UNCHECKED
+ gMenuItems(nCurSel).chkChecked = BST_UNCHECKED
+ bEnabled = false
+ end if
+
+ AfxSetWindowText( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_TXTCAPTION), gMenuItems(nCurSel).wszCaption)
+ AfxSetWindowText( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_TXTNAME), gMenuItems(nCurSel).wszName)
+
+ ' Shortcut
+ dim as long nIndex = ComboBox_FindStringExact( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CMBOSHORTCUT), -1, gMenuItems(nCurSel).wszShortcut.sptr )
+ ComboBox_SetCurSel( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CMBOSHORTCUT), nIndex)
+ EnableWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CMBOSHORTCUT), bEnabled )
+ Button_SetCheck( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKCTRL), gMenuItems(nCurSel).chkCtrl)
+ EnableWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKCTRL), bEnabled )
+ Button_SetCheck( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKALT), gMenuItems(nCurSel).chkAlt)
+ EnableWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKALT), bEnabled )
+ Button_SetCheck( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKSHIFT), gMenuItems(nCurSel).chkShift)
+ EnableWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKSHIFT), bEnabled )
+
+ ' Checked
+ Button_SetCheck( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKCHECKED), gMenuItems(nCurSel).chkChecked )
+ EnableWindow( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKCHECKED), bEnabled )
+
+ ' Grayed
+ Button_SetCheck( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKGRAYED), gMenuItems(nCurSel).chkGrayed )
+
+ SetFocus( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_TXTCAPTION) )
+ SendMessage GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_TXTCAPTION), EM_SETSEL, 0, cast(LPARAM, -1)
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Generate a default MenuItem Name based on the MenuItem Caption
+' ========================================================================================
+function frmMenuEditor_GenerateMenuItemName( byval nCurSel as long ) As CWSTR
+
+ dim as CWSTR wszCaption = gMenuItems(nCurSel).wszCaption
+ dim as CWSTR wszName
+ dim as Boolean bFound
+ dim as long nextSeperator
+
+ If Trim(wszCaption) = "-" Then
+ ' Determine what separator number has not been used yet.
+ Do
+ bFound = false ' default that it doesn't exist
+ nextSeperator = nextSeperator + 1
+ wszName = "mnuSep" & nextSeperator
+ For i as long = 0 To ubound(gMenuItems) - 1
+ If UCase(gMenuItems(i).wszName) = UCase(wszName) Then continue do
+ Next
+ if bFound = false then exit do
+ Loop
+ Else
+ ' The name can only be alphanumeric
+ static wszRetain as CWSTR = "abcdefghijklmnopqrstuvwxyz0123456789"
+ wszName = "mnu" & AfxStrRetainAnyI(wszCaption, wszRetain)
+ End If
+
+ function = wszName
+end function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmMenuEditor
+' ========================================================================================
+function frmMenuEditor_OnCreate( _
+ ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) as boolean
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmMenuEditor
+' ========================================================================================
+function frmMenuEditor_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim as HWND hListBox = GetDlgItem( HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_LSTDETAIL)
+ dim as long nCurSel = ListBox_GetCurSel(hListBox)
+
+ Select Case id
+ Case IDC_FRMMENUEDITOR_CMDOK
+ If codeNotify = BN_CLICKED Then
+ ' Do error checking to ensure that the menu structure is valid
+ for i as long = 0 to ubound(gMenuItems) - 1
+ ' If a caption exists but does not have a name then present the error.
+ If ( Len(gMenuItems(i).wszCaption) > 0 ) andalso ( Len(Trim(gMenuItems(i).wszName)) = 0 ) Then
+ ListBox_SetCurSel(hListBox, i)
+ frmMenuEditor_DisplayMenuItem
+ MessageBox( HWND, L(357,"A Name must exist for menu items with a Caption."), _
+ L(109,"Warning"), MB_OK Or MB_ICONINFORMATION Or MB_DEFBUTTON1 Or MB_APPLMODAL )
+ exit function
+ End If
+ next
+
+ ' Do error checking for duplicate menu names
+ for i as long = 0 to ubound(gMenuItems) - 1
+ ' If a caption exists but does not have a name then present the error.
+ for ii as long = 0 to ubound(gMenuItems) - 1
+ if ii = i then continue for
+ If ucase(trim(gMenuItems(ii).wszName)) = ucase(trim(gMenuItems(i).wszName)) Then
+ ListBox_SetCurSel(hListBox, ii)
+ frmMenuEditor_DisplayMenuItem
+ MessageBox( HWND, L(367,"Duplicate menu name.") & vbcrlf & gMenuItems(i).wszName, _
+ L(109,"Warning"), MB_OK Or MB_ICONINFORMATION Or MB_DEFBUTTON1 Or MB_APPLMODAL )
+ exit function
+ end if
+ next
+ next
+
+ ' Make sure the indent levels are consistent.
+ for i as long = 1 to ubound(gMenuItems) - 1
+ if gMenuItems(i).nIndent > gMenuItems(i-1).nIndent + 1 then
+ ListBox_SetCurSel(hListBox, i)
+ frmMenuEditor_DisplayMenuItem
+ MessageBox( HWND, L(358,"Menu item has skipped a level."), _
+ L(109,"Warning"), MB_OK Or MB_ICONINFORMATION Or MB_DEFBUTTON1 Or MB_APPLMODAL )
+ exit function
+ end if
+ next
+
+ ' Copy the temporary array back to the form's menu items
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ ' Copy all menuitems except for the last one because that is
+ ' the last blank line in the listbox.
+ dim as long numItems = ubound(gMenuItems) - 1
+ if numItems > -1 then
+ redim pDoc->MenuItems(numItems)
+ for i as long = 0 to numItems
+ pDoc->MenuItems(i) = gMenuItems(i)
+ next
+ end if
+
+ ' Save the value indicating that we want the menu to display in
+ ' the generated code for the form.
+ pDoc->GenerateMenu = _
+ iif(Button_GetCheck(GetDlgItem(HWND, IDC_FRMMENUEDITOR_CHKDISPLAYONFORM)) = BST_CHECKED, true, false)
+
+ ' If there are no valid MenuItems then set the GenerateMenu to False.
+ if numItems < 0 then pDoc->GenerateMenu = false
+
+ pDoc->UserModified = true
+ end if
+
+ SendMessage(HWnd, WM_CLOSE, 0, 0)
+ Exit Function
+ End If
+
+ Case IDC_FRMMENUEDITOR_CMDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage(HWnd, WM_CLOSE, 0, 0)
+ Exit Function
+ End If
+
+ case IDC_FRMMENUEDITOR_LSTDETAIL
+ If codeNotify = LBN_SELCHANGE Then
+ frmMenuEditor_DisplayMenuItem
+ end if
+
+ case IDC_FRMMENUEDITOR_TXTCAPTION
+ If codeNotify = EN_CHANGE Then
+ if nCurSel = -1 then exit function
+ ' Update the listbox with the new caption
+ gMenuItems(nCurSel).wszCaption = AfxGetWindowText(hwndCtl)
+ dim as CWSTR wszCaption = frmMenuEditor_ListBoxLine(nCurSel)
+ ListBox_ReplaceString( GetDlgItem(HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_LSTDETAIL), nCurSel, wszCaption)
+ frmMenuEditor_EnsureLastLine
+ end if
+
+ case IDC_FRMMENUEDITOR_TXTNAME
+ if nCurSel = -1 then exit function
+ If codeNotify = EN_CHANGE Then
+ gMenuItems(nCurSel).wszName = AfxGetWindowText(hwndCtl)
+ frmMenuEditor_EnsureLastLine
+ elseIf codeNotify = EN_SETFOCUS Then
+ if len(gMenuItems(nCurSel).wszName) = 0 then
+ gMenuItems(nCurSel).wszName = frmMenuEditor_GenerateMenuItemName(nCurSel)
+ AfxSetWindowText(hwndCtl, gMenuItems(nCurSel).wszName)
+ SendMessage( hwndCtl, EM_SETSEL, 0, cast(LPARAM, -1) )
+ end if
+ end if
+
+ Case IDC_FRMMENUEDITOR_CMDNEXT
+ If codeNotify = BN_CLICKED Then
+ frmMenuEditor_EnsureLastLine
+ ' move down one selection or wrap to start
+ nCurSel = nCurSel + 1
+ If nCurSel > Listbox_GetCount(hListBox) - 1 then nCurSel = 0
+ Listbox_SetCurSel(hListBox, nCurSel )
+ frmMenuEditor_DisplayMenuItem
+ End If
+
+ Case IDC_FRMMENUEDITOR_CHKDISPLAYONFORM
+ If codeNotify = BN_CLICKED Then
+ ' Don't need to store the value. We will check it when the
+ ' Menu Editor is closed.
+ End If
+
+ Case IDC_FRMMENUEDITOR_CHKALT
+ if nCurSel = -1 then exit function
+ If codeNotify = BN_CLICKED Then
+ gMenuItems(nCurSel).chkAlt = Button_GetCheck(hwndCtl)
+ End If
+
+ Case IDC_FRMMENUEDITOR_CHKSHIFT
+ if nCurSel = -1 then exit function
+ If codeNotify = BN_CLICKED Then
+ gMenuItems(nCurSel).chkShift = Button_GetCheck(hwndCtl)
+ End If
+
+ Case IDC_FRMMENUEDITOR_CHKCTRL
+ if nCurSel = -1 then exit function
+ If codeNotify = BN_CLICKED Then
+ gMenuItems(nCurSel).chkCtrl = Button_GetCheck(hwndCtl)
+ End If
+
+ Case IDC_FRMMENUEDITOR_CHKCHECKED
+ if nCurSel = -1 then exit function
+ If codeNotify = BN_CLICKED Then
+ gMenuItems(nCurSel).chkChecked = Button_GetCheck(hwndCtl)
+ End If
+
+ Case IDC_FRMMENUEDITOR_CHKGRAYED
+ if nCurSel = -1 then exit function
+ If codeNotify = BN_CLICKED Then
+ gMenuItems(nCurSel).chkGrayed = Button_GetCheck(hwndCtl)
+ End If
+
+ Case IDC_FRMMENUEDITOR_CMBOSHORTCUT
+ if nCurSel = -1 then exit function
+ If codeNotify = CBN_SELCHANGE Then
+ gMenuItems(nCurSel).wszShortcut = AfxGetWindowText(hwndCtl)
+ End If
+
+ Case IDC_FRMMENUEDITOR_CMDLEFT
+ If codeNotify = BN_CLICKED Then
+ if nCurSel = -1 then exit function
+ ' Can not move less than 0 position
+ if gMenuItems(nCurSel).nIndent - 1 < 0 then exit function
+ gMenuItems(nCurSel).nIndent = gMenuItems(nCurSel).nIndent - 1
+ frmMenuEditor_DisplayMenuItem
+ End If
+
+ Case IDC_FRMMENUEDITOR_CMDRIGHT
+ If codeNotify = BN_CLICKED Then
+ ' You can only move the item one place to the right of the item's parent
+ if nCurSel <= 0 then exit function ' can not move the first item in the list
+ dim as long nPrevIndent = gMenuItems(nCurSel-1).nIndent
+ dim as long nCurIndent = gMenuItems(nCurSel).nIndent
+ if nCurIndent + 1 > nPrevIndent + 1 then exit function
+ gMenuItems(nCurSel).nIndent = nCurIndent + 1
+ frmMenuEditor_DisplayMenuItem
+ End If
+
+ Case IDC_FRMMENUEDITOR_CMDUP
+ If codeNotify = BN_CLICKED Then
+ ' You can only move the item one place to the right of the item's parent
+ if nCurSel <= 0 then exit function ' can not move the first item in the list
+ ' If the MenuItem was moved to position 0 then ensure that the indent is 0.
+ if nCurSel = 1 then gMenuItems(nCurSel).nIndent = 0
+ swap gMenuItems(nCurSel), gMenuItems(nCurSel-1)
+ ' Display the two lines
+ ListBox_ReplaceString(hListBox, nCurSel-1, frmMenuEditor_ListBoxLine(nCurSel-1))
+ ListBox_ReplaceString(hListBox, nCurSel, frmMenuEditor_ListBoxLine(nCurSel))
+ Listbox_SetCurSel( hListBox, nCurSel - 1)
+ frmMenuEditor_DisplayMenuItem
+ End If
+
+ Case IDC_FRMMENUEDITOR_CMDDOWN
+ If codeNotify = BN_CLICKED Then
+ ' You can only move the item one place to the right of the item's parent
+ if nCurSel = -1 then exit function
+ ' If the MenuItem was moved from position 0 then ensure that the indent is 0.
+ if nCurSel = 0 then gMenuItems(nCurSel+1).nIndent = 0
+ swap gMenuItems(nCurSel), gMenuItems(nCurSel+1)
+ ' Display the two lines
+ ListBox_ReplaceString(hListBox, nCurSel, frmMenuEditor_ListBoxLine(nCurSel))
+ ListBox_ReplaceString(hListBox, nCurSel+1, frmMenuEditor_ListBoxLine(nCurSel+1))
+ Listbox_SetCurSel( hListBox, nCurSel + 1)
+ frmMenuEditor_DisplayMenuItem
+ End If
+
+ Case IDC_FRMMENUEDITOR_CMDDELETE
+ If codeNotify = BN_CLICKED Then
+ if nCurSel = -1 then exit function
+ for i as long = nCurSel to ubound(gMenuItems) - 1
+ gMenuItems(i) = gMenuItems(i+1)
+ next
+ Redim Preserve gMenuItems(Ubound(gMenuItems)-1)
+ Listbox_DeleteString(hListBox, nCurSel)
+ ' If position 0 is deleted then ensure the item replacing it is indent 0.
+ if nCurSel = 0 then
+ gMenuItems(0).nIndent = 0
+ ListBox_ReplaceString(hListBox, 0, frmMenuEditor_ListBoxLine(0))
+ end if
+ frmMenuEditor_EnsureLastLine
+ dim as long NumItems = Listbox_GetCount(hListBox)
+ Listbox_SetCurSel( hListBox, Min(nCurSel, NumItems-1) )
+ frmMenuEditor_DisplayMenuItem
+ end if
+
+ Case IDC_FRMMENUEDITOR_CMDINSERT
+ If codeNotify = BN_CLICKED Then
+ if nCurSel = -1 then exit function
+ Redim Preserve gMenuItems(Ubound(gMenuItems)+1)
+ For i as long = Ubound(gMenuItems) To nCurSel + 1 Step -1
+ gMenuItems(i) = gMenuItems(i-1)
+ Next
+ dim newMenuItem as clsMenuItem
+ gMenuItems(nCurSel) = newMenuItem
+ Listbox_InsertString(hListBox, nCurSel, gMenuItems(nCurSel).wszCaption.sptr)
+ frmMenuEditor_EnsureLastLine
+ dim as long NumItems = Listbox_GetCount(hListBox)
+ Listbox_SetCurSel( hListBox, nCurSel )
+ frmMenuEditor_DisplayMenuItem
+ end if
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmMenuEditor
+' ========================================================================================
+function frmMenuEditor_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Reset the global MenuItems array
+ erase gMenuItems
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow HWnd
+ Function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmMenuEditor
+' ========================================================================================
+function frmMenuEditor_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+end function
+
+
+' ========================================================================================
+' frmMenuEditor Window procedure
+' ========================================================================================
+function frmMenuEditor_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmMenuEditor_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmMenuEditor_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmMenuEditor_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmMenuEditor_OnCommand)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+end function
+
+
+' ========================================================================================
+' frmMenuEditor_Show
+' ========================================================================================
+function frmMenuEditor_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ DIM hBitmap AS HBITMAP
+ dim hCtrl as HWnd
+ dim wszImage as wstring * 100
+ dim wszString as WSTRING * 100
+
+ HWND_FRMMENUEDITOR = _
+ pWindow->Create(hWndParent, L(312,"Menu Editor"), @frmMenuEditor_WndProc, 0, 0, 411, 438, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ pWindow->AddControl("LABEL", , IDC_FRMMENUEDITOR_LABEL3, L(150,"Text") & ":", 10, 16, 62, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", , IDC_FRMMENUEDITOR_LABEL1, L(364,"Name") & ":", 10, 40, 62, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMMENUEDITOR_TXTCAPTION, "", 74, 13, 233, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMMENUEDITOR_TXTNAME, "", 74, 37, 233, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMMENUEDITOR_LBLSHORTCUT, L(363,"Shortcut") & ":", 10, 65, 54, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMMENUEDITOR_CHKCTRL, "Ctrl", 74, 65, 48, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMMENUEDITOR_CHKALT, "Alt", 124, 65, 42, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMMENUEDITOR_CHKSHIFT, "Shift", 168, 65, 48, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMMENUEDITOR_CMBOSHORTCUT, "", 240, 65, 67, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMMENUEDITOR_LBLSTATE, L(360,"State") & ":", 10, 90, 63, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMMENUEDITOR_CHKCHECKED, L(361,"Checked"), 74, 91, 175, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMMENUEDITOR_CHKGRAYED, L(362,"Grayed"), 74, 110, 175, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMMENUEDITOR_CMDLEFT, "", 17, 141, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWLEFT", "IMAGE_ARROWLEFT16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMMENUEDITOR_CMDRIGHT, "", 43, 141, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWRIGHT", "IMAGE_ARROWRIGHT16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMMENUEDITOR_CMDUP, "", 69, 141, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWUP", "IMAGE_ARROWUP16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMMENUEDITOR_CMDDOWN, "", 95, 141, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWDOWN", "IMAGE_ARROWDOWN16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMMENUEDITOR_CMDNEXT, L(359,"&Next"), 157, 141, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMMENUEDITOR_CMDINSERT, L(281,"&Insert"), 237, 141, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMMENUEDITOR_CMDDELETE, L(282,"&Delete"), 317, 141, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LISTBOX", , IDC_FRMMENUEDITOR_LSTDETAIL, "", 13, 173, 384, 200, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or LBS_NOINTEGRALHEIGHT, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("BUTTON", , IDC_FRMMENUEDITOR_CMDOK, L(0,"&OK"), 317, 13, 80, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMMENUEDITOR_CMDCANCEL, L(1,"&Cancel"), 317, 42, 80, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMMENUEDITOR_CHKDISPLAYONFORM, L(237,"Display on Form"), 13, 383, 175, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ hCtrl = GetDlgItem( HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CMBOSHORTCUT)
+ ComboBox_ResetContent(hCtrl)
+
+ ' Have a blank string at the beginning of the list so that an accelerator can be unselected
+ wszString = ""
+ ComboBox_AddString(hCtrl, @wszString)
+
+ For i as long = 1 To 26 ' A-Z
+ wszString = wchr(i + 64)
+ ComboBox_AddString(hCtrl, @wszString)
+ Next
+ For i as long = 0 To 9 ' 0-9
+ wszString = wchr(i + 48)
+ ComboBox_AddString(hCtrl, @wszString)
+ Next
+ For i as long = 1 To 12 ' F1 to F12
+ wszString = "F" & i
+ ComboBox_AddString(hCtrl, @wszString)
+ Next
+
+ ComboBox_AddString(hCtrl, @wstr("Ins"))
+ ComboBox_AddString(hCtrl, @wstr("Del"))
+ ComboBox_AddString(hCtrl, @wstr("TAB"))
+ ComboBox_AddString(hCtrl, @wstr("Left"))
+ ComboBox_AddString(hCtrl, @wstr("Right"))
+ ComboBox_AddString(hCtrl, @wstr("Up"))
+ ComboBox_AddString(hCtrl, @wstr("Down"))
+ ComboBox_AddString(hCtrl, @wstr("Home"))
+ ComboBox_AddString(hCtrl, @wstr("End"))
+ ComboBox_AddString(hCtrl, @wstr("PgUp"))
+ ComboBox_AddString(hCtrl, @wstr("PgDn"))
+ ComboBox_AddString(hCtrl, @wstr("Space"))
+ ComboBox_AddString(hCtrl, @wstr("Plus"))
+ ComboBox_AddString(hCtrl, @wstr("Minus"))
+ ComboBox_AddString(hCtrl, @wstr("Enter"))
+
+ ComboBox_SetCurSel(hCtrl, 0)
+
+
+ ' Copy the form's menu items to the temporary array for editing
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ hCtrl = GetDlgItem( HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_CHKDISPLAYONFORM )
+ Button_SetCheck( hCtrl, iif(pDoc->GenerateMenu, BST_CHECKED, BST_UNCHECKED))
+ dim as long numItems = ubound(pDoc->MenuItems)
+ if numItems > -1 then
+ redim gMenuItems(numItems)
+ for i as long = 0 to numItems
+ gMenuItems(i) = pDoc->MenuItems(i)
+ next
+ end if
+ end if
+
+ ' Display the menuitems in the listbox
+ hCtrl = GetDlgItem( HWND_FRMMENUEDITOR, IDC_FRMMENUEDITOR_LSTDETAIL)
+ for i as long = 0 to ubound(gMenuItems)
+ ListBox_AddString(hCtrl, frmMenuEditor_ListBoxLine(i).sptr)
+ next
+ frmMenuEditor_EnsureLastLine
+ ListBox_SetCurSel(hCtrl, 0)
+ frmMenuEditor_DisplayMenuItem
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents( SW_SHOW )
+
+ ' Delete the frmMenuEditor CWindow class manually allocated memory
+ Delete pWindow
+
+ ' Erase the temporary global MenuItems array
+ erase gMenuItems
+
+end function
+
+
+
+
+
diff --git a/src/frmOptions.bi b/src/frmOptions.bi
index 5433463e..26116077 100644
--- a/src/frmOptions.bi
+++ b/src/frmOptions.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptions.bi.bak b/src/frmOptions.bi.bak
new file mode 100644
index 00000000..5433463e
--- /dev/null
+++ b/src/frmOptions.bi.bak
@@ -0,0 +1,25 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMOPTIONS_LABEL1 1000
+#Define IDC_FRMOPTIONS_CMDCANCEL 1001
+#Define IDC_FRMOPTIONS_LBLCATEGORY 1002
+#Define IDC_FRMOPTIONS_CMDOK 1003
+#Define IDC_FRMOPTIONS_TVWCATEGORIES 1004
+
+dim shared OptionsDialogLastOpened as long
+
+declare Function frmOptions_Show( ByVal hWndParent As HWnd ) as LRESULT
+
diff --git a/src/frmOptions.inc b/src/frmOptions.inc
index a67891d5..923094ff 100644
--- a/src/frmOptions.inc
+++ b/src/frmOptions.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptions.inc.bak b/src/frmOptions.inc.bak
new file mode 100644
index 00000000..a67891d5
--- /dev/null
+++ b/src/frmOptions.inc.bak
@@ -0,0 +1,460 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmOptions.bi"
+#include once "frmOptionsGeneral.bi"
+#include once "frmOptionsEditor.bi"
+#include once "frmOptionsEditor2.bi"
+#include once "frmOptionsCompiler.bi"
+#include once "frmOptionsColors.bi"
+#include once "frmOptionsLocal.bi"
+#include once "frmOptionsKeywords.bi"
+#include once "frmOptionsKeywordsWinApi.bi"
+#include once "frmMain.bi"
+
+#include once "clsConfig.bi"
+
+
+' ========================================================================================
+' Save all options to the gConfig class
+' ========================================================================================
+private function frmOptions_SaveEditorOptions() as long
+
+ Dim HWnd As HWnd
+ Dim wText As WString * MAX_PATH
+
+ ' GENERAL OPTIONS
+ HWnd = HWND_FRMOPTIONSGENERAL
+ gConfig.MultipleInstances = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSGENERAL_CHKMULTIPLEINSTANCES) )
+ gConfig.CompileAutosave = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSGENERAL_CHKCOMPILEAUTOSAVE) )
+ gConfig.CloseFuncList = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSGENERAL_CHKCLOSEFUNCLIST) )
+ gConfig.AskExit = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSGENERAL_CHKASKEXIT) )
+ gConfig.RestoreSession = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSGENERAL_CHKRESTORESESSION) )
+ gConfig.CheckForUpdates = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSGENERAL_CHKUPDATES) )
+
+
+ ' EDITOR OPTIONS
+ HWnd = HWND_FRMOPTIONSEDITOR
+ gConfig.SyntaxHighlighting = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKSYNTAXHIGHLIGHTING) )
+ gConfig.LeftMargin = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKSHOWLEFTMARGIN) )
+ gConfig.FoldMargin = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKSHOWFOLDMARGIN) )
+ gConfig.ConfineCaret = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKCONFINECARET) )
+ gConfig.LineNumbering = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKLINENUMBERING) )
+ gConfig.HighlightCurrentLine = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKCURRENTLINE) )
+ gConfig.TabIndentSpaces = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKTABTOSPACES) )
+ gConfig.IndentGuides = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKINDENTGUIDES ) )
+ gConfig.RightEdge = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKSHOWRIGHTEDGE) )
+ gConfig.PositionMiddle = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_CHKPOSITIONMIDDLE) )
+
+ gConfig.RightEdgePosition = AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_TXTRIGHTEDGE) )
+ gConfig.TabSize = AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR_TXTTABSIZE) )
+ gConfig.KeywordCase = ComboBox_GetCurSel( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_COMBOCASE))
+
+ ' EDITOR OPTIONS2
+ HWnd = HWND_FRMOPTIONSEDITOR2
+ gConfig.Codetips = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR2_CHKCODETIPS) )
+ gConfig.AutoComplete = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR2_CHKAUTOCOMPLETE) )
+ gConfig.CharacterAutoComplete = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR2_CHKCHARAUTOCOMPLETE) )
+ gConfig.AutoIndentation = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR2_CHKAUTOINDENTATION) )
+ gConfig.ForNextVariable = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR2_CHKFORNEXTVARIABLE) )
+ gConfig.BraceHighlight = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR2_CHKBRACEHIGHLIGHT) )
+ gConfig.OccurrenceHighlight = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR2_CHKOCCURRENCEHIGHLIGHT) )
+
+
+ ' If a localization file is currently being edited then save it now.
+ frmOptionsLocal_LocalEditCheck
+
+ ' If the localization has changed then display a message indicating that the changes
+ ' will not be seen until the application is restarted.
+ HWnd = HWND_FRMOPTIONSLOCAL
+ wText = AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION) )
+ If (Ucase(wText) <> Ucase(gConfig.LocalizationFile)) orelse (gLocalPhrasesEdit = true) Then
+ MessageBox( HWND_FRMMAIN, _
+ L(108,"Localization changes will be applied the next time the application is run."), _
+ L(109,"Warning"), _
+ MB_OK Or MB_ICONINFORMATION Or MB_DEFBUTTON1 Or MB_APPLMODAL )
+ End If
+ gConfig.LocalizationFile = wText
+
+
+ ' THEME COLOR/FONT OPTIONS
+ HWnd = HWND_FRMOPTIONSCOLORS
+
+ Dim idx As Long
+ idx = ListBox_GetCurSel( GetDlgItem(HWnd, IDC_FRMOPTIONSCOLORS_LSTTHEMES) )
+ if idx >= lbound(gThemeFilenames) and idx <= ubound(gThemeFilenames) then
+ gConfig.ThemeFilename = gThemeFilenames(idx)
+ end if
+ idx = ComboBox_GetCurSel( GetDlgItem(HWnd, IDC_FRMOPTIONSCOLORS_COMBOFONTNAME) )
+ gConfig.EditorFontname = AfxGetComboBoxText( GetDlgItem(HWnd, IDC_FRMOPTIONSCOLORS_COMBOFONTNAME), idx )
+ idx = ComboBox_GetCurSel( GetDlgItem(HWnd, IDC_FRMOPTIONSCOLORS_COMBOFONTSIZE) )
+ gConfig.EditorFontSize = AfxGetComboBoxText( GetDlgItem(HWnd, IDC_FRMOPTIONSCOLORS_COMBOFONTSIZE), idx )
+ idx = ComboBox_GetCurSel( GetDlgItem(HWnd, IDC_FRMOPTIONSCOLORS_COMBOFONTCHARSET) )
+ gConfig.EditorFontCharSet = AfxGetComboBoxText( GetDlgItem(HWnd, IDC_FRMOPTIONSCOLORS_COMBOFONTCHARSET), idx )
+ gConfig.FontExtraSpace = AfxGetWindowText( GetDlgItem( HWnd, IDC_FRMOPTIONSCOLORS_TXTEXTRASPACE))
+
+
+ ' COMPILER OPTIONS
+ HWnd = HWND_FRMOPTIONSCOMPILER
+
+ ' Get the selected toolchain and then build the paths to the compilers
+ dim as CWSTR wszPath
+ idx = ListBox_GetCurSel( GetDlgItem(HWnd, IDC_FRMOPTIONSCOMPILER_LSTTOOLCHAINS) )
+ if idx <> -1 then
+ wszPath = AfxGetExePathName + "Toolchains\" + AfxGetListBoxText( GetDlgItem(HWnd, IDC_FRMOPTIONSCOMPILER_LSTTOOLCHAINS), idx )
+ gConfig.FBWINCompiler32 = wszPath + "\fbc32.exe"
+ gConfig.FBWINCompiler64 = wszPath + "\fbc64.exe"
+ end if
+ gConfig.CompilerSwitches = AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSCOMPILER_TXTFBSWITCHES) )
+ gConfig.CompilerHelpfile = AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSCOMPILER_TXTFBHELPFILE) )
+ gConfig.WinFBXHelpfile = AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSCOMPILER_TXTWINFBXHELPPATH) )
+ gConfig.RunViaCommandWindow = Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSCOMPILER_CHKRUNVIACOMMANDWINDOW) )
+ gConfig.DisableCompileBeep = Button_GetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSCOMPILER_CHKDISABLECOMPILEBEEP) )
+
+
+ ' KEYWORDS
+ If gConfig.bKeywordsDirty Then
+ Dim As HWnd hTextBox = GetDlgItem(HWND_FRMOPTIONSKEYWORDS, IDC_FRMOPTIONSKEYWORDS_TXTKEYWORDS)
+ gConfig.FBKeywords = AfxGetWindowText(hTextBox)
+ hTextBox = GetDlgItem(HWND_FRMOPTIONSKEYWORDSWINAPI, IDC_FRMOPTIONSKEYWORDSWINAPI_TXTKEYWORDS)
+ gConfig.WinApiKeywords = AfxGetWindowText(hTextBox)
+ gConfig.SaveKeywords
+ End If
+
+ ' Output the config settings to disk file
+ gConfig.SaveConfigFile
+
+ ' If Occurrences Highlighting is false then ensure that any highlights on the screen will be removed.
+ dim pDoc as clsDocument ptr
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ frmMain_HighlightWord( pDoc, "" )
+ end if
+
+ function = 0
+End function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmOptions
+' ========================================================================================
+Function frmOptions_OnCreate( _
+ ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmOptions
+' ========================================================================================
+Function frmOptions_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+
+ Case IDC_FRMOPTIONS_CMDOK
+ If codeNotify = BN_CLICKED Then
+ frmOptions_SaveEditorOptions()
+ ' Reload the theme file in case it has changed
+ LoadThemeFile()
+ ' Refresh the frmOutput controls (listviews and RichEdits)
+ AfxRedrawWindow( HWND_FRMOUTPUT )
+ frmOutput_SetControlColors()
+ frmOutput_PositionWindows()
+ ' Refresh the menubar. The rest of the GUI will refresh via frmMain_PositionWindows
+ AfxRedrawWindow( HWND_FRMMAIN_MENUBAR )
+ frmMenuBar_PositionWindows()
+
+ ' Reposition main windows in case hide toolbar/statusbar selected
+ frmMain_PositionWindows
+ ' Apply the newly saved options to all open Scintilla windows
+ dim pFrame as CWindow ptr
+ Dim pDoc As clsDocument Ptr = gApp.pDocList
+ do until pDoc = 0
+ pDoc->ApplyProperties
+ ' Ensure the grab handles of form and controls are redrawn or hidden
+ if IsWindow(pDoc->hWndFrame) then
+ pFrame = AfxCWindowPtr(pDoc->hWndFrame)
+ pFrame->Brush = ghDesigner.hPanelBrush
+ AfxRedrawWindow(pDoc->hWndFrame)
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_NOTIFY message for window/dialog: frmOptions
+' ========================================================================================
+Function frmOptions_OnNotify( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal pNMHDR As NMHDR Ptr _
+ ) As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+
+ Select Case id
+
+ Case IDC_FRMOPTIONS_TVWCATEGORIES
+ If pNMHDR->code = TVN_SELCHANGED Then
+ Dim As Long nLeft, nTop
+ Dim As HWnd hForm, hLabel
+
+ Static hCurrent As HWnd ' hwnd of currently display child Form
+
+ If hCurrent Then ShowWindow hCurrent, SW_HIDE
+
+ Dim lpNMTV As NM_TREEVIEW Ptr = Cast(NM_TREEVIEW Ptr, pNMHDR)
+ hLabel = GetDlgItem(HWnd, IDC_FRMOPTIONS_LBLCATEGORY)
+
+ ' Display the correct Category name and Child dialog. The child identifier is held in the lParam
+ dim as long nBranchNum = TreeView_GetlParam( pNMHDR->hWndFrom, lpNMTV->itemNew.hItem)
+ Select Case nBranchNum
+ Case 0
+ AfxSetWindowText( hLabel, " " & L(226,"General Options"))
+ hForm = HWND_FRMOPTIONSGENERAL
+ Case 1
+ AfxSetWindowText( hLabel, " " & L(110,"Code Editor"))
+ hForm = HWND_FRMOPTIONSEDITOR
+ Case 2
+ AfxSetWindowText( hLabel, " " & L(110,"Code Editor"))
+ hForm = HWND_FRMOPTIONSEDITOR2
+ Case 3
+ AfxSetWindowText( hLabel, " " & L(111,"Themes and Fonts") )
+ hForm = HWND_FRMOPTIONSCOLORS
+ Case 4
+ AfxSetWindowText( hLabel, " " & L(112,"Compiler Setup") )
+ hForm = HWND_FRMOPTIONSCOMPILER
+ Case 5
+ AfxSetWindowText( hLabel, " " & L(129,"Localization") )
+ hForm = HWND_FRMOPTIONSLOCAL
+ Case 6
+ AfxSetWindowText( hLabel, " " & L(177,"FreeBASIC Keywords") )
+ hForm = HWND_FRMOPTIONSKEYWORDS
+ Case 7
+ AfxSetWindowText( hLabel, " " & L(435,"Windows Api Keywords") )
+ hForm = HWND_FRMOPTIONSKEYWORDSWINAPI
+ End Select
+
+ ' Save the most recently opened tree branch
+ OptionsDialogLastOpened = nBranchNum
+
+
+ ' Move the child Form into place. The child form will be displayed under the header label.
+ Dim rc As Rect
+ GetWindowRect( hLabel, @rc )
+ MapWindowPoints( Null, HWnd, Cast(LPPOINT, @rc), 2 )
+ SetWindowPos hForm, HWND_TOP, _
+ rc.Left + pWindow->ScaleX(5), pWindow->ScaleY(50), _
+ pWindow->ScaleX(420), pWindow->ScaleY(350), _
+ SWP_SHOWWINDOW
+
+ InvalidateRect HWnd, ByVal Null, True
+ UpdateWindow HWnd
+
+ hCurrent = hForm
+ End If
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CTLCOLORSTATIC message for window/dialog: frmOptions
+' ========================================================================================
+Function frmOptions_OnCtlColorStatic( _
+ byval HWnd As HWnd, _
+ byval hdc As HDC, _
+ byval hWndChild As HWnd, _
+ byval nType As Long _
+ ) As HBRUSH
+
+ if hWndChild = GetDlgItem( HWnd, IDC_FRMOPTIONS_LBLCATEGORY ) then
+ ' Set the category label to blue text
+ SetTextColor hdc, 8388608
+ SetBkColor hdc, GetSysColor( COLOR_BTNFACE )
+ return GetSysColorBrush( COLOR_BTNFACE )
+ end if
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmOptions
+' ========================================================================================
+Function frmOptions_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow HWnd
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmOptions
+' ========================================================================================
+Function frmOptions_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ Dim As HFONT hFont = AfxGetWindowFont(GetDlgItem(HWnd, IDC_FRMOPTIONS_LBLCATEGORY))
+ DeleteFont(hFont)
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmOptions Window procedure
+' ========================================================================================
+Function frmOptions_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmOptions_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmOptions_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmOptions_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmOptions_OnCommand)
+ HANDLE_MSG (HWnd, WM_NOTIFY, frmOptions_OnNotify)
+ HANDLE_MSG (HWnd, WM_CTLCOLORSTATIC, frmOptions_OnCtlColorStatic)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmOptions_Show
+' ========================================================================================
+public Function frmOptions_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ pWindow->Create( hWndParent, L(113,"Environment Options"), @frmOptions_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT )
+ pWindow->SetClientSize(625, 460)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ Dim As HWnd hLabel = _
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONS_LBLCATEGORY, "Category", 216, 10, 400, 30, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_CENTERIMAGE Or SS_NOTIFY Or SS_SUNKEN, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ Dim As HFONT hFont = pWindow->CreateFont("", 12, FW_BOLD)
+ AfxSetWindowFont hLabel, hFont, True
+
+ Dim As HWnd hWndTreeview = _
+ pWindow->AddControl("TREEVIEW", , IDC_FRMOPTIONS_TVWCATEGORIES, "", 10, 10, 200, 385, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or TVS_HASBUTTONS Or TVS_HASLINES Or TVS_LINESATROOT Or TVS_SHOWSELALWAYS, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONS_LABEL1, "", 8, 405, 600, 2, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY Or SS_SUNKEN, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMOPTIONS_CMDOK, L(0,"&OK"), 450, 417, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_DEFPUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(1,"&Cancel"), 535, 417, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ ' Reload the config file in case a user has automated a change to it since
+ ' the application started (for example, changing the compiler path).
+ gConfig.LoadConfigFile()
+
+ ' Configure the TreeView
+ Dim hItems(7) As HTREEITEM
+ hItems(0) = TreeView_AppendItem (hWndTreeview, TVI_ROOT, L(226,"General Options"), 0)
+ hItems(1) = TreeView_AppendItem (hWndTreeview, TVI_ROOT, L(110,"Code Editor"), 1)
+ hItems(2) = TreeView_AppendItem (hWndTreeview, TVI_ROOT, L(110,"Code Editor"), 2)
+ hItems(3) = TreeView_AppendItem (hWndTreeview, TVI_ROOT, L(111,"Colors and Fonts"), 3)
+ hItems(4) = TreeView_AppendItem (hWndTreeview, TVI_ROOT, L(112,"Compiler Setup"), 4)
+ hItems(5) = TreeView_AppendItem (hWndTreeview, TVI_ROOT, L(129,"Localization"), 5)
+ hItems(6) = TreeView_AppendItem (hWndTreeview, TVI_ROOT, L(177,"FreeBASIC Keywords"), 6)
+ hItems(7) = TreeView_AppendItem (hWndTreeview, TVI_ROOT, L(435,"Windows API Keywords"), 7)
+
+ ' Load all of the child dialogs
+ frmOptionsGeneral_Show( pWindow->hWindow )
+ frmOptionsEditor_Show( pWindow->hWindow )
+ frmOptionsEditor2_Show( pWindow->hWindow )
+ frmOptionsColors_Show( pWindow->hWindow )
+ frmOptionsCompiler_Show( pWindow->hWindow )
+ frmOptionsLocal_Show( pWindow->hWindow )
+ frmOptionsKeywords_Show( pWindow->hWindow )
+ frmOptionsKeywordsWinApi_Show( pWindow->hWindow )
+
+ ' Select the most previously open tree branch or first item "Code Editor" by default.
+ TreeView_SelectItem( hWndTreeview, hItems(OptionsDialogLastOpened) )
+
+ SetFocus hWndTreeview
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the frmOptions CWindow class manually allocated memory
+ Delete pWindow
+
+ ' Delete the child windows releasing their manually allocated memory
+ pWindow = AfxCWindowPtr(HWND_FRMOPTIONSGENERAL): Delete pWindow
+ pWindow = AfxCWindowPtr(HWND_FRMOPTIONSEDITOR): Delete pWindow
+ pWindow = AfxCWindowPtr(HWND_FRMOPTIONSEDITOR2): Delete pWindow
+ pWindow = AfxCWindowPtr(HWND_FRMOPTIONSCOLORS): Delete pWindow
+ pWindow = AfxCWindowPtr(HWND_FRMOPTIONSCOMPILER): Delete pWindow
+ pWindow = AfxCWindowPtr(HWND_FRMOPTIONSLOCAL): Delete pWindow
+ pWindow = AfxCWindowPtr(HWND_FRMOPTIONSKEYWORDS): Delete pWindow
+ pWindow = AfxCWindowPtr(HWND_FRMOPTIONSKEYWORDSWINAPI): Delete pWindow
+
+End Function
+
+
+
+
+
diff --git a/src/frmOptionsColors.bi b/src/frmOptionsColors.bi
index 3e5ee860..8c9988a6 100644
--- a/src/frmOptionsColors.bi
+++ b/src/frmOptionsColors.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsColors.bi.bak b/src/frmOptionsColors.bi.bak
new file mode 100644
index 00000000..3e5ee860
--- /dev/null
+++ b/src/frmOptionsColors.bi.bak
@@ -0,0 +1,26 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMOPTIONSCOLORS_FRMCOLORS 1001
+#Define IDC_FRMOPTIONSCOLORS_LSTTHEMES 1002
+#Define IDC_FRMOPTIONSCOLORS_LBLTHEMES 1003
+#Define IDC_FRMOPTIONSCOLORS_FRMFONT 1004
+#Define IDC_FRMOPTIONSCOLORS_COMBOFONTNAME 1007
+#Define IDC_FRMOPTIONSCOLORS_COMBOFONTCHARSET 1008
+#Define IDC_FRMOPTIONSCOLORS_COMBOFONTSIZE 1009
+#Define IDC_FRMOPTIONSCOLORS_LBLEXTRASPACE 1015
+#Define IDC_FRMOPTIONSCOLORS_TXTEXTRASPACE 1016
+
+declare Function frmOptionsColors_Show( ByVal hWndParent As HWnd ) as LRESULT
diff --git a/src/frmOptionsColors.inc b/src/frmOptionsColors.inc
index af4ada21..19c826b8 100644
--- a/src/frmOptionsColors.inc
+++ b/src/frmOptionsColors.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsColors.inc.bak b/src/frmOptionsColors.inc.bak
new file mode 100644
index 00000000..af4ada21
--- /dev/null
+++ b/src/frmOptionsColors.inc.bak
@@ -0,0 +1,358 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmOptionsColors.bi"
+#include once "clsConfig.bi"
+
+
+' ========================================================================================
+' Enumerate the names of all the fonts. Note the difference between how to enumerate them
+' (%TMPF_FIXED_PITCH has the bit cleared).
+' %TMPF_FIXED_PITCH for fixed pitch fonts (like in PB edit)
+' %TMPF_TRUETYPE OR %TMPF_VECTOR for True type and vector fonts
+' %TMPF_DEVICE for device fonts (like printer fonts)
+' Exclude what you don't want to include in list.
+' ========================================================================================
+Function frmOptionsColors_EnumFontName( _
+ byref lf As LOGFONTW, _
+ byref tm As TEXTMETRIC, _
+ ByVal FontType As Long, _
+ HWnd As HWnd _
+ ) As Long
+
+ static wszPrevText as CWSTR
+ if gApp.isWineActive then
+ ' Wine doesn't display the WYSIWYG version of the font. It will just be duplicate names
+ ' so ensure that only one version of the font name displays.
+ if lf.lfFaceName = wszPrevText then return true
+ wszPrevText = lf.lfFaceName
+ end if
+
+ If (FontType And TRUETYPE_FONTTYPE) Then ' // True type fonts
+ ComboBox_AddString( HWnd, @lf.lfFaceName )
+ ElseIf (FontType And TMPF_FIXED_PITCH) = 0 Then ' <- check if bit is cleared!
+ ComboBox_AddString( HWnd, @lf.lfFaceName ) ' // fixed pitch fonts
+ ElseIf (FontType And TMPF_VECTOR) Then
+ ComboBox_AddString( HWnd, @lf.lfFaceName ) ' // vector fonts
+ ElseIf (FontType And TMPF_DEVICE) Then
+ ComboBox_AddString( HWnd, @lf.lfFaceName ) ' // device fonts
+ Else
+ ComboBox_AddString( HWnd, @lf.lfFaceName ) ' // system, others
+ End If
+
+ Function = True
+
+End Function
+
+
+' ========================================================================================
+' Fill combobox with list of valid font names
+' ========================================================================================
+function frmOptionsColors_FillFontCombo( ByVal HWnd As HWnd ) as long
+ Dim hDC As HDC = GetDC(0)
+ SendMessage( HWnd, CB_RESETCONTENT, 0, 0)
+ EnumFontFamilies hDC, ByVal 0, Cast(FONTENUMPROCW, @frmOptionsColors_EnumFontName), Cast(LPARAM, HWnd)
+ ReleaseDC 0, hDC
+ function = 0
+End function
+
+
+' ========================================================================================
+' WM_DRAWITEM procedure
+' ========================================================================================
+Function frmOptionsColors_DrawFontCombo( _
+ ByVal HWnd As HWnd, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As Long
+
+ Dim hFont As HFONT
+ Dim lpdis As DRAWITEMSTRUCT Ptr
+ Dim wText As WString * MAX_PATH
+ Dim wPrevText As WString * MAX_PATH
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN)
+
+ lpdis = Cast(DRAWITEMSTRUCT Ptr, lParam)
+ If lpdis->itemID = &HFFFFFFFF Then Exit Function ' empty list, take a break..
+
+ Select Case lpdis->itemAction
+ Case ODA_DRAWENTIRE, ODA_SELECT
+ ' If not selected or if in edit part of the combobox
+ If (lpdis->itemState And ODS_SELECTED) = 0 Or _
+ (lpdis->itemState And ODS_COMBOBOXEDIT) Then
+ SetBkColor lpdis->hDC, GetSysColor(COLOR_WINDOW)
+ SetTextColor lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT)
+ FillRect lpdis->hDC, @lpdis->rcItem, GetSysColorBrush(COLOR_WINDOW)
+ Else
+ ' Select text background
+ SetBkColor lpdis->hDC, GetSysColor(COLOR_HIGHLIGHT)
+ SetTextColor lpdis->hDC, GetSysColor(COLOR_HIGHLIGHTTEXT)
+ FillRect lpdis->hDC, @lpdis->rcItem, GetSysColorBrush(COLOR_HIGHLIGHT)
+ End If
+
+ ' Get item's text (fontname), create font and draw text
+ wText = AfxGetComboBoxText(HWnd, lpdis->itemID)
+ If Len(wText) Then
+ if gApp.isWineActive then
+ SelectObject(lpdis->hDC, pWindow->Font)
+ else
+ hFont = pWindow->CreateFont( wText, 10 )
+ If hFont Then hFont = SelectObject(lpdis->hDC, hFont)
+ end if
+ End If
+ DrawTextW lpdis->hDC, @wText, Len(wText), @lpdis->rcItem, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER
+ If hFont Then DeleteObject SelectObject(lpdis->hDC, hFont)
+
+ ' Focus rect around selected item
+ If (lpdis->itemState And ODS_SELECTED) Then
+ DrawFocusRect lpdis->hDC, @lpdis->rcItem
+ End If
+ Function = True
+
+ End Select
+
+End Function
+
+
+' ========================================================================================
+' Fill combobox with list of valid font sizes
+' ========================================================================================
+function frmOptionsColors_FillFontSizeCombo( _
+ ByVal hCb As HWnd, _
+ ByVal strFontName As WString Ptr _
+ ) as long
+
+ Select Case Ucase(*strFontName)
+ Case "FIXEDSYS"
+ ComboBox_ResetContent(hCb)
+ ComboBox_AddString( hCb, @WStr("9"))
+ Case "TERMINAL"
+ ComboBox_ResetContent(hCb)
+ ComboBox_AddString( hCb, @WStr("5" ))
+ ComboBox_AddString( hCb, @WStr("6" ))
+ ComboBox_AddString( hCb, @WStr("12"))
+ ComboBox_AddString( hCb, @WStr("14"))
+ Case Else
+ ComboBox_ResetContent(hCb)
+ ComboBox_AddString( hCb, @WStr("8" ))
+ ComboBox_AddString( hCb, @WStr("9" ))
+ ComboBox_AddString( hCb, @WStr("10"))
+ ComboBox_AddString( hCb, @WStr("11"))
+ ComboBox_AddString( hCb, @WStr("12"))
+ ComboBox_AddString( hCb, @WStr("14"))
+ ComboBox_AddString( hCb, @WStr("16"))
+ ComboBox_AddString( hCb, @WStr("18"))
+ ComboBox_AddString( hCb, @WStr("20"))
+ ComboBox_AddString( hCb, @WStr("22"))
+ ComboBox_AddString( hCb, @WStr("24"))
+ ComboBox_AddString( hCb, @WStr("26"))
+ ComboBox_AddString( hCb, @WStr("28"))
+ ComboBox_AddString( hCb, @WStr("32"))
+ ComboBox_AddString( hCb, @WStr("36"))
+ End Select
+
+ function = 0
+End function
+
+
+' ========================================================================================
+' Fill combobox with list of valid character sets
+' ========================================================================================
+function frmOptionsColors_FillFontCharSets( ByVal hCtl As HWnd ) as long
+ ComboBox_AddString( hCtl, @WStr("Default") )
+ ComboBox_AddString( hCtl, @WStr("Ansi") )
+ ComboBox_AddString( hCtl, @WStr("Arabic") )
+ ComboBox_AddString( hCtl, @WStr("Baltic") )
+ ComboBox_AddString( hCtl, @WStr("Chinese Big 5") )
+ ComboBox_AddString( hCtl, @WStr("East Europe") )
+ ComboBox_AddString( hCtl, @WStr("GB 2312") )
+ ComboBox_AddString( hCtl, @WStr("Greek") )
+ ComboBox_AddString( hCtl, @WStr("Hangul") )
+ ComboBox_AddString( hCtl, @WStr("Hebrew") )
+ ComboBox_AddString( hCtl, @WStr("Johab") )
+ ComboBox_AddString( hCtl, @WStr("Mac") )
+ ComboBox_AddString( hCtl, @WStr("OEM") )
+ ComboBox_AddString( hCtl, @WStr("Russian") )
+ ComboBox_AddString( hCtl, @WStr("Shiftjis") )
+ ComboBox_AddString( hCtl, @WStr("Symbol") )
+ ComboBox_AddString( hCtl, @WStr("Thai") )
+ ComboBox_AddString( hCtl, @WStr("Turkish") )
+ ComboBox_AddString( hCtl, @WStr("Vietnamese") )
+
+ function = 0
+End function
+
+
+' ========================================================================================
+' frmOptionsColors Window procedure
+' ========================================================================================
+Function frmOptionsColors_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+
+ Case WM_MEASUREITEM
+ If wParam = IDC_FRMOPTIONSCOLORS_COMBOFONTNAME Then
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ Dim pMeasureItem As MEASUREITEMSTRUCT Ptr = Cast(MEASUREITEMSTRUCT Ptr, lParam)
+ pMeasureItem->itemHeight = pWindow->ScaleY(pMeasureItem->itemHeight)
+ Return True
+ End If
+
+ Case WM_DRAWITEM ' must pass this one on to ownerdrawn combo
+ If (wParam = IDC_FRMOPTIONSCOLORS_COMBOFONTNAME) Then
+ frmOptionsColors_DrawFontCombo( GetDlgItem(HWnd, IDC_FRMOPTIONSCOLORS_COMBOFONTNAME), wParam, lParam )
+ Return True
+ End If
+
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' GetThemeDescription
+' ========================================================================================
+function GetThemeDescription( byval wszFilename as CWSTR ) as string
+ ' default to the theme description being the filename
+ function = AfxGetFileName(wszFilename)
+
+ dim pStream AS CTextStream
+ if pStream.Open(wszFilename) <> S_OK then exit function 'error
+
+ dim as CWSTR wst, keyValue, keyData
+
+ Do Until pStream.EOS
+ wst = pStream.ReadLine
+
+ wst = trim(AfxStrExtract( 1, wst, "#")) ' remove comments
+ If Len(wst) = 0 Then Continue Do
+
+ keyValue = trim(AfxStrParse(wst, 1, ":"))
+ keyData = trim(AfxStrParse(wst, 2, ":"))
+
+ ' is this a replaceable parameter
+ if keyValue = "general.description" then
+ function = keyData
+ exit do
+ end if
+
+ loop
+
+ pStream.Close
+
+end function
+
+
+' ========================================================================================
+' frmOptionsColors_Show
+' ========================================================================================
+Function frmOptionsColors_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMOPTIONSCOLORS = pWindow->Create( hWndParent, "", @frmOptionsColors_WndProc, 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ ' Height and width of this child form is set in frmOptions_OnNotify when the treeview option is selected.
+
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONSCOLORS_LBLTHEMES, _
+ L(422,"Themes") & ":", 0, 2, 375, 15, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ dim as HWND hListBox = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMOPTIONSCOLORS_LSTTHEMES, "", 0, 20, 386, 220, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or LBS_NOINTEGRALHEIGHT, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("GROUPBOX",, IDC_FRMOPTIONSCOLORS_FRMFONT, L(136,"Font (applies to all styles)"), 0, 266, 385, 80, _
+ WS_CHILD Or WS_VISIBLE Or BS_TEXT Or BS_LEFT Or BS_NOTIFY Or BS_GROUPBOX, _
+ WS_EX_TRANSPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING)
+ Dim As HWnd hComboFontname = _
+ pWindow->AddControl("COMBOBOX", , IDC_FRMOPTIONSCOLORS_COMBOFONTNAME, "", 11, 286, 310, 23, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST Or CBS_OWNERDRAWFIXED Or CBS_HASSTRINGS Or CBS_SORT, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ Dim As HWnd hComboFontSize = _
+ pWindow->AddControl("COMBOBOX", , IDC_FRMOPTIONSCOLORS_COMBOFONTSIZE, "", 330, 286, 40, 23, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ Dim As HWnd hComboFontCharSet = _
+ pWindow->AddControl("COMBOBOX", , IDC_FRMOPTIONSCOLORS_COMBOFONTCHARSET, "", 11, 318, 150, 23, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("LABEL",, IDC_FRMOPTIONSCOLORS_LBLEXTRASPACE, L(421,"Extra line spacing") & ":", 170, 320, 140, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMOPTIONSCOLORS_TXTEXTRASPACE, "0", 330, 318, 40, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ AfxSetWindowText( GetDlgItem( HWND_FRMOPTIONSCOLORS, IDC_FRMOPTIONSCOLORS_TXTEXTRASPACE), gConfig.FontExtraSpace)
+
+ frmOptionsColors_FillFontCombo( hComboFontName )
+ frmOptionsColors_FillFontSizeCombo( hComboFontSize, gConfig.EditorFontname )
+ frmOptionsColors_FillFontCharSets( hComboFontCharSet )
+
+ Dim idx As Long
+ idx = SendMessage( hComboFontName, CB_FINDSTRING, 0, Cast(LPARAM, *gConfig.EditorFontname))
+ ComboBox_SetCurSel( hComboFontName, idx )
+ idx = SendMessage( hComboFontSize, CB_FINDSTRING, 0, Cast(LPARAM, *gConfig.EditorFontSize))
+ ComboBox_SetCurSel( hComboFontSize, idx )
+ idx = SendMessage( hComboFontCharSet, CB_FINDSTRING, 0, Cast(LPARAM, *gConfig.EditorFontCharSet))
+ ComboBox_SetCurSel( hComboFontCharSet, idx )
+
+ ' Load the Themes listbox
+ DIM hSearch as HANDLE
+ dim WFD AS WIN32_FIND_DATAW
+ DIM wszPath AS WSTRING * MAX_PATH
+ dim wszCurPath AS WSTRING * MAX_PATH
+ dim wszFullPath AS WSTRING * (MAX_PATH * 2)
+ dim wszDisplayName AS WSTRING * (MAX_PATH * 2)
+ dim as long idxMatch = -1
+
+ wszPath = AfxGetExePathName + "themes\"
+ wszCurPath = wszPath + "*"
+
+ erase gThemeFilenames
+
+ idx = 0
+ hSearch = FindFirstFile( wszCurPath, @WFD )
+ IF hSearch <> INVALID_HANDLE_VALUE THEN
+ DO
+ if (WFD.cFileName <> ".") andalso (WFD.cFileName <> "..") then
+ wszFullPath = wszPath & WFD.cFileName
+ wszDisplayName = GetThemeDescription(wszFullPath)
+ idx = SendMessage( hListBox, LB_ADDSTRING, 0, cast(LPARAM, @wszDisplayName) )
+ redim preserve gThemeFilenames(idx) as CWSTR
+ gThemeFilenames(idx) = WFD.cFileName
+ if ucase(gConfig.ThemeFilename) = ucase(WFD.cFileName ) then
+ idxMatch = idx
+ end if
+ end if
+ LOOP WHILE FindNextFile( hSearch, @WFD )
+ FindClose( hSearch )
+ END IF
+ SendMessage( hListBox, LB_SETCURSEL, idxMatch, 0 )
+
+ Function = 0
+End Function
diff --git a/src/frmOptionsCompiler.bi b/src/frmOptionsCompiler.bi
index d47d2770..653e7339 100644
--- a/src/frmOptionsCompiler.bi
+++ b/src/frmOptionsCompiler.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsCompiler.bi.bak b/src/frmOptionsCompiler.bi.bak
new file mode 100644
index 00000000..d47d2770
--- /dev/null
+++ b/src/frmOptionsCompiler.bi.bak
@@ -0,0 +1,29 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMOPTIONSCOMPILER_LBLSWITCHES 1001
+#Define IDC_FRMOPTIONSCOMPILER_TXTFBSWITCHES 1002
+#Define IDC_FRMOPTIONSCOMPILER_LBLFBHELP 1003
+#Define IDC_FRMOPTIONSCOMPILER_TXTFBHELPFILE 1004
+#Define IDC_FRMOPTIONSCOMPILER_CMDFBHELPFILE 1005
+#Define IDC_FRMOPTIONSCOMPILER_CHKRUNVIACOMMANDWINDOW 1006
+#Define IDC_FRMOPTIONSCOMPILER_CMDWINFBXHELPPATH 1007
+#Define IDC_FRMOPTIONSCOMPILER_LBLWINFBXHELP 1008
+#Define IDC_FRMOPTIONSCOMPILER_TXTWINFBXHELPPATH 1009
+#Define IDC_FRMOPTIONSCOMPILER_CHKDISABLECOMPILEBEEP 1010
+#Define IDC_FRMOPTIONSCOMPILER_LBLTOOLCHAINS 1011
+#Define IDC_FRMOPTIONSCOMPILER_LSTTOOLCHAINS 1012
+
+declare Function frmOptionsCompiler_Show( ByVal hWndParent As HWnd ) as LRESULT
diff --git a/src/frmOptionsCompiler.inc b/src/frmOptionsCompiler.inc
index cf6e702f..669de184 100644
--- a/src/frmOptionsCompiler.inc
+++ b/src/frmOptionsCompiler.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsCompiler.inc.bak b/src/frmOptionsCompiler.inc.bak
new file mode 100644
index 00000000..cf6e702f
--- /dev/null
+++ b/src/frmOptionsCompiler.inc.bak
@@ -0,0 +1,170 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmOptionsCompiler.bi"
+#include once "clsConfig.bi"
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmOptionsCompiler
+' ========================================================================================
+private Function frmOptionsCompiler_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+
+ case IDC_FRMOPTIONSCOMPILER_CMDFBHELPFILE, IDC_FRMOPTIONSCOMPILER_CMDWINFBXHELPPATH
+
+ If codeNotify = BN_CLICKED Then
+ ' Display the Open File Dialog
+ Dim pwszName As WString Ptr = AfxIFileOpenDialogW(HWnd, id)
+ If pwszName Then
+ If id = IDC_FRMOPTIONSCOMPILER_CMDFBHELPFILE Then SetWindowTextW( GetDlgItem(HWnd, IDC_FRMOPTIONSCOMPILER_TXTFBHELPFILE), pwszName )
+ If id = IDC_FRMOPTIONSCOMPILER_CMDWINFBXHELPPATH Then SetWindowTextW( GetDlgItem(HWnd, IDC_FRMOPTIONSCOMPILER_TXTWINFBXHELPPATH), pwszName )
+ CoTaskMemFree pwszName
+ End If
+ Exit Function
+ End If
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmOptionsCompiler Window procedure
+' ========================================================================================
+private Function frmOptionsCompiler_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_COMMAND, frmOptionsCompiler_OnCommand)
+ End Select
+
+ Function = DefWindowProcW(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmOptionsCompiler_Show
+' ========================================================================================
+public Function frmOptionsCompiler_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMOPTIONSCOMPILER = pWindow->Create( hWndParent, "", @frmOptionsCompiler_WndProc, 0, 0, 0, 0, _
+ WS_CHILD, WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ ' Height and width of this child form is set in frmOptions_OnNotify when the treeview option is selected.
+
+
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONSCOMPILER_LBLTOOLCHAINS, _
+ L(420,"Toolchains") & ":", 0, 2, 375, 15, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ dim as HWND hListBox = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMOPTIONSCOMPILER_LSTTOOLCHAINS, "", 0, 20, 386, 124, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or LBS_NOINTEGRALHEIGHT, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONSCOMPILER_LBLSWITCHES, _
+ L(153,"Additional compiler option switches (optional)" & ":"), 0, 148, 375, 16, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMOPTIONSCOMPILER_TXTFBSWITCHES, "", 0, 167, 386, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSCOMPILER_CHKRUNVIACOMMANDWINDOW, _
+ L(273,"Run compiled programs using command window"), 0, 195, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSCOMPILER_CHKDISABLECOMPILEBEEP, _
+ L(413,"Disable successful compile sound"), 0, 216, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONSCOMPILER_LBLFBHELP, _
+ L(155,"FreeBASIC Help file (*.chm)") & ":", 0, 300, 375, 18, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMOPTIONSCOMPILER_TXTFBHELPFILE, "", 0, 320, 356, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("BUTTON", , IDC_FRMOPTIONSCOMPILER_CMDFBHELPFILE, "...", 362, 320, 24, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ gConfig.FBWINCompiler32 = ProcessFromCurdriveApp(gConfig.FBWINCompiler32)
+ gConfig.FBWINCompiler64 = ProcessFromCurdriveApp(gConfig.FBWINCompiler64)
+ gConfig.CompilerHelpfile = ProcessFromCurdriveApp(gConfig.CompilerHelpfile)
+ gConfig.WinFBXHelpfile = ProcessFromCurdriveApp(gConfig.WinFBXHelpfile)
+
+ ' Load the Toolchain listbox
+ DIM hSearch as HANDLE
+ dim WFD AS WIN32_FIND_DATAW
+ DIM wszPath AS WSTRING * MAX_PATH
+ dim wszCurPath AS WSTRING * MAX_PATH
+ dim wszFullPath AS WSTRING * (MAX_PATH * 2)
+ dim wszDisplayName AS WSTRING * (MAX_PATH * 2)
+ dim as long nCount = 0
+ dim as long idx = 0
+ dim as long idxMatch = -1
+
+ wszPath = AfxGetExePathName + "toolchains\"
+ wszCurPath = wszPath + "*"
+
+ hSearch = FindFirstFile( wszCurPath, @WFD )
+ IF hSearch <> INVALID_HANDLE_VALUE THEN
+ DO
+ IF (WFD.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY THEN
+ if (WFD.cFileName <> ".") andalso (WFD.cFileName <> "..") then
+ wszFullPath = ucase( wszPath & WFD.cFileName & "\fbc32.exe" )
+
+ ' Do check to see if path contains spaces as we will have to warn the user to fix it
+ wszDisplayName = WFD.cFileName
+ if instr( wszFullPath, " " ) then
+ wszDisplayName = wszDisplayName & " (Warning: File path contains spaces)"
+ end if
+
+ idx = SendMessage( hListBox, LB_ADDSTRING, 0, cast(LPARAM, @wszDisplayName) )
+ if ucase(gConfig.FBWINCompiler32) = wszFullPath then
+ idxMatch = idx
+ end if
+
+ end if
+ END IF
+ LOOP WHILE FindNextFile( hSearch, @WFD )
+ FindClose( hSearch )
+ END IF
+ SendMessage( hListBox, LB_SETCURSEL, idxMatch, 0 )
+
+ Dim As HWnd HWnd = HWND_FRMOPTIONSCOMPILER
+ AfxSetWindowText( GetDlgItem( HWnd, IDC_FRMOPTIONSCOMPILER_TXTFBSWITCHES), gConfig.CompilerSwitches)
+ AfxSetWindowText( GetDlgItem( HWnd, IDC_FRMOPTIONSCOMPILER_TXTFBHELPFILE), gConfig.CompilerHelpfile)
+ AfxSetWindowText( GetDlgItem( HWnd, IDC_FRMOPTIONSCOMPILER_TXTWINFBXHELPPATH), gConfig.WinFBXHelpfile)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSCOMPILER_CHKRUNVIACOMMANDWINDOW), gConfig.RunViaCommandWindow)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSCOMPILER_CHKDISABLECOMPILEBEEP), gConfig.DisableCompileBeep)
+
+ Function = 0
+End Function
diff --git a/src/frmOptionsEditor.bi b/src/frmOptionsEditor.bi
index c5aa6b90..69b2675a 100644
--- a/src/frmOptionsEditor.bi
+++ b/src/frmOptionsEditor.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsEditor.bi.bak b/src/frmOptionsEditor.bi.bak
new file mode 100644
index 00000000..c5aa6b90
--- /dev/null
+++ b/src/frmOptionsEditor.bi.bak
@@ -0,0 +1,35 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMOPTIONSEDITOR_LBLTABSIZE 1000
+#Define IDC_FRMOPTIONSEDITOR_TXTTABSIZE 1001
+#Define IDC_FRMOPTIONSEDITOR_LBLKEYWORDCASE 1002
+#Define IDC_FRMOPTIONSEDITOR_COMBOCASE 1003
+#Define IDC_FRMOPTIONSEDITOR_CHKSHOWLEFTMARGIN 1004
+#Define IDC_FRMOPTIONSEDITOR_CHKSYNTAXHIGHLIGHTING 1005
+#Define IDC_FRMOPTIONSEDITOR_CHKCURRENTLINE 1006
+#Define IDC_FRMOPTIONSEDITOR_CHKLINENUMBERING 1007
+#Define IDC_FRMOPTIONSEDITOR_CHKCONFINECARET 1008
+#Define IDC_FRMOPTIONSEDITOR_CHKTABTOSPACES 1009
+#Define IDC_FRMOPTIONSEDITOR_CHKSHOWFOLDMARGIN 1010
+#Define IDC_FRMOPTIONSEDITOR_CHKINDENTGUIDES 1011
+#Define IDC_FRMOPTIONSEDITOR_CHKSHOWRIGHTEDGE 1012
+#Define IDC_FRMOPTIONSEDITOR_TXTRIGHTEDGE 1013
+#Define IDC_FRMOPTIONSEDITOR_LBLRIGHTEDGE 1014
+#Define IDC_FRMOPTIONSEDITOR_CHKPOSITIONMIDDLE 1015
+
+declare Function frmOptionsEditor_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+
diff --git a/src/frmOptionsEditor.inc b/src/frmOptionsEditor.inc
index 25bf3523..b1b7610d 100644
--- a/src/frmOptionsEditor.inc
+++ b/src/frmOptionsEditor.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsEditor.inc.bak b/src/frmOptionsEditor.inc.bak
new file mode 100644
index 00000000..25bf3523
--- /dev/null
+++ b/src/frmOptionsEditor.inc.bak
@@ -0,0 +1,128 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include "frmOptionsEditor.bi"
+#include "clsConfig.bi"
+
+
+' ========================================================================================
+' frmOptionsEditor Window procedure
+' ========================================================================================
+private Function frmOptionsEditor_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmOptionsEditor_Show
+' ========================================================================================
+public Function frmOptionsEditor_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMOPTIONSEDITOR = pWindow->Create( hWndParent, "", @frmOptionsEditor_WndProc, 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ ' Height and width of this child form is set in frmOptions_OnNotify when the treeview option is selected.
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKSYNTAXHIGHLIGHTING, L(114,"Syntax highlighting"), 0, 0, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKCONFINECARET, L(116,"Confine caret to text"), 0, 21, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKCURRENTLINE, L(117,"Highlight current line"), 0, 42, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKTABTOSPACES, L(118,"Treat Tab as spaces"), 0, 63, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKSHOWLEFTMARGIN, L(122,"Show left margin"), 0, 84, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKSHOWFOLDMARGIN, L(123,"Show fold margin"), 0, 105, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKLINENUMBERING, L(124,"Show line numbers"), 0, 126, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKINDENTGUIDES, L(125,"Show Indentation guides"), 0, 147, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKSHOWRIGHTEDGE, L(306,"Show right edge column"), 0, 168, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMOPTIONSEDITOR_TXTRIGHTEDGE, "", 50, 189, 30, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL Or ES_NUMBER, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONSEDITOR_LBLRIGHTEDGE, L(307,"Position"), 85, 192, 100, 17, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR_CHKPOSITIONMIDDLE, L(407,"Position searches to middle of screen"), 0, 213, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("TEXTBOX", , IDC_FRMOPTIONSEDITOR_TXTTABSIZE, "", 0, 318, 30, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL Or ES_NUMBER, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMOPTIONSEDITOR_COMBOCASE, "", 230, 319, 157, 22, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONSEDITOR_LBLTABSIZE, L(127,"Tab Size") & ":", 36, 323, 100, 17, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONSEDITOR_LBLKEYWORDCASE, L(128,"Case") & ":", 120, 323, 100, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ Dim As Long idx = 0
+ Dim As HWnd HWnd = HWND_FRMOPTIONSEDITOR
+
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKSYNTAXHIGHLIGHTING), gConfig.SyntaxHighlighting)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKSHOWLEFTMARGIN), gConfig.LeftMargin)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKSHOWFOLDMARGIN), gConfig.FoldMargin)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKCONFINECARET), gConfig.ConfineCaret)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKLINENUMBERING), gConfig.LineNumbering)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKINDENTGUIDES), gConfig.IndentGuides)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKCURRENTLINE), gConfig.HighlightCurrentLine)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKTABTOSPACES), gConfig.TabIndentSpaces)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKSHOWRIGHTEDGE), gConfig.RightEdge)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_CHKPOSITIONMIDDLE), gConfig.PositionMiddle)
+
+ AfxSetWindowText( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_TXTRIGHTEDGE), gConfig.RightEdgePosition )
+ AfxSetWindowText( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_TXTTABSIZE), gConfig.TabSize )
+
+ ComboBox_AddString( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_COMBOCASE), @L(130,"Lower Case") )
+ ComboBox_AddString( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_COMBOCASE), @L(131,"Upper Case") )
+ ComboBox_AddString( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_COMBOCASE), @L(272,"Mixed Case") )
+ ComboBox_AddString( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_COMBOCASE), @L(132,"Original Case") )
+ ComboBox_SetCurSel( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR_COMBOCASE), gConfig.KeywordCase )
+
+ Function = 0
+
+End Function
+
+
+
diff --git a/src/frmOptionsEditor2.bi b/src/frmOptionsEditor2.bi
index 18dbd1de..ad62bd16 100644
--- a/src/frmOptionsEditor2.bi
+++ b/src/frmOptionsEditor2.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsEditor2.bi.bak b/src/frmOptionsEditor2.bi.bak
new file mode 100644
index 00000000..18dbd1de
--- /dev/null
+++ b/src/frmOptionsEditor2.bi.bak
@@ -0,0 +1,26 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMOPTIONSEDITOR2_CHKCODETIPS 1000
+#Define IDC_FRMOPTIONSEDITOR2_CHKAUTOCOMPLETE 1001
+#Define IDC_FRMOPTIONSEDITOR2_CHKAUTOINDENTATION 1002
+#Define IDC_FRMOPTIONSEDITOR2_CHKCHARAUTOCOMPLETE 1003
+#Define IDC_FRMOPTIONSEDITOR2_CHKFORNEXTVARIABLE 1004
+#Define IDC_FRMOPTIONSEDITOR2_CHKBRACEHIGHLIGHT 1005
+#Define IDC_FRMOPTIONSEDITOR2_CHKOCCURRENCEHIGHLIGHT 1006
+
+declare Function frmOptionsEditor2_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+
diff --git a/src/frmOptionsEditor2.inc b/src/frmOptionsEditor2.inc
index e092490c..04a1a806 100644
--- a/src/frmOptionsEditor2.inc
+++ b/src/frmOptionsEditor2.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsEditor2.inc.bak b/src/frmOptionsEditor2.inc.bak
new file mode 100644
index 00000000..e092490c
--- /dev/null
+++ b/src/frmOptionsEditor2.inc.bak
@@ -0,0 +1,119 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include "frmOptionsEditor2.bi"
+#include "clsConfig.bi"
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmOptions
+' ========================================================================================
+private Function frmOptionsEditor2_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+
+ case IDC_FRMOPTIONSEDITOR2_CHKAUTOINDENTATION
+ if codeNotify = BN_CLICKED THEN
+ if Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR2_CHKAUTOINDENTATION) ) then
+ EnableWindow( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKFORNEXTVARIABLE), true )
+ else
+ EnableWindow( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKFORNEXTVARIABLE), false )
+ end if
+ end if
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmOptionsEditor2 Window procedure
+' ========================================================================================
+private Function frmOptionsEditor2_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_COMMAND, frmOptionsEditor2_OnCommand)
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmOptionsEditor2_Show
+' ========================================================================================
+public Function frmOptionsEditor2_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMOPTIONSEDITOR2 = pWindow->Create( hWndParent, "", @frmOptionsEditor2_WndProc, 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ ' Height and width of this child form is set in frmOptions_OnNotify when the treeview option is selected.
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR2_CHKCODETIPS, L(115,"Enable CodeTips"), 0, 0, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR2_CHKAUTOCOMPLETE, L(95,"Enable Autocomplete"), 0, 21, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR2_CHKCHARAUTOCOMPLETE, L(417,"Enable Character Autocompletion"), 0, 42, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR2_CHKAUTOINDENTATION, L(120,"Enable Auto Indentation"), 0, 63, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR2_CHKFORNEXTVARIABLE, L(416,"Append loop variable to For/Next statement"), 30, 84, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR2_CHKBRACEHIGHLIGHT, L(412,"Enable Brace Highlighting"), 0, 105, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSEDITOR2_CHKOCCURRENCEHIGHLIGHT, L(419,"Enable Occurrences Highlighting"), 0, 126, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ Dim As HWnd HWnd = HWND_FRMOPTIONSEDITOR2
+
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKCODETIPS), gConfig.CodeTips)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKAUTOCOMPLETE), gConfig.AutoComplete)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKCHARAUTOCOMPLETE), gConfig.CharacterAutoComplete)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKAUTOINDENTATION), gConfig.AutoIndentation)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKFORNEXTVARIABLE), gConfig.ForNextVariable)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKBRACEHIGHLIGHT), gConfig.BraceHighlight)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKOCCURRENCEHIGHLIGHT), gConfig.OccurrenceHighlight)
+
+ if Button_GetCheck( GetDlgItem(HWnd, IDC_FRMOPTIONSEDITOR2_CHKAUTOINDENTATION) ) then
+ EnableWindow( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKFORNEXTVARIABLE), true )
+ else
+ EnableWindow( GetDlgItem( HWnd, IDC_FRMOPTIONSEDITOR2_CHKFORNEXTVARIABLE), false )
+ end if
+
+ Function = 0
+
+End Function
+
+
+
diff --git a/src/frmOptionsGeneral.bi b/src/frmOptionsGeneral.bi
index 6e4a35f4..16e0784f 100644
--- a/src/frmOptionsGeneral.bi
+++ b/src/frmOptionsGeneral.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsGeneral.bi.bak b/src/frmOptionsGeneral.bi.bak
new file mode 100644
index 00000000..6e4a35f4
--- /dev/null
+++ b/src/frmOptionsGeneral.bi.bak
@@ -0,0 +1,27 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+#Define IDC_FRMOPTIONSGENERAL_CHKMULTIPLEINSTANCES 1000
+#Define IDC_FRMOPTIONSGENERAL_CHKCOMPILEAUTOSAVE 1001
+#Define IDC_FRMOPTIONSGENERAL_CHKCLOSEFUNCLIST 1002
+#Define IDC_FRMOPTIONSGENERAL_CHKCLOSEPROJMGR 1003
+#Define IDC_FRMOPTIONSGENERAL_CHKASKEXIT 1004
+#Define IDC_FRMOPTIONSGENERAL_CHKHIDETOOLBAR 1005
+#Define IDC_FRMOPTIONSGENERAL_CHKRESTORESESSION 1006
+#Define IDC_FRMOPTIONSGENERAL_CHKUPDATES 1007
+#Define IDC_FRMOPTIONSGENERAL_CHKPROJECTCACHE 1008
+
+declare Function frmOptionsGeneral_Show( ByVal hWndParent As HWnd ) as LRESULT
diff --git a/src/frmOptionsGeneral.inc b/src/frmOptionsGeneral.inc
index 618d1d54..c28f8dde 100644
--- a/src/frmOptionsGeneral.inc
+++ b/src/frmOptionsGeneral.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsGeneral.inc.bak b/src/frmOptionsGeneral.inc.bak
new file mode 100644
index 00000000..618d1d54
--- /dev/null
+++ b/src/frmOptionsGeneral.inc.bak
@@ -0,0 +1,84 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmOptionsGeneral.bi"
+#include once "clsConfig.bi"
+
+
+' ========================================================================================
+' frmOptionsGeneral Window procedure
+' ========================================================================================
+private Function frmOptionsGeneral_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmOptionsGeneral_Show
+' ========================================================================================
+public Function frmOptionsGeneral_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMOPTIONSGENERAL = pWindow->Create( hWndParent, "", @frmOptionsGeneral_WndProc, 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ ' Height and width of this child form is set in frmOptions_OnNotify when the treeview option is selected.
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSGENERAL_CHKMULTIPLEINSTANCES, L(119,"Allow multiple instances"), 0, 0, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSGENERAL_CHKCOMPILEAUTOSAVE, L(121,"Autosave files before compiling"), 0, 21, 235, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSGENERAL_CHKCLOSEFUNCLIST, L(227,"Close Function List on selection"), 0, 42, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSGENERAL_CHKASKEXIT, L(274,"Ask before exiting the editor"), 0, 63, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSGENERAL_CHKRESTORESESSION, L(423,"Restore previous session files on startup"), 0, 84, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMOPTIONSGENERAL_CHKUPDATES, L(166,"Check for update at startup (once per day)"), 0, 105, 400, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ Dim As Long idx = 0
+ Dim As HWnd HWnd = HWND_FRMOPTIONSGENERAL
+
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSGENERAL_CHKMULTIPLEINSTANCES), gConfig.MultipleInstances)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSGENERAL_CHKCLOSEFUNCLIST), gConfig.CloseFuncList)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSGENERAL_CHKCOMPILEAUTOSAVE), gConfig.CompileAutoSave)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSGENERAL_CHKASKEXIT), gConfig.AskExit)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSGENERAL_CHKRESTORESESSION), gConfig.RestoreSession)
+ Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSGENERAL_CHKUPDATES), gConfig.CheckForUpdates)
+' Button_SetCheck( GetDlgItem( HWnd, IDC_FRMOPTIONSGENERAL_CHKPROJECTCACHE), gConfig.EnableProjectCache)
+
+ Function = 0
+
+End Function
+
+
+
+
+
diff --git a/src/frmOptionsKeywords.bi b/src/frmOptionsKeywords.bi
index 31cddbb4..1970340e 100644
--- a/src/frmOptionsKeywords.bi
+++ b/src/frmOptionsKeywords.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsKeywords.bi.bak b/src/frmOptionsKeywords.bi.bak
new file mode 100644
index 00000000..31cddbb4
--- /dev/null
+++ b/src/frmOptionsKeywords.bi.bak
@@ -0,0 +1,19 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMOPTIONSKEYWORDS_TXTKEYWORDS 1000
+
+declare function frmOptionsKeywords_Show( ByVal hWndParent As HWnd ) as LRESULT
+
diff --git a/src/frmOptionsKeywords.inc b/src/frmOptionsKeywords.inc
index 7ee8d7a9..e9b775a5 100644
--- a/src/frmOptionsKeywords.inc
+++ b/src/frmOptionsKeywords.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsKeywords.inc.bak b/src/frmOptionsKeywords.inc.bak
new file mode 100644
index 00000000..7ee8d7a9
--- /dev/null
+++ b/src/frmOptionsKeywords.inc.bak
@@ -0,0 +1,98 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmOptionsKeywords.bi"
+#include once "frmOptionsKeywordsWinApi.bi"
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmOptionsKeywords
+' ========================================================================================
+private Function frmOptionsKeywords_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+ Select Case id
+ Case IDC_FRMOPTIONSKEYWORDS_TXTKEYWORDS
+ If codeNotify = EN_CHANGE Then
+ ' The EN_CHANGE notification code is not sent when the ES_MULTILINE style is used and the text is sent through WM_SETTEXT.
+ ' Set the flag in gConfig to indicate that the keywords need to be saved to disk should
+ ' the user press OK to close the Environment Options dialog.
+ gConfig.bKeywordsDirty = True
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmOptionsKeywords
+' ========================================================================================
+private Function frmOptionsKeywords_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ Dim As HFONT hFont = AfxGetWindowFont(GetDlgItem(HWnd, IDC_FRMOPTIONSKEYWORDS_TXTKEYWORDS))
+ DeleteFont(hFont)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmOptionsKeywords Window procedure
+' ========================================================================================
+private Function frmOptionsKeywords_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_COMMAND, frmOptionsKeywords_OnCommand)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmOptionsKeywords_OnDestroy)
+ End Select
+
+ Function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+End Function
+
+
+' ========================================================================================
+' frmOptionsKeywords_Show
+' ========================================================================================
+public function frmOptionsKeywords_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMOPTIONSKEYWORDS = pWindow->Create( hWndParent, "", @frmOptionsKeywords_WndProc, 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING )
+ ' Height and width of this child form is set in frmOptions_OnNotify when the treeview option is selected.
+
+ Dim As HWnd hTextBox = _
+ pWindow->AddControl("TEXTBOX", , IDC_FRMOPTIONSKEYWORDS_TXTKEYWORDS, "", 0, 0, 386, 345, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or ES_LEFT Or _
+ ES_MULTILINE Or ES_AUTOVSCROLL Or ES_WANTRETURN, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING )
+ SendMessage( hTextBox, EM_SETLIMITTEXT, (1024 * 100), 0 ) ' max 100K text
+ Dim As HFONT hFont = pWindow->CreateFont("Courier New", 9)
+ AfxSetWindowFont hTextBox, hFont, True
+
+ gConfig.bKeywordsDirty = False
+ SetWindowTextW hTextBox, WStr(gConfig.FBKeywords)
+
+ Function = 0
+
+End Function
+
diff --git a/src/frmOptionsKeywordsWinApi.bi b/src/frmOptionsKeywordsWinApi.bi
index 064c1195..919e4ff0 100644
--- a/src/frmOptionsKeywordsWinApi.bi
+++ b/src/frmOptionsKeywordsWinApi.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsKeywordsWinApi.bi.bak b/src/frmOptionsKeywordsWinApi.bi.bak
new file mode 100644
index 00000000..064c1195
--- /dev/null
+++ b/src/frmOptionsKeywordsWinApi.bi.bak
@@ -0,0 +1,19 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMOPTIONSKEYWORDSWINAPI_TXTKEYWORDS 1001
+
+declare function frmOptionsKeywordsWinApi_Show( ByVal hWndParent As HWnd ) as LRESULT
+
diff --git a/src/frmOptionsKeywordsWinApi.inc b/src/frmOptionsKeywordsWinApi.inc
index d78e6901..27a218cc 100644
--- a/src/frmOptionsKeywordsWinApi.inc
+++ b/src/frmOptionsKeywordsWinApi.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsKeywordsWinApi.inc.bak b/src/frmOptionsKeywordsWinApi.inc.bak
new file mode 100644
index 00000000..d78e6901
--- /dev/null
+++ b/src/frmOptionsKeywordsWinApi.inc.bak
@@ -0,0 +1,101 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmOptionsKeywordsWinApi.bi"
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmOptionsKeywordsWinApi
+' ========================================================================================
+Function frmOptionsKeywordsWinApi_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+ Case IDC_FRMOPTIONSKEYWORDSWINAPI_TXTKEYWORDS
+ If codeNotify = EN_CHANGE Then
+ ' The EN_CHANGE notification code is not sent when the ES_MULTILINE style is used and the text is sent through WM_SETTEXT.
+ ' Set the flag in gConfig to indicate that the keywords need to be saved to disk should
+ ' the user press OK to close the Environment Options dialog.
+ gConfig.bKeywordsDirty = True
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmOptionsKeywordsWinApi
+' ========================================================================================
+Function frmOptionsKeywordsWinApi_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ Dim As HFONT hFont = AfxGetWindowFont(GetDlgItem(HWnd, IDC_FRMOPTIONSKEYWORDSWINAPI_TXTKEYWORDS))
+ DeleteFont(hFont)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmOptionsKeywordsWinApi Window procedure
+' ========================================================================================
+Function frmOptionsKeywordsWinApi_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_COMMAND, frmOptionsKeywordsWinApi_OnCommand)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmOptionsKeywordsWinApi_OnDestroy)
+ End Select
+
+ Function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+End Function
+
+
+' ========================================================================================
+' frmOptionsKeywordsWinApi_Show
+' ========================================================================================
+function frmOptionsKeywordsWinApi_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMOPTIONSKEYWORDSWINAPI = pWindow->Create( hWndParent, "", _
+ @frmOptionsKeywordsWinApi_WndProc, 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING )
+ ' Height and width of this child form is set in frmOptions_OnNotify when the treeview option is selected.
+
+ Dim As HWnd hTextBox = _
+ pWindow->AddControl("TEXTBOX", , IDC_FRMOPTIONSKEYWORDSWINAPI_TXTKEYWORDS, "", 0, 0, 386, 345, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or ES_LEFT Or _
+ ES_MULTILINE Or ES_AUTOVSCROLL Or ES_WANTRETURN, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING )
+ SendMessage( hTextBox, EM_SETLIMITTEXT, (1024 * 100), 0 ) ' max 100K text
+ Dim As HFONT hFont = pWindow->CreateFont("Courier New", 9)
+ AfxSetWindowFont( hTextBox, hFont, True )
+
+ gConfig.bKeywordsDirty = False
+ AfxSetWindowText( hTextBox, WStr(gConfig.WinApiKeywords) )
+
+ Function = 0
+
+End Function
+
diff --git a/src/frmOptionsLocal.bi b/src/frmOptionsLocal.bi
index b2e451c0..9fe5d772 100644
--- a/src/frmOptionsLocal.bi
+++ b/src/frmOptionsLocal.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsLocal.bi.bak b/src/frmOptionsLocal.bi.bak
new file mode 100644
index 00000000..b2e451c0
--- /dev/null
+++ b/src/frmOptionsLocal.bi.bak
@@ -0,0 +1,32 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION 1001
+#Define IDC_FRMOPTIONSLOCAL_CMDNEW 1002
+#Define IDC_FRMOPTIONSLOCAL_CMDEDIT 1003
+#Define IDC_FRMOPTIONSLOCAL_CMDDELETE 1004
+#Define IDC_FRMOPTIONSLOCAL_FRAMEEDITAREA 1005
+#Define IDC_FRMOPTIONSLOCAL_CMDLOCALIZATION 1006
+#Define IDC_FRMOPTIONSLOCAL_LBLPHRASES 1007
+#Define IDC_FRMOPTIONSLOCAL_LVWPHRASES 1008
+#Define IDC_FRMOPTIONSLOCAL_LBLENGLISH 1009
+#Define IDC_FRMOPTIONSLOCAL_TXTENGLISH 1010
+#Define IDC_FRMOPTIONSLOCAL_LBLTRANSLATE 1011
+#Define IDC_FRMOPTIONSLOCAL_TXTTRANSLATE 1012
+
+declare function frmOptionsLocal_LocalEditCheck() as Long
+declare Function frmOptionsLocal_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+
diff --git a/src/frmOptionsLocal.inc b/src/frmOptionsLocal.inc
index 4a86f23b..272fec69 100644
--- a/src/frmOptionsLocal.inc
+++ b/src/frmOptionsLocal.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOptionsLocal.inc.bak b/src/frmOptionsLocal.inc.bak
new file mode 100644
index 00000000..4a86f23b
--- /dev/null
+++ b/src/frmOptionsLocal.inc.bak
@@ -0,0 +1,457 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmOptionsLocal.bi"
+
+
+' ========================================================================================
+' If a localization file has been edited then save it.
+' ========================================================================================
+public function frmOptionsLocal_LocalEditCheck() as Long
+ if gLocalPhrasesEdit = false then exit function
+
+ dim as CWSTR wszLocalName = AfxGetWindowText( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION) )
+ dim as CWSTR wszFileName = AfxGetExePathName + wstr("Languages\" + wszLocalName)
+ dim as CWSTR wszTemp, wszPhrase
+
+ ' If the english file is selected then we do not want to allow any modifications to that file.
+ if ucase(trim(AfxStrPathname( "NAMEX", wszFilename ))) = "ENGLISH.LANG" then exit function
+
+ dim as HWND hLV = GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LVWPHRASES)
+ dim as long nCount = ListView_GetItemCount(hLV)
+ dim wszIndex as wstring * MAX_PATH
+
+ AfxDeleteFile(wszFileName)
+
+ dim pStream as CTextStream
+ IF pStream.OpenForOutputW(wszFilename, true) = S_OK THEN
+
+ wszTemp = _
+ "' WinFBE localization file for " & ucase(AfxStrPathName("NAME", wszLocalName)) & " language" & vbcrlf & _
+ "'" & vbcrlf & _
+ "' The first element to exist must be called MAXIMUM and needs to be set to" & vbcrlf & _
+ "' the value of the last key in this file." & vbcrlf & _
+ "'" & vbcrlf & _
+ "' This file should be created and saved using UTF-16 encoding (unicode)." & vbcrlf & _
+ "'" & vbcrlf & _
+ "' Each line represents a key/value pair describing the position to store the" & vbcrlf & _
+ "' localized word/phrase into the localization array used by WinFBE. Simple." & vbcrlf & vbcrlf & _
+ "MAXIMUM:" & wstr(nCount) & vbcrlf & vbcrlf
+ pStream.WriteLine(wszTemp)
+
+ for i as long = 0 to nCount - 1
+ FF_ListView_GetItemText(hLV, i, 0, @wszIndex, MAX_PATH )
+ wszTemp = wspace(1024)
+ wszPhrase = AfxStrRSet(wszIndex, 5, "0") + wstr(":") + gLocalPhrases(val(wszIndex))
+ ' Use ** version of CWSTR on MID statements per the documentation.
+ mid(**wszTemp, 1) = wszPhrase
+ if len(gLangEnglish(val(wszIndex))) then
+ ' Always attempt to insert the ENGLISH comment at position 60. If the local
+ ' phrase is too long then simply put the ENGLISH comment after it.
+ dim as long nPos = iif( len(wszPhrase) < 60, 60, len(wszPhrase) + 5)
+ mid(**wszTemp, nPos) = "; " & gLangEnglish(val(wszIndex))
+ end if
+ pStream.WriteLine rtrim(wszTemp)
+ next
+ end if
+ pStream.Close
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Do not allow the English language file to be edited or deleted
+' ========================================================================================
+private function frmOptionsLocal_DisableEnglish() as Long
+ dim as boolean bEnable, bEnglish
+ Dim as CWSTR wszFilename = ucase(AfxGetWindowText(GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION)))
+
+ ' If the english file is selected then we do not want to allow any editing so disable the controls.
+ bEnglish = iif( AfxStrPathname( "NAMEX", wszFilename ) = "ENGLISH.LANG", true, false)
+
+ ' Set the default case for english localization
+ if bEnglish then
+ EnableWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_CMDLOCALIZATION), true )
+ EnableWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_CMDNEW), true )
+ EnableWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_CMDEDIT), false )
+ EnableWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_CMDDELETE), false )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LVWPHRASES), SW_HIDE )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LBLENGLISH), SW_HIDE )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_TXTENGLISH), SW_HIDE )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LBLTRANSLATE), SW_HIDE )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_TXTTRANSLATE), SW_HIDE )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_FRAMEEDITAREA), SW_HIDE )
+ exit function
+ end if
+
+ ' If a non-english file is being edited then enable the fields.
+ dim as long nShow = iif(gLocalPhrasesEdit, SW_SHOW, SW_HIDE)
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LVWPHRASES), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LBLENGLISH), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_TXTENGLISH), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LBLTRANSLATE), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_TXTTRANSLATE), nShow )
+ ShowWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_FRAMEEDITAREA), nShow )
+
+ EnableWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_CMDLOCALIZATION), true )
+ EnableWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_CMDNEW), true )
+ EnableWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_CMDDELETE), true )
+ bEnable = iif(gLocalPhrasesEdit, false, true)
+ EnableWindow( GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_CMDEDIT), bEnable )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Clear the global localization phrase array.
+' ========================================================================================
+private function frmOptionsLocal_ClearGlobalArray() as Long
+ ' Clear the global array contents
+ for i as long = lbound(gLocalPhrases) to ubound(gLocalPhrases)
+ gLocalPhrases(i) = ""
+ next
+ function = 0
+end function
+
+
+' ========================================================================================
+' Load the selected localization file into the global array
+' ========================================================================================
+private function frmOptionsLocal_LoadLocalizationFile( byref wszFilename as wstring ) as Long
+
+ If AfxFileExists( wszFileName ) = 0 Then exit function
+
+ Dim as CBSTR wst, wKey, wData
+ Dim as long nKey, nData, i, nRow, maxKey
+
+ dim pStream AS CTextStream
+ if pStream.OpenUnicode( wszFileName ) <> S_OK then exit function
+
+ frmOptionsLocal_ClearGlobalArray()
+
+ do until pStream.EOS
+ wst = pStream.ReadLine
+
+
+ If Len(wst) = 0 Then Continue Do
+ If Left(wst, 1) = "'" Then Continue Do
+
+ i = Instr(wst, ":")
+ If i = 0 Then Continue Do
+
+ wKey = "": wData = "": nData = 0
+
+ wKey = Left(wst, i-1)
+ wData = Mid(**wst, i+1) ' MID causes problems with Chinese data so ** is used.
+
+ nKey = Val(wKey)
+ nData = Val(wData)
+
+ ' MAXMIUM for a non-English does not redimension the gLocalPhrases array because
+ ' that array is always sized according to the main ENGLISH array.
+ If Ucase(wKey) <> "MAXIMUM" Then
+ if (nKey >= lbound(gLocalPhrases)) and (nKey <= ubound(gLocalPhrases)) then
+ ' Use ** to ensure that cyrillic langauge gets converted correctly. FB intrinsic
+ ' functions (RTRIM) automatically convert those incorrectly when using CBSTR or CWSTR.
+ gLocalPhrases(nKey) = rtrim(**AfxStrParse(wData, 1, ";"), any chr(9,32))
+ ' If the English phrase is blank then blank the translation phrase
+ if gLangEnglish(nKey) = "" then gLocalPhrases(nKey) = ""
+ ' If the Translated phrase is blank then replace it with the English version
+ if gLocalPhrases(nKey) = "" then gLocalPhrases(nKey) = gLangEnglish(nKey)
+ if nKey > maxKey then maxKey = nKey
+ end if
+ End If
+
+ Loop
+ pStream.Close
+
+ ' It is possible that the number of keys in the local file is less than the number
+ ' of keys in the full english file. In that case we need process the remaining
+ ' missing keys by copying the english version over to the local array.
+ for i as long = maxKey + 1 to ubound(gLangEnglish)
+ gLocalPhrases(i) = gLangEnglish(i)
+ next
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Update the translation textboxes
+' ========================================================================================
+private Function frmOptionsLocal_UpdateTextBoxes( ByVal HWnd As HWnd ) As LRESULT
+ dim wszIndex as wstring * MAX_PATH
+ dim wszEnglish as wstring * MAX_PATH
+ dim wszTranslate as wstring * MAX_PATH
+ dim as long idx
+
+ dim as HWND hLV = GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_LVWPHRASES)
+ Dim As Long nCurSel = ListView_GetSelection(hLV)
+ If nCurSel < 0 Then exit function
+ FF_ListView_GetItemText(hLV, nCurSel, 0, @wszIndex, MAX_PATH )
+ FF_ListView_GetItemText(hLV, nCurSel, 1, @wszEnglish, MAX_PATH )
+ idx = val(wszIndex)
+ if (idx >= lbound(gLocalPhrases)) and (idx <= ubound(gLocalPhrases)) then
+ wszTranslate = gLocalPhrases(idx)
+ AfxSetWindowText( GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_TXTENGLISH), wszEnglish)
+ AfxSetWindowText( GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_TXTTRANSLATE), wszTranslate)
+ end if
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmOptionsLocal
+' ========================================================================================
+private Function frmOptionsLocal_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+ Select Case id
+
+ Case IDC_FRMOPTIONSLOCAL_CMDLOCALIZATION
+ ' select localization file
+ If codeNotify = BN_CLICKED Then
+ ' If a localization file is currently being edited then save it now.
+ frmOptionsLocal_LocalEditCheck
+
+ ' Display the Open File Dialog
+ Dim pwszName As WString Ptr = AfxIFileOpenDialogW(HWnd, id)
+ If pwszName Then
+ frmOptionsLocal_LoadLocalizationFile(*pwszName)
+ gLocalPhrasesEdit = false
+ ' Clear any previous listview selected line
+ dim as HWND hLV = GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LVWPHRASES)
+ ListView_UnselectAllItems(hLV)
+ AfxSetWindowText( GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_TXTENGLISH), "")
+ AfxSetWindowText( GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_TXTTRANSLATE), "")
+ AfxSetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION), AfxStrPathname("NAMEX", *pwszName) )
+ AfxSetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_LBLTRANSLATE), AfxStrPathName("NAME", *pwszName) )
+ frmOptionsLocal_DisableEnglish()
+ CoTaskMemFree pwszName
+ End If
+ Exit Function
+ End If
+
+ Case IDC_FRMOPTIONSLOCAL_CMDNEW
+ ' New localization file
+ If codeNotify = BN_CLICKED Then
+ ' If a localization file is currently being edited then save it now.
+ frmOptionsLocal_LocalEditCheck
+
+ ' Display the Save File Dialog
+ Dim wzFilename As WString * MAX_PATH
+ wzFilename = "*.lang"
+ Dim pwszName As WString Ptr = AfxIFileSaveDialog(HWND, @wzFilename, @wstr("lang"), id)
+ If pwszName Then
+ wzFilename = *pwszName
+ frmOptionsLocal_ClearGlobalArray()
+ AfxSetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION), AfxStrPathname("NAMEX", *pwszName) )
+ AfxSetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_LBLTRANSLATE), AfxStrPathName("NAME", *pwszName) )
+ gLocalPhrasesEdit = true
+ frmOptionsLocal_DisableEnglish()
+ dim as HWND hLV = GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LVWPHRASES)
+ ListView_SelectItem(hLV, 0)
+ frmOptionsLocal_UpdateTextBoxes(HWND)
+ SetFocus( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_TXTTRANSLATE) )
+ CoTaskMemFree(pwszName)
+ End If
+ Exit Function
+ End If
+
+ Case IDC_FRMOPTIONSLOCAL_CMDEDIT
+ ' Edit the loaded localization file
+ If codeNotify = BN_CLICKED Then
+ dim as CWSTR wszLanguage = _
+ AfxGetExePathName & wstr("Languages\") & AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION) )
+ frmOptionsLocal_LoadLocalizationFile(wszLanguage)
+ AfxSetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_LBLTRANSLATE), AfxStrPathName("NAME", wszLanguage) )
+ gLocalPhrasesEdit = true
+ frmOptionsLocal_DisableEnglish()
+ dim as HWND hLV = GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LVWPHRASES)
+ ListView_SelectItem(hLV, 0)
+ frmOptionsLocal_UpdateTextBoxes(HWND)
+ SetFocus( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_TXTTRANSLATE) )
+ Exit Function
+ End If
+
+ Case IDC_FRMOPTIONSLOCAL_CMDDELETE
+ ' Delete localization file
+ If codeNotify = BN_CLICKED Then
+ if MessageBox( HWND, L(366,"Are you sure you want to delete?"), L(276,"Confirm"), _
+ MB_YESNOCANCEL or MB_ICONQUESTION Or MB_DEFBUTTON1 ) <> IDYES then
+ exit function
+ end if
+ dim as CWSTR wszFileName = AfxGetExePathName + wstr("Languages\") + _
+ AfxGetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION) )
+ frmOptionsLocal_ClearGlobalArray()
+ AfxDeleteFile(wszFileName)
+ ' Clear any previous listview selected line
+ dim as HWND hLV = GetDlgItem(HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_LVWPHRASES)
+ ListView_UnselectAllItems(hLV)
+ AfxSetWindowText( GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_TXTENGLISH), "")
+ AfxSetWindowText( GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_TXTTRANSLATE), "")
+ AfxSetWindowText( GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION), wstr("english.lang"))
+ AfxSetWindowText( GetDlgItem(HWnd, IDC_FRMOPTIONSLOCAL_LBLTRANSLATE), wstr("english") )
+ frmOptionsLocal_DisableEnglish()
+ end if
+ exit function
+
+ case IDC_FRMOPTIONSLOCAL_TXTTRANSLATE
+ If codeNotify = EN_CHANGE Then
+ dim wszIndex as wstring * MAX_PATH
+ dim wszTranslate as wstring * MAX_PATH
+ dim as HWND hLV = GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_LVWPHRASES)
+ Dim As Long nCurSel = ListView_GetSelection(hLV)
+ If nCurSel >= 0 Then
+ FF_ListView_GetItemText(hLV, nCurSel, 0, @wszIndex, MAX_PATH )
+ dim as long idx = val(wszIndex)
+ if (idx >= lbound(gLocalPhrases)) and (idx <= ubound(gLocalPhrases)) then
+ gLocalPhrases(idx) = AfxGetWindowText( GetDlgItem(HWND, IDC_FRMOPTIONSLOCAL_TXTTRANSLATE) )
+ end if
+ end if
+ end if
+ exit function
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_NOTIFY message for window/dialog: frmOptionsLocal
+' ========================================================================================
+private Function frmOptionsLocal_OnNotify( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal pNMHDR As NMHDR Ptr _
+ ) As LRESULT
+ SELECT CASE id
+ Case IDC_FRMOPTIONSLOCAL_LVWPHRASES
+ select case pNMHDR->code
+ case LVN_ITEMCHANGED
+ frmOptionsLocal_UpdateTextBoxes(HWND)
+ end select
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmOptionsLocal Window procedure
+' ========================================================================================
+private Function frmOptionsLocal_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_COMMAND, frmOptionsLocal_OnCommand)
+ HANDLE_MSG (HWnd, WM_NOTIFY, frmOptionsLocal_OnNotify)
+ End Select
+
+ Function = DefWindowProcW(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmOptionsLocal_Show
+' ========================================================================================
+public Function frmOptionsLocal_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ gLocalPhrasesEdit = false
+
+ HWND_FRMOPTIONSLOCAL = pWindow->Create( hWndParent, "", @frmOptionsLocal_WndProc, 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ ' Height and width of this child form is set in frmOptions_OnNotify when the treeview option is selected.
+
+ pWindow->AddControl("BUTTON", , IDC_FRMOPTIONSLOCAL_CMDLOCALIZATION, L(126,"Select"), 40, 22, 75, 26, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMOPTIONSLOCAL_CMDNEW, L(3,"New"), 117, 22, 75, 26, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMOPTIONSLOCAL_CMDEDIT, L(14,"Edit"), 194, 22, 75, 26, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMOPTIONSLOCAL_CMDDELETE, L(282,"Delete"), 271, 22, 75, 26, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("GROUPBOX", , IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION, "english.lang", 0, 0, 385, 58, _
+ WS_CHILD Or WS_VISIBLE Or BS_TEXT Or BS_LEFT Or BS_NOTIFY Or BS_GROUPBOX, _
+ WS_EX_TRANSPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ dim as hwnd hwndLV = _
+ pWindow->AddControl("LISTVIEW", , IDC_FRMOPTIONSLOCAL_LVWPHRASES, "", 8, 78, 368, 160, _
+ WS_CHILD Or WS_VISIBLE OR WS_CLIPCHILDREN OR WS_TABSTOP OR LVS_REPORT OR LVS_SHOWSELALWAYS, _
+ WS_EX_CLIENTEDGE)
+ ListView_MakeHeaderFlat(hwndLV)
+ ' Add some extended styles
+ dim as long dwExStyle = ListView_GetExtendedListViewStyle(hwndLV)
+ dwExStyle = dwExStyle Or LVS_EX_FULLROWSELECT Or LVS_EX_GRIDLINES Or LVS_EX_DOUBLEBUFFER Or LVS_EX_FLATSB
+ ListView_SetExtendedListViewStyle(hwndLV, dwExStyle)
+
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONSLOCAL_LBLENGLISH, "English", 8, 246, 150, 16, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMOPTIONSLOCAL_TXTENGLISH, "", 8, 264, 368, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL or ES_READONLY, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMOPTIONSLOCAL_LBLTRANSLATE, "English", 8, 292, 150, 16, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMOPTIONSLOCAL_TXTTRANSLATE, "", 8, 310, 368, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("GROUPBOX", , IDC_FRMOPTIONSLOCAL_FRAMEEDITAREA, "Phrases", 0, 58, 385, 288, _
+ WS_CHILD Or WS_VISIBLE Or BS_TEXT Or BS_LEFT Or BS_NOTIFY Or BS_GROUPBOX, _
+ WS_EX_TRANSPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ AfxSetWindowText(GetDlgItem( HWND_FRMOPTIONSLOCAL, IDC_FRMOPTIONSLOCAL_FRAMELOCALIZATION), gConfig.LocalizationFile)
+ frmOptionsLocal_DisableEnglish()
+
+ ' Display the columns in the Listview and load the English phrases
+ ListView_AddColumn( hwndLV, 0, @wstr("Index"), pWindow->ScaleX(50) )
+ ListView_AddColumn( hwndLV, 1, @wstr("English Phrase"), pWindow->ScaleX(280))
+
+ ' Always size the local phrase array to be the same size as the ENGLISH array.
+ ReDim gLocalPhrases(Ubound(gLangEnglish))
+ frmOptionsLocal_LoadLocalizationFile(gConfig.LocalizationFile)
+
+ dim as long nRow = 0
+ for i as long = LBound(gLangEnglish) to Ubound(gLangEnglish)
+ ' Add to the English phrase Listview
+ dim as CWSTR wKey = AfxStrRset(str(i), 5, "0")
+ FF_ListView_InsertItem(hwndLV, nRow, 0, wKey, 0 )
+ FF_ListView_InsertItem(hwndLV, nRow, 1, gLangEnglish(i), 0 )
+ nRow = nRow + 1
+ next
+
+ Function = 0
+
+End Function
+
diff --git a/src/frmOutput.bi b/src/frmOutput.bi
index 5139731d..ef0d3b64 100644
--- a/src/frmOutput.bi
+++ b/src/frmOutput.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOutput.bi.bak b/src/frmOutput.bi.bak
new file mode 100644
index 00000000..5139731d
--- /dev/null
+++ b/src/frmOutput.bi.bak
@@ -0,0 +1,44 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMOUTPUT_TABS 1000
+#Define IDC_FRMOUTPUT_LVRESULTS 1001
+#Define IDC_FRMOUTPUT_TXTLOGFILE 1002
+#Define IDC_FRMOUTPUT_LVSEARCH 1003
+#Define IDC_FRMOUTPUT_LVTODO 1004
+#Define IDC_FRMOUTPUT_TXTNOTES 1005
+#Define IDC_FRMOUTPUT_BTNCLOSE 1006
+
+#define OUTPUT_TABS_HEIGHT 40
+
+
+type OUTPUT_TABS
+ wszText as CWSTR
+ rcTab as RECT
+ rcText as RECT ' diff rect b/c line drawn under Text for CurSel
+ isHot as boolean
+end type
+
+dim shared gOutputTabs(4) as OUTPUT_TABS
+dim shared gOutputTabsCurSel as long = 0 ' default to first tab
+dim shared gOutputCloseRect as RECT
+
+declare function frmOutput_ShowNotes() as long
+declare function frmOutput_UpdateToDoListview() as long
+declare function frmOutput_UpdateSearchListview( byref wszResultFile as wstring ) as long
+declare Function frmOutput_ShowHideOutputControls( ByVal HWnd As HWnd ) As LRESULT
+declare Function frmOutput_PositionWindows As LRESULT
+declare Function frmOutput_Show( ByVal hWndParent As HWnd ) As LRESULT
+
diff --git a/src/frmOutput.inc b/src/frmOutput.inc
index 8bebcd11..0b23b2d6 100644
--- a/src/frmOutput.inc
+++ b/src/frmOutput.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmOutput.inc.bak b/src/frmOutput.inc.bak
new file mode 100644
index 00000000..8bebcd11
--- /dev/null
+++ b/src/frmOutput.inc.bak
@@ -0,0 +1,991 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmOutput.bi"
+
+
+' ========================================================================================
+' Clear data from all of the controls in the frmOutput windows. This is needed
+' when Projects are loaded and closed.
+' ========================================================================================
+function frmOutput_ResetAllControls() as long
+ ListView_DeleteAllItems( GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVRESULTS) )
+ AfxSetWindowText( GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTLOGFILE), "" )
+ ListView_DeleteAllItems( GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVSEARCH) )
+ ListView_DeleteAllItems( GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVTODO) )
+ AfxSetWindowText( GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES), "" )
+ function = 0
+END FUNCTION
+
+
+' ========================================================================================
+' Ensure that the correct notes are shown
+' ========================================================================================
+function frmOutput_ShowNotes() as long
+
+ dim hCtl as hwnd = GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES)
+
+ if gApp.IsProjectActive THEN
+ AfxSetWindowText(hCtl, gApp.ProjectNotes)
+ else
+ AfxSetWindowText(hCtl, gApp.NonProjectNotes)
+ END IF
+
+ function = 0
+END FUNCTION
+
+
+' ========================================================================================
+' Update the TODO listview
+' ========================================================================================
+function frmOutput_UpdateToDoListview() as long
+ dim as hwnd hLV = GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVTODO)
+ ListView_DeleteAllItems( hLV )
+ dim as long n = 0
+
+ dim pData as DB2_DATA ptr
+
+ gdb2.dbRewind()
+ do
+ pData = gdb2.dbGetNext
+ if pData = 0 THEN exit do
+ if pData->id <> DB2_TODO THEN continue do
+ FF_ListView_InsertItem( hLV, n, 0, "" )
+ FF_ListView_InsertItem( hLV, n, 1, ltrim(WStr(pData->nLineStart)))
+ FF_ListView_InsertItem( hLV, n, 2, ltrim(WStr(pData->fileName)))
+ FF_ListView_InsertItem( hLV, n, 3, ltrim(WStr(pData->ElementData)))
+ n = n + 1
+ loop
+
+ function = 0
+END FUNCTION
+
+' ========================================================================================
+' Update the SEARCH listview
+' ========================================================================================
+function frmOutput_UpdateSearchListview( byref wszResultFile as wstring ) as long
+ dim hLV as hwnd = GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVSEARCH )
+
+ ListView_DeleteAllItems( hLV )
+ dim as long n = 0
+
+ if AfxFileExists(wszResultFile) = 0 then exit function
+
+ dim as CWSTR wst
+
+ dim pStream as CTextStream
+ if pStream.OpenUnicode(wszResultFile) <> S_OK then exit function
+
+ do until pStream.EOS
+ wst = pStream.ReadLine
+
+ wst = trim(wst)
+ if len(wst) = 0 THEN continue do
+
+ dim as CWSTR wszFilename, wszLineNum, wszDescription
+ dim as long f1, f2
+
+ ' Original as seen in the output file
+ 'X:\FB\WinFBE - Editor\license.txt:1:WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+
+ ' Search for the 2nd semicolon
+ f1 = instr( 3, wst, ":" )
+ if f1 then f2 = instr( f1 + 1, wst, ":" )
+
+ if f1 then wszFilename = left(wst, f1 - 1)
+ if f2 > f1 then wszLinenum = mid(wst, f1 + 1, f2 - f1 - 1)
+ if f2 then wszDescription = rtrim(mid(wst, f2 + 1))
+
+ FF_ListView_InsertItem( hLV, n, 0, "" )
+ FF_ListView_InsertItem( hLV, n, 1, wszLineNum )
+ FF_ListView_InsertItem( hLV, n, 2, wszFilename )
+ FF_ListView_InsertItem( hLV, n, 3, wszDescription )
+ n = n + 1
+
+ loop
+ pStream.Close
+
+ AfxDeleteFile( wszResultFile )
+
+ ' Show the search results
+ gOutputTabsCurSel = 2
+ ShowWindow( HWND_FRMOUTPUT, SW_SHOW )
+ frmMain_PositionWindows
+ frmOutput_PositionWindows
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Show/Hide correct child controls
+' ========================================================================================
+Function frmOutput_ShowHideOutputControls( ByVal HWnd As HWnd ) As LRESULT
+ dim as HWND hCtrl
+ dim as RECT rc
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMOUTPUT)
+ If pWindow = 0 Then Exit Function
+
+ ' By default, hide all controls
+ ShowWindow GetDlgItem(hWnd, IDC_FRMOUTPUT_TABS), SW_SHOW
+ AfxRedrawWindow( GetDlgItem(hWnd, IDC_FRMOUTPUT_TABS) )
+
+ ShowWindow GetDlgItem(hWnd, IDC_FRMOUTPUT_LVRESULTS), SW_HIDE
+ ShowWindow GetDlgItem(hWnd, IDC_FRMOUTPUT_TXTLOGFILE), SW_HIDE
+ ShowWindow GetDlgItem(hWnd, IDC_FRMOUTPUT_LVSEARCH), SW_HIDE
+ ShowWindow GetDlgItem(hWnd, IDC_FRMOUTPUT_LVTODO), SW_HIDE
+ ShowWindow GetDlgItem(hWnd, IDC_FRMOUTPUT_TXTNOTES), SW_HIDE
+
+ Select case gOutputTabsCurSel
+ case 0 ' compiler results
+ hCtrl = GetDlgItem(hWnd, IDC_FRMOUTPUT_LVRESULTS)
+ ListView_SetColumnWidth( hCtrl, 3, LVSCW_AUTOSIZE_USEHEADER )
+
+ case 1 ' compiler log file
+ hCtrl = GetDlgItem(hWnd, IDC_FRMOUTPUT_TXTLOGFILE)
+ GetClientRect( hCtrl, @rc )
+ rc.left = rc.left + pWindow->ScaleX(20)
+ SendMessage( hCtrl, EM_SETRECT, 0, cast(LPARAM, @rc) )
+
+ case 2 ' search results
+ hCtrl = GetDlgItem(hWnd, IDC_FRMOUTPUT_LVSEARCH)
+ ListView_SetColumnWidth( hCtrl, 3, LVSCW_AUTOSIZE_USEHEADER )
+
+ case 3 ' ToDo list
+ ' ensure last column is sized to fit to end of client area.
+ hCtrl = GetDlgItem(hWnd, IDC_FRMOUTPUT_LVTODO)
+ ListView_SetColumnWidth( hCtrl, 3, LVSCW_AUTOSIZE_USEHEADER )
+
+ case 4 ' Notes
+ hCtrl = GetDlgItem(hWnd, IDC_FRMOUTPUT_TXTNOTES)
+ GetClientRect( hCtrl, @rc )
+ rc.left = rc.left + pWindow->ScaleX(20)
+ SendMessage( hCtrl, EM_SETRECT, 0, cast(LPARAM, @rc) )
+
+ end select
+
+ SetWindowPos( hCtrl, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW )
+ SetFocus( hCtrl )
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+Function frmOutput_PositionWindows() As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMOUTPUT)
+ If pWindow = 0 Then Exit Function
+
+ Dim As Long nTop = pWindow->ScaleY(2)
+ Dim As Long nLeft = 0
+ Dim As Long nTabsHeight
+ Dim As Rect rc: GetClientRect( HWND_FRMOUTPUT, @rc )
+
+ dim as hwnd hTabs = GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TABS)
+
+ nTabsHeight = AfxGetWindowHeight(hTabs)
+ SetWindowPos( hTabs, 0, nLeft, nTop, rc.right - rc.left, nTabsHeight, SWP_NOZORDER )
+
+ ' Position the child controls
+ nTop = nTop + nTabsHeight + pWindow->ScaleY(8)
+ SetWindowPos GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTLOGFILE), 0, nLeft, nTop, rc.Right, rc.Bottom - nTop, SWP_NOZORDER
+ SetWindowPos GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVRESULTS), 0, nLeft, nTop, rc.Right, rc.Bottom - nTop, SWP_NOZORDER
+ SetWindowPos GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVSEARCH), 0, nLeft, nTop, rc.Right, rc.Bottom - nTop, SWP_NOZORDER
+ SetWindowPos GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVTODO), 0, nLeft, nTop, rc.Right, rc.Bottom - nTop, SWP_NOZORDER
+ SetWindowPos GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES), 0, nLeft, nTop, rc.Right, rc.Bottom - nTop, SWP_NOZORDER
+
+ ' Calculate the tabs rects
+ GetClientRect( hTabs, @rc )
+
+ dim wszText as wstring * 100
+ dim as long nTextLen
+ dim as HFONT hFontText = ghStatusBar.hFontStatusBar
+ dim as long hmargin = pWindow->ScaleX(10)
+ rc.top = rc.top + pWindow->ScaleY(2)
+ rc.left = rc.left + pWindow->ScaleX(10)
+
+ wszText = ucase(L(191, "Compiler Results"))
+ nTextLen = pWindow->ScaleX(getTextWidth( HWND_FRMOUTPUT, wszText, hFontText, 0 ))
+ gOutputTabs(0).wszText = wszText
+ gOutputTabs(0).rcTab = rc: gOutputTabs(0).rcText = rc
+ gOutputTabs(0).rcText.left = gOutputTabs(0).rcTab.left + hmargin
+ gOutputTabs(0).rcText.right = gOutputTabs(0).rcText.left + nTextLen
+ gOutputTabs(0).rcTab.right = gOutputTabs(0).rcText.right + hmargin
+
+ wszText = ucase(L(252, "Compiler Log File"))
+ nTextLen = pWindow->ScaleX(getTextWidth( HWND_FRMOUTPUT, wszText, hFontText, 0 ))
+ gOutputTabs(1).wszText = wszText
+ gOutputTabs(1).rcTab = rc: gOutputTabs(1).rcText = rc
+ gOutputTabs(1).rcTab.left = gOutputTabs(0).rcTab.right
+ gOutputTabs(1).rcText.left = gOutputTabs(1).rcTab.left + hmargin
+ gOutputTabs(1).rcText.right = gOutputTabs(1).rcText.left + nTextLen
+ gOutputTabs(1).rcTab.right = gOutputTabs(1).rcText.right + hmargin
+
+ wszText = ucase(L(262, "Search Results"))
+ nTextLen = pWindow->ScaleX(getTextWidth( HWND_FRMOUTPUT, wszText, hFontText, 0 ))
+ gOutputTabs(2).wszText = wszText
+ gOutputTabs(2).rcTab = rc: gOutputTabs(2).rcText = rc
+ gOutputTabs(2).rcTab.left = gOutputTabs(1).rcTab.right
+ gOutputTabs(2).rcText.left = gOutputTabs(2).rcTab.left + hmargin
+ gOutputTabs(2).rcText.right = gOutputTabs(2).rcText.left + nTextLen
+ gOutputTabs(2).rcTab.right = gOutputTabs(2).rcText.right + hmargin
+
+ wszText = ucase(L(263, "TODO"))
+ nTextLen = pWindow->ScaleX(getTextWidth( HWND_FRMOUTPUT, wszText, hFontText, 0 ))
+ gOutputTabs(3).wszText = wszText
+ gOutputTabs(3).rcTab = rc: gOutputTabs(3).rcText = rc
+ gOutputTabs(3).rcTab.left = gOutputTabs(2).rcTab.right
+ gOutputTabs(3).rcText.left = gOutputTabs(3).rcTab.left + hmargin
+ gOutputTabs(3).rcText.right = gOutputTabs(3).rcText.left + nTextLen
+ gOutputTabs(3).rcTab.right = gOutputTabs(3).rcText.right + hmargin
+
+ wszText = ucase(L(264, "Notes"))
+ nTextLen = pWindow->ScaleX(getTextWidth( HWND_FRMOUTPUT, wszText, hFontText, 0 ))
+ gOutputTabs(4).wszText = wszText
+ gOutputTabs(4).rcTab = rc: gOutputTabs(4).rcText = rc
+ gOutputTabs(4).rcTab.left = gOutputTabs(3).rcTab.right
+ gOutputTabs(4).rcText.left = gOutputTabs(4).rcTab.left + hmargin
+ gOutputTabs(4).rcText.right = gOutputTabs(4).rcText.left + nTextLen
+ gOutputTabs(4).rcTab.right = gOutputTabs(4).rcText.right + hmargin
+
+ dim as long rcCloseWidth = 20
+ dim as long rcCloseHeight = 20
+ dim as long vmargin = pWindow->ScaleY( (OUTPUT_TABS_HEIGHT - rcCloseHeight) / 2 )
+ GetClientRect( hTabs, @rc )
+ gOutputCloseRect.top = gOutputTabs(4).rcTab.top + vmargin
+ gOutputCloseRect.bottom = gOutputTabs(4).rcTab.bottom - vmargin
+ gOutputCloseRect.right = rc.right - hmargin
+ gOutputCloseRect.left = gOutputCloseRect.right - pWindow->ScaleX(rcCloseWidth)
+
+ ' Determine which child controls should be shown or hidden
+ frmOutput_ShowHideOutputControls(HWND_FRMOUTPUT)
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmOutput
+' ========================================================================================
+Function frmOutput_OnSize( _
+ ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+
+ If state <> SIZE_MINIMIZED Then
+ ' Position all of the child windows
+ frmOutput_PositionWindows
+ End If
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmOutput
+' ========================================================================================
+Function frmOutput_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select case codeNotify
+
+ case EN_CHANGE
+ ' Notes have been modified. Save them to the correct global variable
+ ' to ensure that the changes are not lost when documents or projects
+ ' are switched.
+ if id = IDC_FRMOUTPUT_TXTNOTES THEN
+ if gApp.IsProjectActive THEN
+ gApp.ProjectNotes = AfxGetWindowText(hwndCtl)
+ else
+ gApp.NonProjectNotes = AfxGetWindowText(hwndCtl)
+ end if
+ exit function
+ end if
+
+ end select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed frmOutput Compile Results and TODO listviews .
+' ========================================================================================
+Function frmOutput_Listview_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ ' Convert our ENTER key presses into LBUTTONDBLCLK to process them similarly
+ If (uMsg = WM_KEYUP) And (Loword(wParam) = VK_RETURN) Then uMsg = WM_LBUTTONDBLCLK
+
+ Select Case uMsg
+
+ Case WM_GETDLGCODE
+ ' All keyboard input
+ Function = DLGC_WANTALLKEYS
+ Exit Function
+
+ case WM_NOTIFY
+ ' Handle custom draw of the listview header
+ dim ptnmhdr as NMHDR ptr
+ dim ptnmcd as NMCUSTOMDRAW ptr
+
+ ptnmhdr = cast(NMHDR ptr, lParam)
+
+ ' need to prevent re-entry into HDN_ITEMCHANGING because
+ ' calling ListView_SetColumnWidth triggers another HDN_ITEMCHANGING
+ static as boolean inChanging = false
+
+ IF ptnmhdr->code = HDN_ITEMCHANGING then
+ ' notification from the ListView header control that the user is
+ ' resizing a header item via the mouse. Update the last column width
+ ' to ensure it covers the non-client area (because difficult painting
+ ' this area).
+ if inChanging then exit function
+ inChanging = true
+ ListView_SetColumnWidth( hWnd, 3, LVSCW_AUTOSIZE_USEHEADER )
+ inChanging = false
+ end if
+
+ IF ptnmhdr->code = NM_CUSTOMDRAW THEN
+ ptnmcd = cast(NMCUSTOMDRAW ptr, lParam)
+
+ ' Determine the stage of the paint cycle
+ select case ptnmcd->dwDrawStage
+
+ case CDDS_PREPAINT
+ ' Control is to notify parent about each item being drawn
+ return CDRF_NOTIFYITEMDRAW
+
+ ' Items are being painted
+ case CDDS_ITEMPREPAINT
+ select case ptnmcd->dwItemSpec
+ case 0, 1, 2, 3 ' columns
+ ' Paint the whole cell ourselves
+ FillRect( ptnmcd->hdc, @ptnmcd->rc, ghOutput.hPanelBrush )
+ SetTextColor( ptnmcd->hdc, ghOutput.ForeColorHot )
+ SetBkColor( ptnmcd->hdc, ghOutput.BackColor )
+ dim wszText as wstring * MAX_PATH
+ 'Header_GetItemText is currently bugged. Report submitted to Jose to correct.
+ 'Header_GetItemText( ptnmhdr->hwndFrom, ptnmcd->dwItemSpec, @wszText, MAX_PATH )
+ ListView_GetHeaderText( HWnd, ptnmcd->dwItemSpec, @wszText, MAX_PATH )
+ dim as HFONT oldFont
+ oldFont = SelectObject( ptnmcd->hdc, ghStatusBar.hFontStatusBar )
+ dim as long wsStyle = DT_NOPREFIX or DT_LEFT Or DT_VCENTER or DT_SINGLELINE
+ DrawText( ptnmcd->hdc, wszText, -1, Cast(lpRect, @ptnmcd->rc), wsStyle )
+ SelectObject( ptnmcd->hdc, oldFont )
+ return CDRF_SKIPDEFAULT
+ end select
+
+ end select
+
+ return true
+ end if
+
+ Case WM_LBUTTONDBLCLK
+ SetDocumentErrorPosition( HWND, gCompile.CompileID )
+ Exit Function
+
+ Case WM_KEYUP
+ Select Case Loword(wParam)
+ Case VK_RETURN ' already processed in WM_LBUTTONDBLCLK
+ End Select
+ Exit Function
+
+ Case WM_CHAR ' prevent the annoying beep!
+ If wParam = VK_RETURN Then Return 0
+ If wParam = VK_ESCAPE Then Return 0
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( HWnd, @frmOutput_Listview_SubclassProc, uIdSubclass )
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc( HWnd, uMsg, wParam, lParam )
+
+End Function
+
+
+' ========================================================================================
+' Process WM_MOUSEMOVE message for window/dialog: frmOutput
+' ========================================================================================
+Function frmOutput_OnMouseMove( _
+ ByVal HWnd As HWnd, _
+ ByVal x as long, _
+ byval y as long, _
+ byval keyflags as UINT _
+ ) As Long
+
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(HWND_FRMMAIN)
+ If pWindow = 0 Then Exit Function
+
+ ' HITTEST (PANELS SPLITTER)
+ dim as POINT pt
+ dim as RECT rc
+ GetWindowRect( HWND_FRMOUTPUT, @rc )
+ rc.Bottom = rc.Top + pWindow->ScaleY(3)
+ GetCursorPos(@pt)
+ If PtInRect( @rc, pt ) Then
+ if WindowFromPoint(pt) = HWND_FRMOUTPUT then
+ SetCursor( ghCursorSizeNS )
+ end if
+ End If
+
+ If gApp.bDragActive Then
+ If gApp.hWndPanel = HWND_FRMOUTPUT Then
+ GetCursorPos(@pt)
+ GetWindowRect( HWND_FRMOUTPUT, @rc )
+ dim as long nHeight
+ Dim As Long nDiff = pt.y - rc.top
+ ' Adjust the height. The positioning will be taken care of in PositionMainWindows().
+ rc.top = rc.top + nDiff
+
+ ' Don't move the Output pane if the top is less than the bottom of the TopTabs
+ dim as RECT rc2
+ dim as long nTopLimit
+ GetWindowRect( HWND_FRMMAIN_MENUBAR, @rc2 )
+ nTopLimit = rc2.bottom
+ if gTTabCtl.GetItemCount then
+ GetWindowRect( HWND_FRMMAIN_TOPTABS, @rc2 )
+ nTopLimit = rc2.bottom
+ end if
+ rc.top = max(rc.top, nTopLimit)
+ nHeight = (rc.bottom-rc.top) - pWindow->ScaleY(4) ' allow room to grab the top
+
+ ' The minimum height of the Output window when visible is the height of the tabs
+ nHeight = max( nHeight, pWindow->ScaleY(OUTPUT_TABS_HEIGHT) )
+
+ SetWindowPos( HWND_FRMOUTPUT, 0, 0, 0, rc.Right - rc.Left, nHeight, SWP_NOMOVE Or SWP_NOZORDER )
+ frmMain_PositionWindows
+ Exit Function
+ End If
+ End If
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_LBUTTONDOWN message for window/dialog: frmOutput
+' ========================================================================================
+Function frmOutput_OnLButtonDown( _
+ ByVal HWnd As HWnd, _
+ byval fDoubleClick as Boolean, _
+ ByVal x as long, _
+ byval y as long, _
+ byval keyflags as UINT _
+ ) As Long
+
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(HWND_FRMMAIN)
+ If pWindow = 0 Then Exit Function
+
+ ' HITTEST (PANELS TOP/BOTTOM SPLITTER)
+ Dim As Rect rc
+ Dim As Point pt
+
+ gApp.bDragActive = False
+
+ GetWindowRect HWND_FRMOUTPUT, @rc
+ rc.Bottom = rc.Top + pWindow->ScaleY(3)
+ GetCursorPos(@pt)
+ If PtInRect( @rc, pt ) Then
+ if WindowFromPoint(pt) = HWND_FRMOUTPUT then
+ SetCursor( ghCursorSizeNS )
+ gApp.bDragActive = True
+ gApp.hWndPanel = HWND_FRMOUTPUT
+ SetCapture( HWND_FRMOUTPUT )
+ end if
+ Exit Function
+ End If
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_LBUTTONUP message for window/dialog: frmOutput
+' ========================================================================================
+Function frmOutput_OnLButtonUp( _
+ ByVal HWnd As HWnd, _
+ ByVal x as long, _
+ byval y as long, _
+ byval keyflags as UINT _
+ ) As Long
+
+ ' HITTEST (PANELS TOP/BOTTOM SPLITTER)
+ if gApp.bDragActive then
+ gApp.bDragActive = False
+ gApp.hWndPanel = 0
+ ReleaseCapture()
+ end if
+ SetCursor( LoadCursor( null, IDC_ARROW ))
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Do hit test to determine what tab is currently under the mouse cursor
+' ========================================================================================
+function frmOutputTabs_getHotTabHitTest( byval hWin as HWnd ) as long
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ dim as long hotTab = -1
+ for i as long = lbound(gOutputTabs) to ubound(gOutputTabs)
+ if PtInRect( @gOutputTabs(i).rcTab, pt ) then
+ hotTab = i
+ gOutputTabs(i).isHot = true
+ else
+ gOutputTabs(i).isHot = false
+ end if
+ next
+ function = hotTab
+end function
+
+
+' ========================================================================================
+' frmOutputTabs_SubclassProc
+' ========================================================================================
+function frmOutputTabs_SubclassProc ( _
+ byval hWin as HWnd, _ ' // Control window handle
+ byval uMsg as UINT, _ ' // Type of message
+ byval _wParam as WPARAM, _ ' // First message parameter
+ byval _lParam as LPARAM, _ ' // Second message parameter
+ byval uIdSubclass as UINT_PTR, _ ' // The subclass ID
+ byval dwRefData as DWORD_PTR _ ' // Pointer to reference data
+ ) as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMOUTPUT)
+ static as long accumDelta
+
+ ' keep track of last index we were over so that we only issue a
+ ' repaint if the cursor has moved off of the tab
+ static as long nLastIdx = -1
+ static as boolean isLastClose = false
+ static hTooltip as HWND
+
+ select case uMsg
+
+ Case WM_MOUSEMOVE
+ ' Track that we are over the control in order to catch the
+ ' eventual WM_MOUSELEAVE event
+ dim tme as TrackMouseEvent
+ tme.cbSize = sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER or TME_LEAVE
+ tme.hwndTrack = hWin
+ TrackMouseEvent(@tme)
+
+ if IsWindow(hTooltip) = 0 then hTooltip = AfxAddTooltip( hWin, "", false, false )
+
+ dim as long idx = frmOutputTabs_getHotTabHitTest( hWin )
+ if idx <> nLastIdx then
+ nLastIdx = idx
+ AfxRedrawWindow(hWin)
+ end if
+
+ dim as boolean isClose = isMouseOverRECT( hWin, gOutputCloseRect )
+ if isClose <> isLastClose then
+ isLastClose = isClose
+ AfxRedrawWindow(hWin)
+ end if
+ exit function
+
+ case WM_MOUSEHOVER
+ dim as CWSTR wszTooltip = ""
+ if isMouseOverRECT( hWin, gOutputCloseRect ) = true then
+ ' Display the tooltip
+ wszTooltip = L(161, "Close")
+ end if
+ AfxSetTooltipText( hTooltip, hWin, wszTooltip )
+ exit function
+
+ case WM_MOUSELEAVE
+ ' reset the hot tab index
+ frmOutputTabs_getHotTabHitTest( hWin )
+ nLastIdx = -1
+ AfxDeleteTooltip( hTooltip, hWin )
+ hTooltip = 0
+ AfxRedrawWindow(hWin)
+ exit function
+
+ case WM_LBUTTONUP
+ if isMouseOverRECT( hWin, gOutputCloseRect ) = true then
+ OnCommand_ViewOutput() ' toggle the Output window off
+ else
+ dim as long idx = frmOutputTabs_getHotTabHitTest( hWin )
+ if idx = -1 then exit function
+ gOutputTabsCurSel = idx
+ AfxRedrawWindow(hWin)
+ frmOutput_ShowHideOutputControls( HWND_FRMOUTPUT )
+ end if
+ exit function
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_PAINT
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDC
+ dim as RECT rc
+ hDC = BeginPaint( hWin, @ps )
+
+ SaveDC(hDC)
+ dim as long nWidth = ps.rcPaint.right - ps.rcPaint.left
+ dim as long nHeight = ps.rcPaint.bottom - ps.rcPaint.top
+
+ Dim memDC as HDC ' Double buffering
+ Dim hbit As HBITMAP ' Double buffering
+ dim oldFont as HFONT
+ dim oldPen as HPEN
+ dim oldBrush as HBRUSH
+ dim oldBmp as HBITMAP
+
+ memDC = CreateCompatibleDC( hDC )
+ hbit = CreateCompatibleBitmap( hDC, nWidth, nHeight )
+
+ SaveDC(memDC)
+ oldBmp = SelectObject( memDC, hbit )
+
+ FillRect( memDC, @ps.rcPaint, ghOutput.hPanelBrush )
+
+ for i as long = lbound(gOutputTabs) to ubound(gOutputTabs)
+ rc = gOutputTabs(i).rcTab
+ if (i = gOutputTabsCurSel) or (gOutputTabs(i).isHot = true) then
+ SetBkColor( memDC, ghOutput.BackColorHot )
+ SetTextColor( memDC, ghOutput.ForeColorHot )
+ FillRect( memDC, @rc, ghOutput.hBackBrushHot )
+ else
+ SetBkColor( memDC, ghOutput.BackColor )
+ SetTextColor( memDC, ghOutput.ForeColor )
+ FillRect( memDC, @rc, ghOutput.hBackBrush )
+ end if
+ dim as long wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER or DT_SINGLELINE
+ oldFont = SelectObject( memDC, ghStatusBar.hFontStatusBar )
+ DrawText( memDC, gOutputTabs(i).wszText.sptr, -1, Cast(lpRect, @rc), wsStyle )
+ SelectObject( memDC, oldFont )
+ next
+
+ dim as HPEN hPenNull = CreatePen( PS_NULL, 1, 0 ) ' null/invisible pen
+ dim as long wsStyle = DT_NOPREFIX or DT_CENTER Or DT_TOP
+ rc = gOutputCloseRect
+ oldFont = SelectObject( memDC, ghMenuBar.hFontSymbolSmall )
+ SetTextColor( memDC, ghOutput.ForeColorHot )
+ DrawText( memDC, wszClose, -1, Cast(lpRect, @rc), wsStyle )
+ SelectObject( memDC, oldFont )
+
+ if isMouseOverRECT( hWin, rc ) then
+ ' if we are hovered over the "X" close icon rect then highlight it
+ oldPen = SelectPen( memDC, hPenNull )
+ oldBrush = SelectObject( memDC, ghOutput.hCloseBrushHot )
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SetBkColor( memDC, ghOutput.CloseBackColorHot )
+ SetTextColor( memDC, ghOutput.ForeColorHot )
+ oldFont = SelectObject( memDC, ghMenuBar.hFontSymbolSmall )
+ DrawText( memDC, wszClose, -1, Cast(lpRect, @rc), wsStyle )
+ SelectObject( memDC, oldPen )
+ SelectObject( memDC, oldFont )
+ SelectObject( memDC, oldBrush )
+ end if
+
+ ' Paint a simple line under the currently active tab
+ dim as HPEN hPenSolid = CreatePen( PS_SOLID, pWindow->ScaleY(2), ghOutput.ForeColor )
+ if gOutputTabsCurSel <> -1 then
+ rc = gOutputTabs(gOutputTabsCurSel).rcText
+ SetBkColor( memDC, ghOutput.ForeColor )
+ oldPen = SelectPen( memDC, hPenSolid )
+ MoveToEx( memDC, rc.left, rc.bottom - pWindow->ScaleY(4), Null )
+ LineTo( memDC, rc.right, rc.bottom - pWindow->ScaleY(4) )
+ SelectObject( memDC, oldPen )
+ end if
+
+ ' Paint a simple line at the top of the window that will act as a
+ ' visual separator between the Output window and the Scintilla window.
+ if hPenSolid then DeleteObject( hPenSolid )
+ hPenSolid = CreatePen( PS_SOLID, pWindow->ScaleY(1), ghOutput.Divider )
+ SetBkColor( memDC, ghOutput.BackColor )
+ oldPen = SelectPen( memDC, hPenSolid )
+ MoveToEx( memDC, ps.rcPaint.left, ps.rcPaint.top, Null )
+ LineTo( memDC, ps.rcPaint.right, ps.rcPaint.top )
+ SelectObject( memDC, oldPen )
+
+ BitBlt( hDC, 0, 0, nWidth, nHeight, memDC, 0, 0, SRCCOPY )
+
+ SelectObject( memDC, oldBmp )
+
+ ' Cleanup
+ RestoreDC( memDC, -1 )
+ DeleteObject( hbit )
+ if memDC then DeleteDC( memDC )
+
+ if hPenSolid then DeleteObject( hPenSolid )
+ if hPenNull then DeleteObject( hPenNull )
+ RestoreDC( hDC, -1 )
+
+ EndPaint( hWin, @ps )
+ exit function
+
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hWin, @frmOutputTabs_SubclassProc, uIdSubclass )
+
+ end select
+
+ ' For messages that we don't deal with
+ function = DefSubclassProc( hWin, uMsg, _wParam, _lParam )
+
+end function
+
+
+' ========================================================================================
+' frmOutput_RichEdit_SubclassProc Window procedure
+' ========================================================================================
+Function frmOutput_RichEdit_SubclassProc ( _
+ byval hWin as HWnd, _ ' // Control window handle
+ byval uMsg as UINT, _ ' // Type of message
+ byval _wParam as WPARAM, _ ' // First message parameter
+ byval _lParam as LPARAM, _ ' // Second message parameter
+ byval uIdSubclass as UINT_PTR, _ ' // The subclass ID
+ byval dwRefData as DWORD_PTR _ ' // Pointer to reference data
+ ) as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(hWin)
+
+ select case uMsg
+
+ case WM_CONTEXTMENU
+ ' Create the right click popup menu
+ dim as CWSTR wszText = RichEdit_GetSelText( hWin )
+ Dim hPopUpMenu As HMENU = CreatePopupMenu()
+ if len(wszText) then
+ AppendMenu( hPopUpMenu, MF_ENABLED, IDM_CUT, wstr("Cut") )
+ AppendMenu( hPopUpMenu, MF_ENABLED, IDM_COPY, wstr("Copy") )
+ end if
+ if RichEdit_CanPaste( hWin, 0 ) then
+ if len(wszText) then
+ AppendMenu( hPopUpMenu, MF_SEPARATOR, 0, "" )
+ end if
+ AppendMenu( hPopUpMenu, MF_ENABLED, IDM_PASTE, wstr("Paste") )
+ end if
+
+ dim as long nResult
+ nResult = TrackPopupMenu( hPopUpMenu, TPM_RETURNCMD or TPM_NONOTIFY, _
+ loword(_lParam), hiword(_lParam), 0, HWND_FRMOUTPUT, 0 )
+ select case nResult
+ case IDM_CUT: SendMessage( hWin, WM_CUT, 0, 0 )
+ case IDM_COPY: SendMessage( hWin, WM_COPY, 0, 0 )
+ case IDM_PASTE: SendMessage( hWin, WM_PASTE, 0, 0 )
+ end select
+ DestroyMenu hPopUpMenu
+ return 0
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hWin, @frmOutput_RichEdit_SubclassProc, uIdSubclass )
+ End Select
+
+ ' For messages that we don't deal with
+ function = DefSubclassProc(hWin, uMsg, _wParam, _lParam)
+
+end function
+
+' ========================================================================================
+' frmOutput Window procedure
+' ========================================================================================
+Function frmOutput_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_COMMAND, frmOutput_OnCommand)
+ HANDLE_MSG (HWnd, WM_SIZE, frmOutput_OnSize)
+ HANDLE_MSG (HWnd, WM_LBUTTONUP, frmOutput_OnLButtonUp)
+ HANDLE_MSG (HWnd, WM_LBUTTONDOWN, frmOutput_OnLButtonDown)
+ HANDLE_MSG (HWnd, WM_MOUSEMOVE, frmOutput_OnMouseMove)
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_PAINT
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDC
+
+ hDC = BeginPaint( hWnd, @ps )
+ SaveDC( hDC )
+ FillRect( hDC, @ps.rcPaint, ghOutput.hPanelBrush )
+ RestoreDC( hDC, -1 )
+ EndPaint( hWnd, @ps )
+ exit function
+
+ End Select
+
+ Function = DefWindowProc( HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' Set the colors for the frmOutput controls. This is also called when the
+' user changes the theme (dark/light)
+' ========================================================================================
+function frmOutput_SetControlColors() as long
+ dim cf as CHARFORMATW
+ cf.cbSize = sizeof(cf)
+ cf.dwMask = CFM_COLOR
+ cf.crTextColor = ghOutput.forecolorhot
+
+ dim as HWND hCtl
+ hCtl = GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTLOGFILE )
+ SendMessage( hCtl, EM_SETCHARFORMAT, SCF_ALL, cast(LPARAM, @cf) )
+ SendMessage( hCtl, EM_SETBKGNDCOLOR , 0, cast(LPARAM, ghOutput.backcolor) )
+ hCtl = GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTNOTES )
+ SendMessage( hCtl, EM_SETCHARFORMAT, SCF_ALL, cast(LPARAM, @cf) )
+ SendMessage( hCtl, EM_SETBKGNDCOLOR , 0, cast(LPARAM, ghOutput.backcolor) )
+ hCtl = GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVRESULTS )
+ ListView_SetBkColor( hCtl, ghOutput.BackColor )
+ ListView_SetTextColor( hCtl, ghOutput.ForeColorHot )
+ ListView_SetTextBkColor( hCtl, ghOutput.BackColor )
+ hCtl = GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVSEARCH )
+ ListView_SetBkColor( hCtl, ghOutput.BackColor )
+ ListView_SetTextColor( hCtl, ghOutput.ForeColorHot )
+ ListView_SetTextBkColor( hCtl, ghOutput.BackColor )
+ hCtl = GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVTODO )
+ ListView_SetBkColor( hCtl, ghOutput.BackColor )
+ ListView_SetTextColor( hCtl, ghOutput.ForeColorHot )
+ ListView_SetTextBkColor( hCtl, ghOutput.BackColor )
+ function = 0
+end function
+
+' ========================================================================================
+' frmOutput_Show
+' ========================================================================================
+Function frmOutput_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMOUTPUT = pWindow->Create( hWndParent, "", @frmOutput_WndProc, 0, 0, 0, 180, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ Dim As HWnd hCtl, hLV, hLB
+
+ ' custom tab control (we paint our Tabs on this control)
+ hCtl = _
+ pWindow->AddControl("LABEL", , IDC_FRMOUTPUT_TABS, , 0, 0, 0, OUTPUT_TABS_HEIGHT, _
+ WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or SS_NOTIFY or SS_LEFT, _
+ WS_EX_LEFT or WS_EX_LTRREADING, , _
+ cast(SUBCLASSPROC, @frmOutputTabs_SubclassProc), _
+ IDC_FRMOUTPUT_TABS, cast(DWORD_PTR, @pWindow))
+
+ hCtl = pWindow->AddControl("RICHEDIT", , IDC_FRMOUTPUT_TXTLOGFILE, "", _
+ 0, 0, 0, 0, _
+ WS_CHILD or WS_TABSTOP or WS_VSCROLL or _
+ ES_MULTILINE or ES_LEFT or ES_AUTOVSCROLL, _
+ WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR, _
+ 0, @frmOutput_RichEdit_SubclassProc, IDC_FRMOUTPUT_TXTLOGFILE, null )
+ AfxSetWindowFont( hCtl, ghStatusBar.hFontStatusBar )
+ SendMessage( hCtl, EM_SETEVENTMASK, 0, cast(LPARAM, ENM_SELCHANGE or ENM_CHANGE) )
+
+ hCtl = pWindow->AddControl("RICHEDIT", , IDC_FRMOUTPUT_TXTNOTES, "", _
+ 0, 0, 0, 0, _
+ WS_CHILD or WS_TABSTOP or WS_VSCROLL or _
+ ES_MULTILINE or ES_LEFT or ES_AUTOVSCROLL or ES_WANTRETURN, _
+ WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR, _
+ 0, @frmOutput_RichEdit_SubclassProc, IDC_FRMOUTPUT_TXTNOTES, null )
+ AfxSetWindowFont( hCtl, ghStatusBar.hFontStatusBar )
+ SendMessage( hCtl, EM_SETEVENTMASK, 0, cast(LPARAM, ENM_SELCHANGE or ENM_CHANGE) )
+ frmOutput_ShowNotes()
+
+ hLV = _
+ pWindow->AddControl("LISTVIEW", , IDC_FRMOUTPUT_LVRESULTS, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or LVS_REPORT Or LVS_SINGLESEL, _
+ WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmOutput_Listview_SubclassProc), IDC_FRMOUTPUT_LVRESULTS, Cast(DWORD_PTR, @pWindow))
+
+ ' Configure the ListView
+ AfxSetWindowFont( hLV, ghStatusBar.hFontStatusBar )
+ dim as long dwExStyle = ListView_GetExtendedListViewStyle(hLV)
+ dwExStyle = dwExStyle Or LVS_EX_FULLROWSELECT Or LVS_EX_DOUBLEBUFFER Or LVS_EX_FLATSB
+ ListView_SetExtendedListViewStyle(hLV, dwExStyle)
+ ListView_MakeHeaderFlat(hLV)
+ ListView_AddColumn( hLV, 0, "", pWindow->ScaleX(20) )
+ ListView_AddColumn( hLV, 1, L(253, "Line"), pWindow->ScaleX(75) )
+ ListView_AddColumn( hLV, 2, L(254, "File"), pWindow->ScaleX(250) )
+ ListView_AddColumn( hLV, 3, L(255, "Description"), pWindow->ScaleX(480) )
+
+ ' Search results Listview
+ hLV = _
+ pWindow->AddControl("LISTVIEW", , IDC_FRMOUTPUT_LVSEARCH, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or LVS_REPORT Or LVS_SINGLESEL, _
+ WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmOutput_Listview_SubclassProc), IDC_FRMOUTPUT_LVSEARCH, Cast(DWORD_PTR, @pWindow))
+
+ ' Configure the ListView
+ AfxSetWindowFont( hLV, ghStatusBar.hFontStatusBar )
+ dwExStyle = ListView_GetExtendedListViewStyle(hLV)
+ dwExStyle = dwExStyle Or LVS_EX_FULLROWSELECT Or LVS_EX_DOUBLEBUFFER Or LVS_EX_FLATSB
+ ListView_SetExtendedListViewStyle(hLV, dwExStyle)
+ ListView_MakeHeaderFlat(hLV)
+ ListView_AddColumn( hLV, 0, "", pWindow->ScaleX(20) )
+ ListView_AddColumn( hLV, 1, L(253, "Line"), pWindow->ScaleX(75) )
+ ListView_AddColumn( hLV, 2, L(254, "File"), pWindow->ScaleX(250) )
+ ListView_AddColumn( hLV, 3, L(255, "Description"), pWindow->ScaleX(480) )
+
+ ' TODO listview
+ hLV = _
+ pWindow->AddControl("LISTVIEW", , IDC_FRMOUTPUT_LVTODO, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or LVS_REPORT or LVS_SINGLESEL, _
+ WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmOutput_Listview_SubclassProc), IDC_FRMOUTPUT_LVTODO, Cast(DWORD_PTR, @pWindow))
+
+ ' Configure the ListView
+ AfxSetWindowFont( hLV, ghStatusBar.hFontStatusBar )
+ dwExStyle = ListView_GetExtendedListViewStyle(hLV)
+ dwExStyle = dwExStyle Or LVS_EX_FULLROWSELECT Or LVS_EX_DOUBLEBUFFER Or LVS_EX_FLATSB
+ ListView_SetExtendedListViewStyle(hLV, dwExStyle)
+ ListView_MakeHeaderFlat(hLV)
+ ListView_AddColumn( hLV, 0, "", pWindow->ScaleX(20) )
+ ListView_AddColumn( hLV, 1, L(253, "Line"), pWindow->ScaleX(75) )
+ ListView_AddColumn( hLV, 2, L(254, "File"), pWindow->ScaleX(250) )
+ ListView_AddColumn( hLV, 3, L(255, "Description"), pWindow->ScaleX(480) )
+
+ frmOutput_SetControlColors
+ frmOutput_PositionWindows
+
+ Function = 0
+
+End Function
+
diff --git a/src/frmPanel.bi b/src/frmPanel.bi
index 7a5cd3dc..8af37e90 100644
--- a/src/frmPanel.bi
+++ b/src/frmPanel.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmPanel.bi.bak b/src/frmPanel.bi.bak
new file mode 100644
index 00000000..7a5cd3dc
--- /dev/null
+++ b/src/frmPanel.bi.bak
@@ -0,0 +1,45 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+declare function frmPanel_Show( byval hWndParent as HWnd ) as LRESULT
+declare function frmPanelVScroll_Show( byval hWndParent as HWnd ) as LRESULT
+declare function frmPanelVScroll_PositionWindows( byval nShowState as long ) as LRESULT
+
+type PANEL_BUTTON_TYPE
+ wszCaption as CWSTR
+ hActionChild as HWND
+ rc as RECT
+end type
+dim shared gPanelButton(any) as PANEL_BUTTON_TYPE
+
+type PANEL_TYPE
+ hActiveChild as HWND
+ wszLabel as CWSTR
+ rcLabel as RECT
+ rcActionMenu as RECT
+end type
+dim shared gPanel as PANEL_TYPE
+
+type PANEL_VSCROLL_TYPE
+ hListBox as HWND
+ listBoxHeight as long
+ numItems as long
+ itemHeight as long
+ itemsPerPage as long
+ thumbHeight as long
+ rc as RECT
+end type
+dim shared gPanelVScroll as PANEL_VSCROLL_TYPE
+
diff --git a/src/frmPanel.inc b/src/frmPanel.inc
index 3de1796a..f1b15ee0 100644
--- a/src/frmPanel.inc
+++ b/src/frmPanel.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmPanel.inc.bak b/src/frmPanel.inc.bak
new file mode 100644
index 00000000..3de1796a
--- /dev/null
+++ b/src/frmPanel.inc.bak
@@ -0,0 +1,454 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+''
+'' frmPanel.inc
+''
+
+#include once "frmPanel.bi"
+#include once "frmExplorer.bi"
+#include once "frmBookmarks.bi"
+#include once "frmFunctions.bi"
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+function frmPanel_PositionWindows() as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMPANEL)
+ if pWindow = 0 then exit function
+
+ ' Get the entire client area
+ dim as Rect rc
+ GetClientRect( HWND_FRMPANEL, @rc )
+
+ redim gPanelButton(1) as PANEL_BUTTON_TYPE
+
+ gPanelButton(1).rc.left = rc.left
+ gPanelButton(1).rc.right = rc.right
+ gPanelButton(1).rc.bottom = rc.bottom
+ gPanelButton(1).rc.top = rc.bottom - pWindow->ScaleY(TOPTABS_HEIGHT)
+
+ gPanelButton(0).rc.left = rc.left
+ gPanelButton(0).rc.right = rc.right
+ gPanelButton(0).rc.bottom = gPanelButton(1).rc.top
+ gPanelButton(0).rc.top = gPanelButton(1).rc.top - pWindow->ScaleY(TOPTABS_HEIGHT)
+
+ if gApp.GetDocumentCount = 0 then
+ SetRectEmpty( @gPanelButton(0).rc )
+ SetRectEmpty( @gPanelButton(1).rc )
+ end if
+
+ ' show/hide of the child window is done separately in order to prevent blank client area from
+ ' painting before the lists are loaded. Allow a 2 pixel right border between listbox and
+ ' form edge in order to allow for panel resizing.
+ dim as long nLeft = 0
+ dim as long nTop = rc.top + pWindow->ScaleY(46)
+ dim as long nWidth = rc.right - rc.Left - pWindow->ScaleX(2)
+ dim as long nHeight = gPanelButton(0).rc.top - rc.top - nTop
+
+ SetWindowPos( HWND_FRMEXPLORER, 0, nLeft, nTop, nWidth, nHeight, SWP_NOZORDER or SWP_HIDEWINDOW )
+ SetWindowPos( HWND_FRMBOOKMARKS, 0, nLeft, nTop, nWidth, nHeight, SWP_NOZORDER or SWP_HIDEWINDOW )
+ SetWindowPos( HWND_FRMFUNCTIONS, 0, nLeft, nTop, nWidth, nHeight, SWP_NOZORDER or SWP_HIDEWINDOW )
+
+ select case gPanel.hActiveChild
+ case HWND_FRMEXPLORER
+ gPanel.wszLabel = L(247,"EXPLORER")
+ ShowWindow( HWND_FRMEXPLORER, SW_SHOW )
+ gPanelVScroll.hListBox = HWND_FRMEXPLORER_LISTBOX
+
+ gPanelButton(0).wszCaption = ucase( L(223,"Function List") )
+ gPanelButton(0).hActionChild = HWND_FRMFUNCTIONS
+ gPanelButton(1).wszCaption = ucase( L(188,"Bookmarks") )
+ gPanelButton(1).hActionChild = HWND_FRMBOOKMARKS
+
+ case HWND_FRMBOOKMARKS
+ gPanel.wszLabel = ucase( L(188,"Bookmarks") )
+ ShowWindow( HWND_FRMBOOKMARKS, SW_SHOW )
+ gPanelVScroll.hListBox = HWND_FRMBOOKMARKS_LISTBOX
+
+ gPanelButton(0).wszCaption = L(247,"EXPLORER")
+ gPanelButton(0).hActionChild = HWND_FRMEXPLORER
+ gPanelButton(1).wszCaption = ucase( L(223,"Function List") )
+ gPanelButton(1).hActionChild = HWND_FRMFUNCTIONS
+
+ case HWND_FRMFUNCTIONS
+ gPanel.wszLabel = ucase( L(223,"Function List") )
+ ShowWindow( HWND_FRMFUNCTIONS, SW_SHOW )
+ gPanelVScroll.hListBox = HWND_FRMFUNCTIONS_LISTBOX
+
+ gPanelButton(0).wszCaption = L(247,"EXPLORER")
+ gPanelButton(0).hActionChild = HWND_FRMEXPLORER
+ gPanelButton(1).wszCaption = ucase( L(188,"Bookmarks") )
+ gPanelButton(1).hActionChild = HWND_FRMBOOKMARKS
+ end select
+
+ ' calculate the rect for the panel label
+ with gPanel.rcLabel
+ .left = pWindow->ScaleX( 10 )
+ .top = pWindow->ScaleY( 10 )
+ .bottom = .top + pWindow->ScaleY( 20 )
+ .right = .left + _
+ pWindow->ScaleX( _
+ getTextWidth(HWND_FRMPANEL, gPanel.wszLabel, ghStatusBar.hFontStatusBar, 10) _
+ )
+ end with
+
+ ' calculate the actual more actions "..." button itself
+ dim as long ActionButtonWidth = 24
+ dim as long ActionButtonHeight = 22
+ with gPanel.rcActionMenu
+ .left = rc.right - pWindow->ScaleX(ActionButtonWidth+10)
+ .top = pWindow->ScaleY(7)
+ .right = .left + pWindow->ScaleX(ActionButtonWidth)
+ .bottom = .top + pWindow->ScaleY(ActionButtonHeight)
+ end with
+
+ AfxRedrawWindow( gPanelVScroll.hListBox )
+ AfxRedrawWindow( HWND_FRMPANEL )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmPanel
+' ========================================================================================
+function frmPanel_OnSize( _
+ byval HWnd as HWnd, _
+ byval state as UINT, _
+ byval cx as long, _
+ byval cy as long _
+ ) as LRESULT
+ if state <> SIZE_MINIMIZED then
+ ' Position all of the child windows
+ frmPanel_PositionWindows
+ end if
+ function = 0
+end function
+
+' ========================================================================================
+' Do hit test to determine if "..." button in action Area was clicked
+' ========================================================================================
+function isPanelActionButtonHitTest( byval hWin as HWnd ) as boolean
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ if PtInRect( @gPanel.rcActionMenu, pt ) then return true
+ function = false
+end function
+
+' ========================================================================================
+' Do hit test on Button0
+' ========================================================================================
+function isPanelButton0HitTest( byval hWin as HWnd ) as boolean
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ if PtInRect( @gPanelButton(0).rc, pt ) then return true
+ function = false
+end function
+
+' ========================================================================================
+' Do hit test on Button1
+' ========================================================================================
+function isPanelButton1HitTest( byval hWin as HWnd ) as boolean
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ if PtInRect( @gPanelButton(1).rc, pt ) then return true
+ function = false
+end function
+
+' ========================================================================================
+' Process WM_PAINT message for window/dialog: frmPanel
+' ========================================================================================
+function frmPanel_OnPaint( byval HWnd as HWnd ) as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMPANEL)
+ if pWindow = 0 then exit function
+
+ dim as PAINTSTRUCT ps
+ dim as HDC hDc
+ dim as HPEN oldPen
+ dim as HFONT oldFont
+ dim as HBRUSH oldBrush
+
+ hDC = BeginPaint(hWnd, @ps)
+
+ SaveDC( hDC )
+
+ FillRect( hDC, @ps.rcPaint, ghPanel.hPanelBrush )
+
+ ' Draw the panel Label
+ SetTextColor( hDC, ghPanel.forecolor )
+ SetBkColor( hDC, ghPanel.backcolor )
+ oldFont = SelectObject( hDC, ghStatusBar.hFontStatusBar )
+
+ dim as long wsStyle = DT_NOPREFIX or DT_LEFT or DT_VCENTER or DT_SINGLELINE
+ DrawText( hDC, gPanel.wszLabel.sptr, -1, cast(lpRect, @gPanel.rcLabel), wsStyle )
+ SelectObject( hDC, oldFont )
+
+ ' Draw the "..." menu item
+ SetTextColor( hDC, ghPanel.ForeColorHot )
+ if isPanelActionButtonHitTest( HWnd ) then
+ oldBrush = SelectObject( hDC, ghPanel.hBackBrushHot )
+ SetBkColor( hDC, ghPanel.BackColorHot )
+ else
+ oldBrush = SelectObject( hDC, ghPanel.hPanelBrush )
+ SetBkColor( hDC, ghPanel.BackColor )
+ end if
+ dim as RECT rc = gPanel.rcActionMenu
+
+ dim as HPEN hPenNull = CreatePen( PS_NULL, 1, 0 ) ' null/invisible pen
+ oldPen = SelectObject( hDC, hPenNull )
+ RoundRect( hDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ DeleteObject SelectObject( hDC, oldPen )
+
+ wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER
+ oldFont = SelectObject( hDC, ghMenuBar.hFontSymbolLargeBold )
+ DrawText( hDC, wszMoreActions, -1, Cast(lpRect, @rc), wsStyle )
+ SelectObject( hDC, oldFont )
+ SelectObject( hDC, oldBrush )
+
+ ' Draw the bottom two Panel buttons
+ dim as long penWidth = pWindow->ScaleX(1)
+ dim as HPEN hPenSolid = CreatePen( PS_SOLID, penWidth, ghTopTabs.Divider )
+ oldPen = SelectObject( hDC, hPenSolid)
+
+ dim as HBRUSH hBrush
+ dim as COLORREF foreclr, backclr
+ dim as boolean isHot
+
+ for i as long = lbound(gPanelButton) to ubound(gPanelButton)
+ dim as RECT rc = gPanelButton(i).rc
+
+ isHot = isMouseOverRECT( HWnd, rc )
+ hBrush = iif( isHot, ghPanel.hBackBrushButtonHot, ghPanel.hBackBrushButton)
+ backclr = iif( isHot, ghPanel.BackColorButtonHot, ghPanel.BackColorButton)
+ foreclr = iif( isHot, ghPanel.ForeColorButtonHot, ghPanel.ForeColorButton)
+
+ oldBrush = SelectObject( hDC, hBrush )
+ SetBkColor( hDC, backclr )
+ SetTextColor( hDC, foreclr )
+
+ SelectPen( hDC, hPenSolid )
+ Rectangle( hDC, rc.left, rc.top, rc.right, rc.bottom )
+ wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER or DT_SINGLELINE
+ oldFont = SelectObject( hDC, ghStatusBar.hFontStatusBar )
+ DrawText( hDC, gPanelButton(i).wszCaption.sptr, -1, Cast(lpRect, @rc), wsStyle )
+
+ SelectObject( hDC, oldFont )
+ SelectObject( hDC, oldBrush )
+ next
+
+ DeleteObject SelectObject( hDC, oldPen )
+ RestoreDC( hDC, -1 )
+
+ EndPaint( hWnd, @ps )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmPanel Window procedure
+' ========================================================================================
+function frmPanel_WndProc( _
+ byval HWnd as HWnd, _
+ byval uMsg as UINT, _
+ byval wParam as WPARAM, _
+ byval lParam as LPARAM _
+ ) as LRESULT
+
+ static as boolean isPrevHotAction, isPrevHotButton0, isPrevHotButton1
+ static hTooltip as HWND
+
+ select case uMsg
+ HANDLE_MSG (HWnd, WM_SIZE, frmPanel_OnSize)
+ HANDLE_MSG (HWnd, WM_PAINT, frmPanel_OnPaint)
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_MOUSEMOVE
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMEXPLORER)
+ if pWindow = 0 then exit function
+
+ dim tme as TrackMouseEvent
+ tme.cbSize = sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER or TME_LEAVE
+ tme.hwndTrack = HWnd
+ TrackMouseEvent(@tme)
+
+ ' Repaint the gPanelMenuRect to ensure Hot highlighting
+ dim as boolean isHotAction, isHotButton0, isHotButton1
+ isHotAction = isPanelActionButtonHitTest( HWnd )
+ isHotButton0 = isPanelButton0HitTest( HWnd )
+ isHotButton1 = isPanelButton1HitTest( HWnd )
+
+ if isHotAction <> isPrevHotAction then
+ AfxRedrawWindow( HWnd )
+ isPrevHotAction = isHotAction
+ end if
+
+ if isHotButton0 <> isPrevHotButton0 then
+ AfxRedrawWindow( HWnd )
+ isPrevHotButton0 = isHotButton0
+ end if
+
+ if isHotButton1 <> isPrevHotButton1 then
+ AfxRedrawWindow( HWnd )
+ isPrevHotButton1 = isHotButton1
+ end if
+
+ ' PANELS LEFT/RIGHT SPLITTER
+ dim as POINT pt
+ dim as Rect rc
+ GetWindowRect HWND_FRMPANEL, @rc
+ rc.Left = rc.Right - pWindow->ScaleX(3)
+ GetCursorPos(@pt)
+ if PtInRect( @rc, pt ) then
+ if WindowFromPoint(pt) = HWND_FRMPANEL then
+ SetCursor( ghCursorSizeWE )
+ end if
+ end if
+
+ if gApp.bDragActive then
+ if gApp.hWndPanel = HWND_FRMPANEL then
+ ' Get the current rect of the frmExplorer and compare right side to the current cursor position
+ ' and then move the right side to equal the cursor position.
+ dim as long nDiff = pt.x - rc.Right
+ GetClientRect HWND_FRMPANEL, @rc
+ dim as long nWidth = (rc.Right - rc.Left + nDiff)
+ ' make sure width does not go below a specific size otherwise the user will not
+ ' be able to grab the panel edge to resize
+ nWidth = max( nWidth, pWindow->ScaleX(80) )
+ SetWindowPos( HWND_FRMPANEL, 0, 0, 0, nWidth, rc.Bottom - rc.Top, SWP_NOMOVE or SWP_NOZORDER )
+ frmMain_PositionWindows
+ AfxRedrawWindow(HWnd) ' ensure the More Actions menu repaints
+ AfxDoEvents ' allow screen to repaint
+ end if
+ end if
+
+ case WM_LBUTTONDOWN
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMPANEL)
+ if pWindow = 0 then exit function
+
+ ' PANELS LEFT/RIGHT SPLITTER
+ dim as Rect rc
+ dim as Point pt
+
+ gApp.bDragActive = false
+ GetWindowRect HWND_FRMPANEL, @rc
+ rc.Left = rc.Right - pWindow->ScaleX(3)
+ GetCursorPos(@pt)
+ if PtInRect( @rc, pt ) then
+ if WindowFromPoint(pt) = HWND_FRMPANEL then
+ SetCursor( ghCursorSizeWE )
+ gApp.bDragActive = true
+ gApp.hWndPanel = HWND_FRMPANEL
+ SetCapture( HWND_FRMPANEL )
+ end if
+ end if
+
+ case WM_LBUTTONUP
+ if gApp.bDragActive then
+ gApp.bDragActive = false
+ gApp.hWndPanel = 0
+ ReleaseCapture()
+ end if
+ if isPanelActionButtonHitTest( HWnd ) then
+ dim as HMENU hPopupMenu
+ select case gPanel.hActiveChild
+ case HWND_FRMEXPLORER
+ hPopupMenu = CreateExplorerActionButtonContextMenu()
+ case HWND_FRMFUNCTIONS
+ hPopupMenu = CreateFunctionsActionButtonContextMenu()
+ case HWND_FRMBOOKMARKS
+ hPopupMenu = CreateBookmarksActionButtonContextMenu()
+ end select
+ ' Popup the menu to the bottom of the Action Button (right aligned)
+ dim as RECT rc = gPanel.rcActionMenu ' work with a copy
+ MapWindowPoints( HWND_FRMPANEL, HWND_DESKTOP, cast(POINT ptr, @rc), 2 )
+ TrackPopupMenu( hPopUpMenu, TPM_RIGHTALIGN, _
+ rc.right, rc.bottom, 0, HWND_FRMMAIN, byval null)
+ DestroyMenu( hPopUpMenu )
+ Return true ' prevent further processing that leads to WM_CONTEXTMENU
+ end if
+
+ if isPanelButton0HitTest( HWnd ) then
+ gPanel.hActiveChild = gPanelButton(0).hActionChild
+ frmPanel_PositionWindows()
+ end if
+
+ if isPanelButton1HitTest( HWnd ) then
+ gPanel.hActiveChild = gPanelButton(1).hActionChild
+ frmPanel_PositionWindows()
+ end if
+
+
+ case WM_MOUSELEAVE
+ isPrevHotAction = false
+ isPrevHotButton0 = false
+ isPrevHotButton1 = false
+ AfxDeleteTooltip( hTooltip, HWnd )
+ hTooltip = 0
+ AfxRedrawWindow(HWnd)
+
+ case WM_MOUSEHOVER
+ dim as CWSTR wszTooltip
+ if IsWindow(hTooltip) = 0 then hTooltip = AfxAddTooltip( HWnd, "", false, false )
+ if isPanelActionButtonHitTest( HWnd ) then
+ wszTooltip = L(440, "More Actions") & "..."
+ end if
+ ' Display the tooltip
+ AfxSetTooltipText( hTooltip, HWnd, wszTooltip )
+ AfxRedrawWindow( HWnd )
+
+ end select
+
+ ' for messages that we don't deal with
+ function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+end function
+
+
+' ========================================================================================
+' frmPanel_Show
+' ========================================================================================
+function frmPanel_Show( byval hWndParent as HWnd ) as LRESULT
+
+ ' Create the main window and child controls
+ dim pWindow as CWindow ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ ' Only make the Panel initially visible if it was already visible
+ ' when the most previous instance of the program closed. Also, set the width of
+ ' the window to the last used visible width.
+ dim as long nWidth = iif(gConfig.ShowPanel, gConfig.ShowPanelWidth, 250)
+
+ HWND_FRMPANEL = pWindow->Create( hWndParent, "Panel Window", @frmPanel_WndProc, _
+ 0, 0, nWidth, 0, _
+ WS_CHILD or iif(gConfig.ShowPanel, WS_VISIBLE, 0) or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT or WS_EX_LEFT or WS_EX_LTRREADING or WS_EX_RIGHTSCROLLBAR)
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ ' Create the Explorer child window
+ frmExplorer_Show( HWND_FRMPANEL )
+ frmBookmarks_Show( HWND_FRMPANEL )
+ frmFunctions_Show( HWND_FRMPANEL )
+ gPanel.hActiveChild = HWND_FRMEXPLORER
+
+ function = 0
+
+end function
diff --git a/src/frmPanelVScroll.inc b/src/frmPanelVScroll.inc
index dcdc2c62..a70c4f8f 100644
--- a/src/frmPanelVScroll.inc
+++ b/src/frmPanelVScroll.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmPanelVScroll.inc.bak b/src/frmPanelVScroll.inc.bak
new file mode 100644
index 00000000..dcdc2c62
--- /dev/null
+++ b/src/frmPanelVScroll.inc.bak
@@ -0,0 +1,270 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+''
+'' frmPanelVScroll.inc
+''
+
+#include once "frmPanel.bi"
+
+
+' ========================================================================================
+' Calculate the RECT that holds the client coordinates of the scrollbar's vertical thumb
+' Returns True if RECT is not empty
+' ========================================================================================
+function frmPanelVScroll_calcVThumbRect() as boolean
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMPANEL)
+ if pWindow = 0 then exit function
+
+ ' calculate the vertical scrollbar in client coordinates
+ SetRectEmpty( @gPanelVScroll.rc )
+
+ dim as long nTopIndex = SendMessage( gPanelVScroll.hListBox, LB_GETTOPINDEX, 0, 0 )
+
+ dim as RECT rc
+ with gPanelVScroll
+ GetClientRect( gPanelVScroll.hListBox, @rc )
+ .listBoxHeight = rc.bottom - rc.top
+ .itemHeight = SendMessage( gPanelVScroll.hListBox, LB_GETITEMHEIGHT, 0, 0 )
+ .numItems = ListBox_GetCount( gPanelVScroll.hListBox )
+ .itemsPerPage = .listBoxHeight / .itemHeight
+ .thumbHeight = (.itemsPerPage / .numItems) * .listBoxHeight
+ GetClientRect( HWND_FRMPANEL_VSCROLLBAR, @rc )
+ .rc.Left = rc.Left
+ .rc.top = rc.top + ((nTopIndex / .numItems) * .listBoxHeight)
+ .rc.Right = rc.right
+ .rc.bottom = .rc.top + .thumbHeight
+ if .numItems < .itemsPerPage then return true
+ end with
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Update the VScrollBar UI via UpdateLayeredWindow
+' ========================================================================================
+function frmPanelVScroll_UpdateUI() as LRESULT
+ dim as long nWidth = AfxGetWindowWidth( HWND_FRMPANEL_VSCROLLBAR )
+ dim as long nHeight = AfxGetWindowHeight( HWND_FRMPANEL_VSCROLLBAR )
+
+ '// Make mem DC + mem bitmap
+ dim as HDC hdcScreen = GetDC(null)
+ dim as HDC hDC = CreateCompatibleDC(hdcScreen)
+ dim as HBITMAP hBmp = CreateCompatibleBitmap(hdcScreen, nWidth, nHeight)
+ dim as HBITMAP hBmpOld = SelectObject(hDC, hBmp)
+
+ '// Draw to StatusBar into the memory DC
+ FillRect( hDC, @gPanelVScroll.rc, ghPanel.hBackBrushThumb )
+
+ '// Call UpdateLayeredWindow
+ dim as BLENDfunction blend
+ blend.BlendOp = AC_SRC_OVER
+ blend.SourceConstantAlpha = 200 '255
+ blend.AlphaFormat = AC_SRC_ALPHA
+
+ dim as POINT ptPos
+ dim as RECT rc = AfxGetWindowRect( HWND_FRMPANEL_VSCROLLBAR )
+ ptPos.x = rc.left
+ ptPos.y = rc.top
+ dim as SIZE sizeWnd = (nWidth, nHeight)
+ dim as POINT ptSrc = (0, 0)
+
+ UpdateLayeredWindow ( _
+ HWND_FRMPANEL_VSCROLLBAR, _ ' A handle to a layered window
+ hdcScreen, _ ' A handle to a DC for the screen
+ @ptPos, _ ' New screen position. pptDst can be NULL if not changing
+ @sizeWnd, _ ' New size. psize can be NULL if not changing
+ hDC, _ ' Handle to DC of layered window from CreateCompatibleDC
+ @ptSrc, _ ' The location of the layer in the device context
+ 0, _ ' COLORREF color key to be used when composing the layered window
+ @blend, _ ' Pointer to BLENDfunction structure
+ ULW_ALPHA ) ' Use pblend as the blend function
+
+ SelectObject( hDC, hBmpOld )
+ DeleteObject( hBmp )
+ DeleteDC( hDC )
+ ReleaseDC( null, hdcScreen )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Position the VScrollBar over the Explorer listbox
+' ========================================================================================
+function frmPanelVScroll_PositionWindows( byval nShowState as long ) as LRESULT
+
+ dim pWindow as CWindow ptr = AfxCWindowPtr(HWND_FRMPANEL_VSCROLLBAR)
+ if pWindow = 0 then exit function
+
+ ' Position the VScrollBar relative to the Explorer Listbox using screen coordinates
+ dim as Rect rc = AfxGetWindowRect( gPanelVScroll.hListBox )
+ dim as long nScrollWidth = pWindow->ScaleX(SCROLLBAR_WIDTH_PANEL)
+
+ SetWindowPos( HWND_FRMPANEL_VSCROLLBAR, HWND_TOP, _
+ rc.right - nScrollWidth, _
+ rc.top, _
+ nScrollWidth, _
+ rc.bottom - rc.top, _
+ SWP_NOACTIVATE )
+
+ ' returns true if RECT is empty
+ if frmPanelVScroll_calcVThumbRect() then nShowState = SW_HIDE
+ ShowWindow( HWND_FRMPANEL_VSCROLLBAR, nShowState )
+ if nShowState = SW_HIDE then exit function
+
+ if gApp.isWineActive then
+ AfxRedrawWindow( HWND_FRMPANEL_VSCROLLBAR )
+ else
+ frmPanelVScroll_UpdateUI()
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmPanelVScroll Window procedure
+' ========================================================================================
+function frmPanelVScroll_WndProc( _
+ byval HWnd as HWnd, _
+ byval uMsg as UINT, _
+ byval wParam as WPARAM, _
+ byval lParam as LPARAM _
+ ) as LRESULT
+
+ static as POINT prev_pt ' screen pt.y cursor position
+
+ select case uMsg
+ case WM_LBUTTONDOWN
+ dim as POINT pt: GetCursorPos( @pt )
+ frmPanelVScroll_calcVThumbRect() ' in client coordinates
+ dim as RECT rc = gPanelVScroll.rc ' covert copy to screen coordinates
+ MapWindowPoints( HWND_FRMPANEL_VSCROLLBAR, HWND_DESKTOP, cast(POINT ptr, @rc), 2)
+ if PtInRect( @rc, pt ) then
+ prev_pt = pt
+ gApp.bDragActive = true
+ SetCapture( HWnd )
+ else
+ ' we have clicked on a PageUp or PageDn
+ dim as long nTopIndex = SendMessage( gPanelVScroll.hListBox, LB_GETTOPINDEX, 0, 0 )
+ if pt.y < rc.top then
+ nTopIndex = max( nTopIndex - gPanelVScroll.itemsPerPage, 0 )
+ SendMessage( gPanelVScroll.hListBox, LB_SETTOPINDEX, nTopIndex, 0 )
+ frmPanelVScroll_calcVThumbRect() ' in client coordinates
+ if gApp.isWineActive then
+ AfxRedrawWindow( HWND_FRMPANEL_VSCROLLBAR )
+ else
+ frmPanelVScroll_UpdateUI()
+ end if
+ AfxRedrawWindow( gPanelVScroll.hListBox )
+ elseif pt.y > rc.bottom then
+ dim as long nMaxTopIndex = gPanelVScroll.numItems - gPanelVScroll.itemsPerPage
+ nTopIndex = min( nTopIndex + gPanelVScroll.itemsPerPage, nMaxTopIndex )
+ SendMessage( gPanelVScroll.hListBox, LB_SETTOPINDEX, nTopIndex, 0 )
+ frmPanelVScroll_calcVThumbRect() ' in client coordinates
+ if gApp.isWineActive then
+ AfxRedrawWindow( HWND_FRMPANEL_VSCROLLBAR )
+ else
+ frmPanelVScroll_UpdateUI()
+ end if
+ AfxRedrawWindow( gPanelVScroll.hListBox )
+ end if
+ end if
+
+ case WM_MOUSEMOVE
+ if gApp.bDragActive then
+ dim as POINT pt: GetCursorPos( @pt )
+ if pt.y <> prev_pt.y then
+ dim as long delta = pt.y - prev_pt.y
+ ' convert to client coordinates for ease of use
+ dim as RECT rc: GetClientRect( HWND_FRMPANEL_VSCROLLBAR, @rc )
+
+ gPanelVScroll.rc.top = max(0, gPanelVScroll.rc.top + delta)
+ gPanelVScroll.rc.top = min(gPanelVScroll.rc.top, rc.bottom-gPanelVScroll.thumbHeight)
+ gPanelVScroll.rc.bottom = gPanelVScroll.rc.top + gPanelVScroll.thumbHeight
+
+ prev_pt = pt
+
+ dim as long nPrevTopIndex = SendMessage( gPanelVScroll.hListBox, LB_GETTOPINDEX, 0, 0 )
+ dim as long nLastIndex = (gPanelVScroll.rc.bottom / rc.bottom) * gPanelVScroll.numItems
+ dim as long nTopIndex = nLastIndex - gPanelVScroll.itemsPerPage
+ if nTopIndex <> nPrevTopIndex then
+ SendMessage( gPanelVScroll.hListBox, LB_SETTOPINDEX, nTopIndex, 0 )
+ AfxRedrawWindow( gPanelVScroll.hListBox )
+ end if
+
+ if gApp.isWineActive then
+ AfxRedrawWindow( HWND_FRMPANEL_VSCROLLBAR )
+ else
+ frmPanelVScroll_UpdateUI()
+ end if
+ end if
+ end if
+
+ case WM_LBUTTONUP
+ gApp.bDragActive = false
+ prev_pt.x = 0
+ prev_pt.y = 0
+ ReleaseCapture
+
+
+ case WM_ERASEBKGND
+ if gApp.isWineActive then
+ return true
+ end if
+
+ case WM_PAINT
+ if gApp.isWineActive then
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDC
+ hDC = BeginPaint( hWnd, @ps )
+ FillRect( hDC, @ps.rcPaint, ghPanel.hBackBrushScrollBar )
+ FillRect( hDC, @gPanelVScroll.rc, ghPanel.hBackBrushThumb )
+ EndPaint hWnd, @ps
+ exit function
+ end if
+
+ end select
+
+ ' for messages that we don't deal with
+ function = DefWindowProc( HWnd, uMsg, wParam, lParam )
+
+end function
+
+
+' ========================================================================================
+' frmPanelVScroll_Show
+' ========================================================================================
+function frmPanelVScroll_Show( byval hWndParent as HWND ) as LRESULT
+
+ ' Create the main window and child controls
+ dim pWindow as CWindow ptr = new CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ dim as long ExStyles = WS_EX_NOACTIVATE
+ if gApp.isWineActive = false then
+ ExStyles = ExStyles or WS_EX_LAYERED
+ end if
+
+ HWND_FRMPANEL_VSCROLLBAR = pWindow->Create( hWndParent, _
+ "", @frmPanelVScroll_WndProc, 0, 0, SCROLLBAR_WIDTH_PANEL, 0, _
+ WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
+ ExStyles )
+ pWindow->Brush = ghPanel.hBackBrushScrollBar
+
+ function = 0
+
+end function
diff --git a/src/frmPopupMenu.inc b/src/frmPopupMenu.inc
index b00fc61d..2e27d834 100644
--- a/src/frmPopupMenu.inc
+++ b/src/frmPopupMenu.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmPopupMenu.inc.bak b/src/frmPopupMenu.inc.bak
new file mode 100644
index 00000000..b00fc61d
--- /dev/null
+++ b/src/frmPopupMenu.inc.bak
@@ -0,0 +1,652 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+declare function frmPopupMenu_Show(byval nPopupType as long, byval nItemID as long, ByVal hParent as HWND) As HWND
+
+dim shared as HWND HWND_MENU(1)
+dim shared as HWND HWND_SHADOW(1)
+
+const ID_POPUP = 0
+const ID_SUBPOPUP = 1
+const IDC_MENU_LISTBOX = 100
+
+
+' ========================================================================================
+' Move highlight to next valid menuitem. This will simulate keyboard control.
+' ========================================================================================
+function setNextMenuItemTabIndex( byval bReverse as boolean ) as long
+ ' Determine the active popup menu that our "cursor' is on
+ dim as HWND hActiveWindow = iif( IsWindowVisible( HWND_MENU(1)), HWND_MENU(1), HWND_MENU(0) )
+ dim as HWND hListBox = GetDlgItem( hActiveWindow, IDC_MENU_LISTBOX )
+
+ ' bypass any disabled menuitems and loop to start if needed
+ dim as long nCount = ListBox_GetCount( hListBox )
+ dim as long nCurSel = ListBox_GetCurSel( hListBox )
+ dim as long nFound = -1
+
+ if bReverse then
+ for i as long = nCursel - 1 to 0 step -1
+ dim as long nIdx = ListBox_GetItemData( hListBox, i )
+ if (gTopMenu(nIdx).isDisabled = false) and (gTopMenu(nIdx).isSeparator = false) then
+ nFound = i: exit for
+ end if
+ next
+ if nFound = -1 then nFound = nCount - 1 ' wrap to end of list
+ else
+ for i as long = nCursel + 1 to nCount - 1
+ dim as long nIdx = ListBox_GetItemData( hListBox, i )
+ if (gTopMenu(nIdx).isDisabled = false) and (gTopMenu(nIdx).isSeparator = false) then
+ nFound = i: exit for
+ end if
+ next
+ if nFound = -1 then nFound = 0 ' wrap to start of list
+ end if
+
+ if hActiveWindow = HWND_MENU(0) then gMenuLastCurSel = nFound
+ ListBox_SetCurSel( hListBox, nFound )
+ AfxRedrawWindow( hListBox )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Kill all popup menus and reset variables. Do this when app loses focus or the user
+' clicks somewhere away from the menu.
+' ========================================================================================
+function killPopupMenus() as boolean
+ if HWND_MENU(0) then
+ DestroyWindow(HWND_MENU(0))
+ HWND_MENU(0) = 0
+ return true
+ end if
+end function
+
+function killPopupSubMenus() as boolean
+ if HWND_MENU(1) then
+ DestroyWindow(HWND_MENU(1))
+ HWND_MENU(1) = 0
+ return true
+ end if
+end function
+
+function killAllPopupMenus() as boolean
+ killPopupSubMenus()
+ killPopupMenus()
+ gMenuLastCurSel = -1
+ gPrevent_WM_NCACTIVATE = false
+ ' unhighlight any previous hot menubar button
+ dim as HWND hCtrl = ghWndActiveMenuBarButton
+ ghWndActiveMenuBarButton = 0
+ if hCtrl then AfxRedrawWindow(hCtrl)
+ return true
+end function
+
+
+' ========================================================================================
+' Fill the bitmap with semi transparent values
+' ========================================================================================
+function bitmapFillAlpha(byval hBmp as HBITMAP, byval clrRGBA as integer ) as Boolean
+
+ dim as Boolean bResult = false
+
+ if (hBmp) then
+ dim as BITMAP bmp
+ GetObject(hBmp, sizeof(BITMAP), @bmp)
+ dim as DWORD dwCount = bmp.bmWidthBytes * bmp.bmHeight
+ if (dwCount >= sizeof(DWORD)) then
+ dim as DWORD ptr pcBitsWords = cast(DWORD ptr, bmp.bmBits)
+ if (pcBitsWords) then
+ dim as DWORD dwIndex = (dwCount / sizeof(DWORD)) - 1
+ dim as DWORD dwUp = bmp.bmWidth
+ dim as DWORD dwDn = dwIndex -dwUp
+ dim as DWORD dwR = bmp.bmWidth -1
+ while dwIndex
+ dim as DWORD dwSides = dwIndex mod bmp.bmWidth
+ if (dwIndex < dwUp) or (dwIndex > dwDn) or (dwSides = 0) or(dwSides = dwR) then
+ pcBitsWords[dwIndex] = clrRGBA 'sm_clrPenA; // 0xFF0080FF
+ else
+ pcBitsWords[dwIndex] = clrRGBA 'sm_clrBrushA; // 0x400020FF
+ end if
+ dwIndex = dwIndex - 1
+ wend
+ bResult = true
+ end if
+ end if
+ end if
+ return bResult
+end function
+
+' ========================================================================================
+' Create/Display the alpha blended shadow for the WS_EX_LAYERED window
+' ========================================================================================
+function paintLayeredWindow( byval HWnd as HWnd, byval clrRGBA as integer ) as long
+ dim as RECT rcPos = AfxGetWindowRect(HWnd)
+
+ dim as HDC hdcScreen = GetDC(0)
+ dim as HDC hDC = CreateCompatibleDC(hdcScreen)
+ dim as long iWidth = rcPos.right - rcPos.left
+ dim as long iHeight = rcPos.bottom - rcPos.top
+
+ dim as BITMAPINFO sBI
+ sBI.bmiHeader.biSize = sizeof(BITMAPINFOHEADER)
+ sBI.bmiHeader.biWidth = iWidth
+ sBI.bmiHeader.biHeight = iHeight
+ sBI.bmiHeader.biPlanes = 1
+ sBI.bmiHeader.biBitCount = 32
+ sBI.bmiHeader.biCompression = BI_RGB
+
+ dim as HBITMAP hBmp = CreateDIBSection(hDC, @sBI, DIB_RGB_COLORS, NULL, NULL, 0)
+ dim as HBITMAP hBmpOld = SelectObject(hDC, hBmp)
+
+ dim as Boolean bFillAlphaOK = bitmapFillAlpha(hBmp, clrRGBA)
+ dim as BLENDFUNCTION blend
+ blend.BlendOp = AC_SRC_OVER
+ blend.SourceConstantAlpha = iif(bFillAlphaOK, 160, 64)
+ blend.AlphaFormat = iif(bFillAlphaOK, AC_SRC_ALPHA, 0)
+
+ ' Destination position at the screen
+ dim as POINT ptPos = (rcPos.left, rcPos.top)
+
+ ' Source position in source (memory DC)
+ dim as point ptSrc = (0,0)
+
+ ' Dimensions of the bits transfer
+ dim as SIZE sizeWnd = (iWidth, iHeight)
+
+ UpdateLayeredWindow(HWnd, hdcScreen, @ptPos, @sizeWnd, hDC, @ptSrc, 0, @blend, ULW_ALPHA)
+
+ SelectObject(hDC, hBmpOld)
+ DeleteObject(hBmp)
+ DeleteDC(hDC)
+ ReleaseDC(0, hdcScreen)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_MEASUREITEM message for window/dialog: frmPopupMenu
+' ========================================================================================
+function frmPopupMenu_OnMeasureItem( _
+ ByVal HWnd As HWnd, _
+ ByVal lpmis As MEASUREITEMSTRUCT Ptr _
+ ) As Long
+ ' Set the height of the menuitem list box items.
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ lpmis->itemHeight = pWindow->ScaleY(MENUITEM_HEIGHT)
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DRAWITEM message for window/dialog: frmPopupMenu
+' ========================================================================================
+function frmPopupMenu_OnDrawItem( _
+ ByVal HWnd As HWnd, _
+ ByVal lpdis As Const DRAWITEMSTRUCT Ptr _
+ ) As Long
+
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(HWND_FRMMAIN)
+ If pWindow = 0 Then Exit Function
+
+ if lpdis = 0 then exit function
+
+ if ( lpdis->itemAction = ODA_DRAWENTIRE ) orelse _
+ ( lpdis->itemAction = ODA_SELECT ) orelse _
+ ( lpdis->itemAction = ODA_FOCUS ) then
+
+ dim as RECT rc = lpdis->rcItem
+ dim as long nWidth = rc.right-rc.left
+ dim as long nHeight = rc.bottom-rc.top
+
+ SaveDC(lpdis->hDC)
+
+ Dim memDC as HDC ' Double buffering
+ Dim hbit As HBITMAP ' Double buffering
+ dim as HPEN oldPen
+ dim as HBRUSH oldBrush
+ dim as HFONT oldFont
+ dim as HFONT oldBmp
+
+ memDC = CreateCompatibleDC( lpdis->hDC )
+ hbit = CreateCompatibleBitmap( lpdis->hDC, nWidth, nHeight )
+
+ SaveDC(memDC)
+ oldBmp = SelectObject( memDC, hbit )
+
+ dim as CWSTR wszCaption
+ dim as long wsStyle
+
+ dim as HBRUSH hBrush
+ dim as COLORREF foreclr, backclr
+
+ dim as long idx = ListBox_GetItemData( lpdis->hwndItem, lpdis->ItemID )
+ dim pMenu as TOPMENU_TYPE ptr = @gTopMenu(idx)
+
+ wszCaption = getMenuText(pMenu->nID)
+
+ if (pMenu->isSeparator = true) orelse (pMenu->isDisabled = true) then
+ hBrush = ghPopup.hBackBrushDisabled
+ foreclr = ghPopup.ForeColorDisabled
+ backclr = ghPopup.BackColorDisabled
+ else
+ dim as boolean IsHot = false
+ if ListBox_GetCurSel(lpdis->hwndItem) = lpdis->itemID then IsHot = true
+ hBrush = iif( IsHot, ghPopup.hBackBrushHot, ghPopup.hBackBrush)
+ backclr = iif( IsHot, ghPopup.BackColorHot, ghPopup.BackColor)
+ foreclr = iif( IsHot, ghPopup.ForeColorHot, ghPopup.ForeColor)
+ end if
+
+ ' Paint the entire background
+ ' Create our rect that works with the entire line
+ SetRect(@rc, 0, 0, nWidth, nHeight)
+ FillRect( memDC, @rc, hBrush )
+
+ SetBkColor( memDC, backclr )
+ SetTextColor( memDC, foreclr )
+
+ dim as RECT rcText = rc
+
+ if pMenu->isSeparator then
+ rcText.left = rcText.left + pWindow->ScaleX(12)
+ rcText.right = rcText.right - pWindow->ScaleX(12)
+ dim as HPEN hPen = CreatePen( PS_SOLID, 1, ghPopup.ForeColorDisabled )
+ oldPen = SelectObject( memDC, hPen )
+ MoveToEx( memDC, rcText.Left, (rcText.bottom-rcText.top) / 2, null )
+ LineTo( memDC, rcText.Right, (rcText.bottom-rcText.top) / 2 )
+ SelectObject( memDC, oldPen )
+ DeleteObject( hPen )
+ else
+ dim as RECT rcBitmap = rcText
+ ' Handle caption, keyboard accelerator or submenu marker
+ dim as CWSTR wszLeft = AfxStrParse(wszCaption, 1, chr(9))
+ dim as CWSTR wszRight = AfxStrParse(wszCaption, 2, chr(9))
+ ' checkmark
+ if pMenu->isChecked then
+ rcBitmap.Right = rcBitmap.Left + pWindow->ScaleX(30)
+ wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER or DT_SINGLELINE
+ oldFont = SelectObject( memDC, ghMenuBar.hFontSymbol )
+ DrawText( memDC, wszCheckmark, -1, Cast(lpRect, @rcBitmap), wsStyle )
+ SelectObject( memDC, oldFont )
+ end if
+ oldFont = SelectObject( memDC, ghMenuBar.hFontMenuBar )
+ rcText.left = rcText.left + pWindow->ScaleX(30)
+ rcText.right = rcText.right - pWindow->ScaleX(30)
+
+ ' caption
+ wsStyle = DT_NOPREFIX or DT_LEFT Or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszLeft.sptr, -1, Cast(lpRect, @rcText), wsStyle )
+
+ ' keyboard accelerator
+ wsStyle = DT_NOPREFIX or DT_RIGHT Or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszRight.sptr, -1, Cast(lpRect, @rcText), wsStyle )
+ SelectObject( memDC, oldFont )
+
+ ' submenu arrow
+ if pMenu->nChildID then
+ rcBitmap = rcText
+ rcBitmap.Left = rcText.Right
+ rcBitmap.Right = rcBitmap.Left + pWindow->ScaleX(20)
+ oldFont = SelectObject( memDC, ghMenuBar.hFontSymbol )
+ wsStyle = DT_NOPREFIX or DT_RIGHT Or DT_TOP or DT_SINGLELINE
+ DrawText( memDC, wszChevronRight, -1, Cast(lpRect, @rcBitmap), wsStyle )
+ SelectObject( memDC, oldFont )
+ end if
+ end if
+
+ BitBlt lpdis->hDC, lpdis->rcItem.left, lpdis->rcItem.top, _
+ nWidth, nHeight, memDC, 0, 0, SRCCOPY
+
+ SelectObject( memDC, oldBmp )
+
+ ' Cleanup
+ RestoreDC(memDC, -1)
+ If hbit Then DeleteObject(hbit)
+ If memDC Then DeleteDC memDC
+ RestoreDC(lpdis->hDC, -1)
+ end if
+
+ Function = True
+End Function
+
+
+' ========================================================================================
+' frmPopupMenuShadow Window procedure
+' ========================================================================================
+function frmPopupMenuShadow_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+end function
+
+
+' ========================================================================================
+' frmPopupMenu Window procedure
+' ========================================================================================
+function frmPopupMenu_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_MEASUREITEM, frmPopupMenu_OnMeasureItem)
+ HANDLE_MSG (HWnd, WM_DRAWITEM, frmPopupMenu_OnDrawItem)
+
+ case WM_DESTROY
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(HWnd)
+ select case HWnd
+ case HWND_MENU(0)
+ DestroyWindow(HWND_SHADOW(0))
+ Delete pWindow
+ case HWND_MENU(1)
+ DestroyWindow(HWND_SHADOW(1))
+ Delete pWindow
+ end select
+
+ ' prevent this popup menu from stealing focus from main app
+ ' This message is reveive before WM_NCACTIVATE for the main form is processed
+ ' This popup is not activated but the mouse click is not thrown away thereby
+ ' allowing us to reset the flag in WM_LBUTTUPUP
+ case WM_MOUSEACTIVATE
+ ' test that the form itself is being clicked on rather than a label
+ gPrevent_WM_NCACTIVATE = true
+ return MA_NOACTIVATE
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_PAINT
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDc
+ Dim As Rect rc
+
+ hDC = BeginPaint(hWnd, @ps)
+ GetClientRect(HWnd, @rc)
+ FillRect( hDC, @rc, ghPopup.hPanelBrush )
+ EndPaint hWnd, @ps
+
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmPopupMenu_SubclassProc
+' ========================================================================================
+function frmPopupMenu_SubclassProc ( _
+ ByVal hWin As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal _wParam As WPARAM, _ ' // First message parameter
+ ByVal _lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(hWin)
+
+ ' save the most recent selected line for the listbox on the main popup
+ ' menu. We need this to ensure that the listbox line is highlighted
+ ' when we mouseover the listbox in the child submenu popup.
+ ' gMenuLastCurSel declared as a global because frmMain needs to access
+ ' it for keyboard access.
+
+ Select Case uMsg
+
+ Case WM_MOUSEMOVE
+ ' Track that we are over the control in order to catch the
+ ' eventual WM_MOUSELEAVE event
+ Dim tme As TrackMouseEvent
+ tme.cbSize = Sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER Or TME_LEAVE
+ tme.hwndTrack = hWin
+ tme.dwHoverTime = 200 ' system default is 400ms
+ TrackMouseEvent(@tme)
+
+ ' get the item rect that the mouse is over and only invalidate
+ ' that instead of the entire listbox
+ dim as RECT rc
+ dim as long nCurSel = ListBox_GetCurSel(hWin)
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ if idx <> nCurSel then
+ ListBox_SetCurSel(hWin, idx)
+ ListBox_GetItemRect( hWin, idx, @rc )
+ InvalidateRect( hWin, @rc, true )
+ ListBox_GetItemRect( hWin, nCurSel, @rc )
+ InvalidateRect( hWin, @rc, true )
+ ' if we are mouse over on the submenu popup then ensure that the
+ ' line in the main menu pope that called this submenu is also highlighted.
+ if GetParent(hWin) = HWND_MENU(1) then
+ dim as HWND hListBox = GetDlgItem(HWND_MENU(0), IDC_MENU_LISTBOX)
+ ListBox_SetCurSel( hListBox, gMenuLastCurSel)
+ ListBox_GetItemRect( hListBox, idx, @rc )
+ InvalidateRect( hListBox, @rc, true )
+ end if
+ end if
+
+ case WM_MOUSELEAVE
+ ListBox_SetCurSel(hWin, -1)
+ AfxRedrawWindow(hWin)
+
+ case WM_LBUTTONDOWN, WM_MOUSEHOVER
+ ' test if this menu item has a submenu then show it now if not already shown
+ dim as HWND hListBox = GetDlgItem( HWND_MENU(0), IDC_MENU_LISTBOX )
+ if hWin = hListBox then
+ dim as long idx = Listbox_ItemFromPoint( hWin, GET_X_LPARAM(_lParam), GET_Y_LPARAM(_lParam))
+ gMenuLastCurSel = idx
+ frmPopupMenu_Show( ID_SUBPOPUP, gMenuLastCurSel, hWin )
+ end if
+
+ case WM_ERASEBKGND
+ ' we paint the listbox via WM_DRAWITEM so no need to erase and paint
+ ' the background here causing unnecessary flicker.
+ return true
+
+ case WM_LBUTTONUP
+ gPrevent_WM_NCACTIVATE = false
+ ' process a menu item that was clicked on
+ dim as long nCurSel = ListBox_GetCurSel(hWin)
+ dim as long idx = ListBox_GetItemData(hWin, nCurSel)
+ ' bypass if the menu entry is a separator or disabled or has a popup child menu.
+ if (gTopMenu(idx).isDisabled = true) orelse (gTopMenu(idx).isSeparator = true) then
+ elseif gTopMenu(idx).nChildID <> 0 then
+ else
+ killAllPopupMenus()
+ PostMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(gTopMenu(idx).nID, 0), 0 )
+ end if
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hWin, @frmPopupMenu_SubclassProc, uIdSubclass )
+ End Select
+
+ ' For messages that we don't deal with
+ Function = DefSubclassProc(hWin, uMsg, _wParam, _lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmPopupMenu_Show
+' ========================================================================================
+function frmPopupMenu_Show( _
+ byval nPopupType as long, _ ' popup or subpopup
+ byval nItemID as long, _ ' parent listbox row
+ byval hParent as HWND _ ' listbox or menubar button
+ ) As HWND
+
+ dim pWindow as CWindow ptr
+ dim as long nMenuLeft, nMenuTop, nMenuWidth, nMenuHeight
+ dim as long nCtrlID
+ dim as RECT rc
+
+ frmMain_ChangeTopMenuStates()
+
+ if nPopupType = ID_SUBPOPUP then
+ ' Determine if incoming hParent menuitem has a child menu
+ dim as long nIdx = ListBox_GetItemData( hParent, nItemID )
+ if gTopMenu(nIdx).nChildID = 0 then
+ if IsWindowVisible(HWND_MENU(1)) then killPopupSubMenus()
+ exit function
+ end if
+ nCtrlID = gTopMenu(nIdx).nID
+ ListBox_GetItemRect( hParent, nItemID, @rc )
+ MapWindowPoints( hParent, HWND_DESKTOP, cast(POINT PTR, @rc), 2 )
+ nMenuLeft = rc.right: nMenuTop = rc.top
+
+ ' If the popup already exists and is being shown for this nCtrlID
+ ' then simply exit, otherwise the menu will just be destroyed and
+ ' re-displayed causing unnecessary flicker. The nCtrlID is stored
+ ' in the UserData section of the CWindow form.
+ if IsWindowVisible(HWND_MENU(1)) then
+ pWindow = AfxCWindowPtr(HWND_MENU(1))
+ if pWindow->UserData(0) = nCtrlID then exit function
+ end if
+
+ elseif nPopupType = ID_POPUP then
+ nCtrlID = GetDlgCtrlID( hParent )
+ rc = AfxGetWindowRect( hParent )
+ nMenuLeft = rc.left
+ nMenuTop = rc.bottom - 1 ' b/c rect doesn't include bottom pixel
+
+ ' If the popup already exists and is being shown for this nCtrlID
+ ' then simply exit, otherwise the menu will just be destroyed and
+ ' re-displayed causing unnecessary flicker. The nCtrlID is stored
+ ' in the UserData section of the CWindow form.
+ if IsWindowVisible(HWND_MENU(0)) then
+ pWindow = AfxCWindowPtr(HWND_MENU(0))
+ if pWindow->UserData(0) = nCtrlID then exit function
+ end if
+ end if
+
+ ' Prevent main form from firing WM_ACTIVATE which would causes the titlebar
+ ' to be inactive. We always want our titlebar to be active when a popup
+ ' menu is active.
+ gPrevent_WM_NCACTIVATE = true
+
+ ' Popup menus are non-modal (modeless) windows
+ pWindow = New CWindow
+ pWindow->DPI = AfxCWindowPtr(HWND_FRMMAIN)->DPI
+ nMenuLeft = pWindow->UnScaleX(nMenuLeft)
+ nMenuTop = pWindow->UnScaleY(nMenuTop)
+
+ ' If popup menu was already active prior to this menubar button gaining
+ ' focus then automatically show the new popup menu rather than forcing
+ ' the user to have to click on the button.
+ dim as HWND prevPopup
+ if nPopupType = ID_POPUP and IsWindow(HWND_MENU(0)) then prevPopup = HWND_MENU(0)
+ if nPopupType = ID_SUBPOPUP and IsWindow(HWND_MENU(1)) then prevPopup = HWND_MENU(1)
+
+ dim as HWND hPopupMenu = pWindow->Create( HWND_FRMMAIN, "", @frmPopupMenu_WndProc, _
+ nMenuLeft, nMenuTop, 0, 0, WS_POPUP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->UserData(0) = nCtrlID
+
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ dim as HWND hPopupListBox = _
+ pWindow->AddControl("LISTBOX", , IDC_MENU_LISTBOX, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or LBS_NOINTEGRALHEIGHT Or _
+ LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS Or LBS_NOTIFY, WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmPopupMenu_SubclassProc), IDC_MENU_LISTBOX, Cast(DWORD_PTR, @pWindow))
+
+ select case nCtrlID
+ case IDC_MENUBAR_FILE: nMenuWidth = 262
+ case IDC_MENUBAR_EDIT: nMenuWidth = 280
+ case IDC_MENUBAR_SEARCH: nMenuWidth = 300
+ case IDC_MENUBAR_VIEW: nMenuWidth = 320
+ case IDC_MENUBAR_PROJECT: nMenuWidth = 242
+ case IDC_MENUBAR_COMPILE: nMenuWidth = 300
+ case IDC_MENUBAR_DESIGNER: nMenuWidth = 300
+ case IDC_MENUBAR_HELP: nMenuWidth = 262
+ case IDM_USERTOOLS: nMenuWidth = 262
+ case IDM_OPTIONS: nMenuWidth = 300
+ case IDM_ALIGN, IDM_MAKESAME
+ nMenuWidth = 130
+ case IDM_HORIZSPACING, IDM_VERTSPACING, IDM_CENTER
+ nMenuWidth = 156
+ case IDM_MRU
+ ' update the list of filenames with the most current data
+ ' the width of the MRU menu depends on the width of the actual filenames
+ nMenuWidth = max( 262, updateMRUFilesItems )
+ case IDM_MRUPROJECT
+ nMenuWidth = max( 262, updateMRUProjectFilesItems )
+
+ end select
+
+ ' add the menuitems to the popup menu ownerdraw listbox. we do this after the
+ ' above menu width calculations because if this is an MRU menu then the menuitems
+ ' text would have possibly changed.
+ for i as long = lbound(gTopMenu) to ubound(gTopMenu)
+ if gTopMenu(i).nParentID = nCtrlID then
+ dim as long idx = Listbox_AddString( hPopupListBox, @"" ) ' text is retrieved from array when drawn
+ ListBox_SetItemData( hPopupListBox, idx, i ) ' store index to gTopMenu array
+ end if
+ next
+
+ ' calculate final size of the popup menu based on margins/padding and the embedded listbox
+ dim as long nLeft, nTop, nWidth, nHeight
+
+ nLeft = 2
+ nTop = 10
+ nWidth = nMenuWidth - (nLeft * 2)
+ nHeight = (ListBox_GetCount(hPopupListBox) * MENUITEM_HEIGHT)
+
+ SetWindowPos( hPopupListBox, 0, _
+ pWindow->ScaleX(nLeft), pWindow->ScaleY(nTop), _
+ pWindow->ScaleX(nWidth), pWindow->ScaleY(nHeight), _
+ SWP_NOZORDER Or SWP_SHOWWINDOW)
+
+ nMenuHeight = nTop + nHeight + nTop
+
+ ' create semi-transparent window slightly offset under our popup menu in order to simulate a shadow.
+ pWindow = New CWindow
+ pWindow->DPI = AfxCWindowPtr(HWND_FRMMAIN)->DPI
+ dim as HWND hPopupShadow = pWindow->Create( HWND_FRMMAIN, "", _
+ @frmPopupMenuShadow_WndProc, nMenuLeft - 1, nMenuTop + 4, nMenuWidth + 3, nMenuHeight, _
+ WS_POPUP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, WS_EX_LAYERED or WS_EX_NOACTIVATE )
+ pWindow->Brush = GetSysColorBrush(COLOR_WINDOWTEXT) ' black background
+ SetLayeredWindowAttributes( hPopupShadow, 0, 20, LWA_ALPHA )
+
+ if nPopupType = ID_POPUP and IsWindowVisible(HWND_MENU(1)) then killPopupSubMenus()
+ if IsWindow(prevPopup) then DestroyWindow(prevPopup)
+
+ SetWindowPos( hPopupShadow, HWND_TOP, 0, 0, 0, 0, _
+ SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW)
+
+ SetWindowPos( hPopupMenu, HWND_TOP, 0, 0, _
+ pWindow->ScaleX(nMenuWidth), pWindow->ScaleY(nMenuHeight), _
+ SWP_NOACTIVATE or SWP_NOMOVE or SWP_SHOWWINDOW)
+
+ gPrevent_WM_NCACTIVATE = false
+
+ HWND_MENU(nPopupType) = hPopupMenu
+ HWND_SHADOW(nPopupType) = hPopupShadow
+
+ Function = hPopupMenu
+
+End Function
+
diff --git a/src/frmProjectOptions.bi b/src/frmProjectOptions.bi
index f703c7b9..85e7338c 100644
--- a/src/frmProjectOptions.bi
+++ b/src/frmProjectOptions.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmProjectOptions.bi.bak b/src/frmProjectOptions.bi.bak
new file mode 100644
index 00000000..f703c7b9
--- /dev/null
+++ b/src/frmProjectOptions.bi.bak
@@ -0,0 +1,38 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMPROJECTOPTIONS_LABEL1 1000
+#Define IDC_FRMPROJECTOPTIONS_LABEL2 1001
+#Define IDC_FRMPROJECTOPTIONS_LABEL3 1002
+#Define IDC_FRMPROJECTOPTIONS_LABEL4 1003
+#Define IDC_FRMPROJECTOPTIONS_LABEL5 1004
+#Define IDC_FRMPROJECTOPTIONS_LABEL6 1005
+#Define IDC_FRMPROJECTOPTIONS_LABEL7 1006
+#Define IDC_FRMPROJECTOPTIONS_LABEL8 1007
+#Define IDC_FRMPROJECTOPTIONS_TXTPROJECTPATH 1008
+#Define IDC_FRMPROJECTOPTIONS_CMDSELECT 1009
+#Define IDC_FRMPROJECTOPTIONS_TXTOPTIONS32 1010
+#Define IDC_FRMPROJECTOPTIONS_TXTOPTIONS64 1011
+#Define IDC_FRMPROJECTOPTIONS_CHKMANIFEST 1012
+#Define IDC_FRMPROJECTOPTIONS_OPTNONE 1013
+#Define IDC_FRMPROJECTOPTIONS_OPTBLANK 1014
+#Define IDC_FRMPROJECTOPTIONS_OPTVD 1015
+#Define IDC_FRMPROJECTOPTIONS_OPTCONSOLE 1016
+#Define IDC_FRMPROJECTOPTIONS_OPTDLL 1017
+#Define IDC_FRMPROJECTOPTIONS_OPTSTATIC 1018
+#Define IDC_FRMPROJECTOPTIONS_LBLDEFAULTFONT 1019
+#Define IDC_FRMPROJECTOPTIONS_CMDDEFAULTFONT 1020
+
+declare Function frmProjectOptions_Show( ByVal hWndParent As HWnd, byval IsNewProject as boolean ) As LRESULT
diff --git a/src/frmProjectOptions.inc b/src/frmProjectOptions.inc
index 6e172775..238b7234 100644
--- a/src/frmProjectOptions.inc
+++ b/src/frmProjectOptions.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmProjectOptions.inc.bak b/src/frmProjectOptions.inc.bak
new file mode 100644
index 00000000..6e172775
--- /dev/null
+++ b/src/frmProjectOptions.inc.bak
@@ -0,0 +1,448 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmProjectOptions.bi"
+#include once "frmBuildConfig.bi"
+
+
+' ========================================================================================
+' Display the abbreviated Font name and point size in the Label
+' ========================================================================================
+function SetDefaultFontLabel( byval hParent as HWND ) as long
+ dim as CWSTR wszPropValue = gApp.ProjectDefaultFont
+ dim as CWSTR wszFont = AfxStrParse(wszPropValue, 1, ",") & ", " & _
+ AfxStrParse(wszPropValue, 2, ",") & "pt"
+ AfxSetWindowText( GetDlgItem(hParent, IDC_FRMPROJECTOPTIONS_LBLDEFAULTFONT), wszFont )
+ function = 0
+end function
+
+' ========================================================================================
+' Show the popup font selection dialog for the Project Default Control Font
+' ========================================================================================
+function ChooseProjectDefaultFont( byval hParent as HWND ) as long
+
+ dim cf as CHOOSEFONT
+ dim lf as LOGFONT
+ cf.lStructSize = sizeof(cf)
+ cf.hwndOwner = hParent
+ cf.lpLogFont = @lf
+ cf.Flags = CF_SCREENFONTS or CF_EFFECTS or CF_INITTOLOGFONTSTRUCT
+
+ lf = SetLogFontFromPropValue(gApp.ProjectDefaultFont)
+
+ EnableWindow(hParent, false)
+ if ChooseFont(@cf) then
+ gApp.ProjectDefaultFont = SetPropValueFromLogFont(*cf.lpLogFont)
+ SetDefaultFontLabel( hParent )
+ END IF
+ EnableWindow(hParent, true)
+ SetActiveWindow(hParent)
+
+ function = 0
+end function
+
+' ========================================================================================
+' Create a generic resource file and manifest for the Project
+' ========================================================================================
+function frmProjectOptions_CreateResourceManifest() as Long
+
+ dim as CWSTR wszProjectPath = AfxStrPathname("PATH", gApp.ProjectFilename)
+ dim as CWSTR wszManifest = wszProjectPath + "manifest.xml"
+ dim as CWSTR wszResource = wszProjectPath + "resource.rc"
+ dim as CWSTR wszManifestTemplate = AfxGetExePathName + "Settings\WinFBE_manifest.xml"
+ dim as CWSTR wszResourceTemplate = AfxGetExePathName + "Settings\WinFBE_resource.rc"
+
+ dim as CWSTR wszFilesMissing
+
+ if AfxFileExists(wszManifest) = false then
+ if AfxFileExists(wszManifestTemplate) = false then
+ wszFilesMissing = wszFilesMissing & _
+ space(5) & "- " & AfxStrPathname( "NAMEX", wszManifestTemplate ) & vbcrlf
+ else
+ AfxCopyFile( wszManifestTemplate, wszManifest, true )
+ end if
+ end if
+
+ if AfxFileExists(wszResource) = false then
+ if AfxFileExists(wszResourceTemplate) = false then
+ wszFilesMissing = wszFilesMissing & _
+ space(5) & "- " & AfxStrPathname( "NAMEX", wszResourceTemplate ) & vbcrlf
+ else
+ AfxCopyFile( wszResourceTemplate, wszResource, true )
+ end if
+ end if
+
+ if len(wszFilesMissing) then
+ MessageBox( 0, _
+ "The following files(s) are missing from the WinFBE Settings folder. " + _
+ "Please reinstall the WinFBE application." & vbcrlf & vbcrlf & _
+ wszFilesMissing, _
+ "Error", _
+ MB_OK Or MB_ICONWARNING Or MB_DEFBUTTON1 Or MB_APPLMODAL )
+ exit function
+ end if
+
+
+ ' Add the resource file to the project if it does not already exist in the project
+ if gApp.GetDocumentPtrByFilename(wszResource) = 0 then
+ dim pDoc as clsDocument ptr
+ pDoc = frmMain_OpenFileSafely(HWND_FRMMAIN, _
+ False, _ ' bIsNewFile
+ False, _ ' bIsTemplate
+ false, _ ' bShowInTab
+ false, _ ' bIsInclude
+ wszResource, _ ' pwszName
+ 0 ) ' pDocIn
+ gApp.ProjectSetFileType(pDoc, FILETYPE_RESOURCE)
+ END IF
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Save all options for the Project
+' ========================================================================================
+function frmProjectOptions_SaveProjectOptions( ByVal HWnd As HWnd ) As BOOLEAN
+
+ Dim wText As WString * MAX_PATH
+
+ ' Determine if the project path was specified
+ wText = AfxGetWindowText(GetDlgItem(HWnd, IDC_FRMPROJECTOPTIONS_TXTPROJECTPATH))
+ If Len(wText) = 0 Then
+ MessageBox( HWnd, L(217,"Invalid project path specified."), L(201,"Error"), _
+ MB_OK Or MB_ICONINFORMATION Or MB_DEFBUTTON1 )
+ return False
+ End If
+
+ if gApp.IsNewProjectFlag then
+ ' Need to close any open files or project at this point before loading
+ ' and displaying the new project.
+ if gApp.IsProjectActive then
+ if OnCommand_ProjectClose(HWnd) = false then exit function
+ else
+ if OnCommand_FileClose(HWnd, EFC_CLOSEALL) = false then exit function
+ end if
+ end if
+
+ ' Load the new or modified data into the Project variables
+ gApp.IsProjectActive = true
+ gApp.ProjectFilename = wText
+ gApp.ProjectName = AfxStrPathname( "NAMEX", gApp.ProjectFilename )
+
+ gApp.ProjectOther32 = AfxGetWindowText(GetDlgItem(HWnd, IDC_FRMPROJECTOPTIONS_TXTOPTIONS32))
+ gApp.ProjectOther64 = AfxGetWindowText(GetDlgItem(HWnd, IDC_FRMPROJECTOPTIONS_TXTOPTIONS64))
+ gApp.ProjectManifest = Button_GetCheck(GetDlgItem(HWnd, IDC_FRMPROJECTOPTIONS_CHKMANIFEST))
+ gApp.ProjectBuild = frmBuildConfig_GetSelectedBuildGUID()
+ gApp.ProjectNotes = ""
+ gApp.ProjectCommandLine = ""
+
+
+ ' Create the resource file and manifest if applicable
+ if gApp.ProjectManifest THEN frmProjectOptions_CreateResourceManifest()
+
+ ' Save the actual Project data to disk.
+ gConfig.ProjectSaveToFile()
+
+ if Button_GetCheck( GetDlgItem(Hwnd, IDC_FRMPROJECTOPTIONS_OPTNONE) ) THEN
+ gApp.NewProjectTemplateType = IDC_FRMPROJECTOPTIONS_OPTNONE
+ elseif Button_GetCheck( GetDlgItem(Hwnd, IDC_FRMPROJECTOPTIONS_OPTBLANK) ) THEN
+ gApp.NewProjectTemplateType = IDC_FRMPROJECTOPTIONS_OPTBLANK
+ elseif Button_GetCheck( GetDlgItem(Hwnd, IDC_FRMPROJECTOPTIONS_OPTVD) ) THEN
+ gApp.NewProjectTemplateType = IDC_FRMPROJECTOPTIONS_OPTVD
+ elseif Button_GetCheck( GetDlgItem(Hwnd, IDC_FRMPROJECTOPTIONS_OPTCONSOLE) ) THEN
+ gApp.NewProjectTemplateType = IDC_FRMPROJECTOPTIONS_OPTCONSOLE
+ elseif Button_GetCheck( GetDlgItem(Hwnd, IDC_FRMPROJECTOPTIONS_OPTDLL) ) THEN
+ gApp.NewProjectTemplateType = IDC_FRMPROJECTOPTIONS_OPTDLL
+ elseif Button_GetCheck( GetDlgItem(Hwnd, IDC_FRMPROJECTOPTIONS_OPTSTATIC) ) THEN
+ gApp.NewProjectTemplateType = IDC_FRMPROJECTOPTIONS_OPTSTATIC
+ end if
+
+ function = true
+End Function
+
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmProjectOptions
+' ========================================================================================
+function frmProjectOptions_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ Select Case id
+ Case IDC_FRMPROJECTOPTIONS_CMDSELECT
+ If codeNotify = BN_CLICKED Then
+ dim as CWSTR wszProjectName = ""
+ if gApp.IsNewProjectFlag = false then wszProjectName = gApp.ProjectName
+ Dim pwszName As WString Ptr = AfxIFileSaveDialog(HWnd, wszProjectName, @wstr("wfbe"), IDC_FRMPROJECTOPTIONS_CMDSELECT)
+ If pwszName Then
+ AfxSetWindowText( GetDlgItem(HWnd, IDC_FRMPROJECTOPTIONS_TXTPROJECTPATH), pwszName )
+ CoTaskMemFree pwszName
+ End If
+ Exit Function
+ End If
+
+ Case IDC_FRMPROJECTOPTIONS_CMDDEFAULTFONT
+ If codeNotify = BN_CLICKED Then
+ ChooseProjectDefaultFont( HWnd )
+ Exit Function
+ End If
+
+ Case IDOK
+ If codeNotify = BN_CLICKED Then
+ If frmProjectOptions_SaveProjectOptions(HWnd) Then
+ SendMessage HWnd, WM_CLOSE, 0, 0
+ End If
+ Exit Function
+ End If
+
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ gApp.IsNewProjectFlag = false
+ SendMessage HWnd, WM_CLOSE, 0, 0
+ exit function
+ End If
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmProjectOptions
+' ========================================================================================
+function frmProjectOptions_OnCreate( _
+ ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmProjectOptions
+' ========================================================================================
+function frmProjectOptions_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow HWnd
+ Function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmProjectOptions
+' ========================================================================================
+function frmProjectOptions_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmProjectOptions Window procedure
+' ========================================================================================
+function frmProjectOptions_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmProjectOptions_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmProjectOptions_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmProjectOptions_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmProjectOptions_OnCommand)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmProjectOptions_Show
+' ========================================================================================
+function frmProjectOptions_Show( _
+ ByVal hWndParent As HWnd, _
+ byval IsNewProject as boolean _
+ ) As LRESULT
+
+ Dim wszTitle As WString * MAX_PATH
+ dim as long nLeft, nTop, nWidth, nHeight, nMidPoint
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ Dim As HWnd hForm = _
+ pWindow->Create( hWndParent, "", @frmProjectOptions_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT)
+ pWindow->SetClientSize(600, 342)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ dim as RECT rcClient
+ GetClientRect( hForm, @rcClient )
+ nMidPoint = pWindow->UnScaleX((rcClient.Right / 2))
+
+ pWindow->AddControl("LABEL", , IDC_FRMPROJECTOPTIONS_LABEL1, L(240,"Project Path"), 26, 15, 235, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ Dim As HWnd hProjectPath = _
+ pWindow->AddControl("TEXTBOX", , IDC_FRMPROJECTOPTIONS_TXTPROJECTPATH, "", 26, 35, 508, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("BUTTON", , IDC_FRMPROJECTOPTIONS_CMDSELECT, "...", 544, 33, 37, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ nTop = iIf(IsNewProject, 75, 95)
+ nWidth = iIf(IsNewProject, 280, 555)
+ nHeight = iIf(IsNewProject, 40, 20)
+ pWindow->AddControl("LABEL", , IDC_FRMPROJECTOPTIONS_LABEL5, L(283,"Specify compiler options in addition to the selected build configuration") & ":", 26, nTop, nWidth, nHeight, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("LABEL", , IDC_FRMPROJECTOPTIONS_LABEL2, L(241,"Other Options (32-bit compiler)"), 26, 121, nWidth, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ nWidth = iIf(IsNewProject, 280, 555)
+ Dim As HWnd hProjectOther32 = _
+ pWindow->AddControl("TEXTBOX", , IDC_FRMPROJECTOPTIONS_TXTOPTIONS32, "", 26, 141, nWidth, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMPROJECTOPTIONS_LABEL4, L(242,"Other Options (64-bit compiler)"), 26, 170, nWidth, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ nWidth = iIf(IsNewProject, 280, 555)
+ Dim As HWnd hProjectOther64 = _
+ pWindow->AddControl("TEXTBOX", , IDC_FRMPROJECTOPTIONS_TXTOPTIONS64, "", 26, 190, nWidth, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ nWidth = iIf(IsNewProject, 280, 555)
+ dim as hwnd hManifest = _
+ pWindow->AddControl("CHECKBOX", , IDC_FRMPROJECTOPTIONS_CHKMANIFEST, L(308,"Create resource file and manifest"), 26, 222, nWidth, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ nWidth = iIf(IsNewProject, 280, 555)
+ pWindow->AddControl("LABEL", , IDC_FRMPROJECTOPTIONS_LABEL8, L(448,"Default Control Font") & ":", 26, 254, 130, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ dim as hwnd hLblDefaultFont = _
+ pWindow->AddControl("LABEL", , IDC_FRMPROJECTOPTIONS_LBLDEFAULTFONT, "", 160, 254, 120, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ SetDefaultFontLabel( hForm )
+ dim as hwnd hCmdDefaultFont = _
+ pWindow->AddControl("BUTTON", , IDC_FRMPROJECTOPTIONS_CMDDEFAULTFONT, wszMoreActions, 282, 254, 24, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ If IsNewProject Then
+ nMidPoint = nMidPoint + 40
+ pWindow->AddControl("LABEL", , IDC_FRMPROJECTOPTIONS_LABEL6, "", nMidPoint, 75, 2, 200, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_SUNKEN, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ nLeft = nMidPoint + 20
+ nTop = 75
+ nWidth = 250
+ pWindow->AddControl("LABEL", , IDC_FRMPROJECTOPTIONS_LABEL7, L(176,"Templates") & ":", nLeft, nTop, nWidth, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ nLeft = nLeft + 20
+ nTop = nTop + 22
+ nWidth = 260
+ pWindow->AddControl("RADIOBUTTON", , IDC_FRMPROJECTOPTIONS_OPTNONE, L(388,"None"), nLeft, nTop, nWidth, 20, _
+ WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER or WS_GROUP, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ nTop = nTop + 22
+ pWindow->AddControl("RADIOBUTTON", , IDC_FRMPROJECTOPTIONS_OPTBLANK, L(389,"Blank Document"), nLeft, nTop, nWidth, 20, _
+ WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ nTop = nTop + 22
+ pWindow->AddControl("RADIOBUTTON", , IDC_FRMPROJECTOPTIONS_OPTVD, L(390,"Visual Designer"), nLeft, nTop, nWidth, 20, _
+ WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ nTop = nTop + 22
+ pWindow->AddControl("RADIOBUTTON", , IDC_FRMPROJECTOPTIONS_OPTCONSOLE, L(391,"Console"), nLeft, nTop, nWidth, 20, _
+ WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ nTop = nTop + 22
+ pWindow->AddControl("RADIOBUTTON", , IDC_FRMPROJECTOPTIONS_OPTDLL, L(392,"Windows DLL"), nLeft, nTop, nWidth, 20, _
+ WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ nTop = nTop + 22
+ pWindow->AddControl("RADIOBUTTON", , IDC_FRMPROJECTOPTIONS_OPTSTATIC, L(393,"Static Library"), nLeft, nTop, nWidth, 20, _
+ WS_VISIBLE OR WS_TABSTOP OR BS_AUTORADIOBUTTON OR BS_LEFT OR BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ CheckRadioButton( hForm, IDC_FRMPROJECTOPTIONS_OPTNONE, _
+ IDC_FRMPROJECTOPTIONS_OPTSTATIC, _
+ IDC_FRMPROJECTOPTIONS_OPTNONE )
+ end if
+
+
+ pWindow->AddControl("LABEL", , IDC_FRMPROJECTOPTIONS_LABEL3, "", 10, 282, 572, 2, _
+ WS_CHILD Or WS_VISIBLE Or SS_LEFT Or SS_NOTIFY Or SS_SUNKEN, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDOK, L(0,"&OK"), 423, 297, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_DEFPUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(1,"&Cancel"), 508, 297, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ wszTitle = L(214,"Project Options")
+
+ ' gApp.IsNewProjectFlag is only used within frmProjectOptions in order to
+ ' keep the state when OK is pressed.
+ gApp.IsNewProjectFlag = IsNewProject
+ If IsNewProject Then
+ ' Set the default values for a new project
+ wszTitle = wszTitle & " - " & L(215, "New Project")
+ Button_SetCheck( hManifest, true)
+ Else
+ wszTitle = wszTitle + " - " + gApp.ProjectName
+ AfxSetWindowText( hProjectPath, gApp.ProjectFilename )
+ AfxSetWindowText( hProjectOther32, gApp.ProjectOther32 )
+ AfxSetWindowText( hProjectOther64, gApp.ProjectOther64 )
+ Button_SetCheck( hManifest, gApp.ProjectManifest)
+ End If
+ AfxSetWindowText( hForm, wszTitle )
+
+ SetFocus GetDlgItem(hForm, IDOK)
+
+ ' Process Windows messages(modal)
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the frmProjectOptions CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
diff --git a/src/frmRecent.bi b/src/frmRecent.bi
index 82441fc3..11775b71 100644
--- a/src/frmRecent.bi
+++ b/src/frmRecent.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmRecent.bi.bak b/src/frmRecent.bi.bak
new file mode 100644
index 00000000..82441fc3
--- /dev/null
+++ b/src/frmRecent.bi.bak
@@ -0,0 +1,25 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMRECENT_BTNNEWFILE 1000
+#Define IDC_FRMRECENT_BTNOPENFILE 1001
+#Define IDC_FRMRECENT_BTNNEWPROJECT 1002
+#Define IDC_FRMRECENT_BTNOPENPROJECT 1003
+#Define IDC_FRMRECENT_TREEVIEW 1004
+
+declare Function frmRecent_LoadTreeview() As LRESULT
+declare Function frmRecent_PositionWindows As LRESULT
+declare Function frmRecent_Show( ByVal hWndParent As HWnd ) As LRESULT
+
diff --git a/src/frmRecent.inc b/src/frmRecent.inc
index 10968f0c..2f516a4a 100644
--- a/src/frmRecent.inc
+++ b/src/frmRecent.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmRecent.inc.bak b/src/frmRecent.inc.bak
new file mode 100644
index 00000000..10968f0c
--- /dev/null
+++ b/src/frmRecent.inc.bak
@@ -0,0 +1,359 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmRecent.bi"
+#include once "clsConfig.bi"
+
+
+' ========================================================================================
+' Load the Recent Files/Projects Treeview
+' ========================================================================================
+public Function frmRecent_LoadTreeview() As LRESULT
+
+ Dim As CWSTR wzStr
+ dim As HTREEITEM hNode, hFirstNode
+ Dim As BOOLEAN fEmpty = True
+
+ Dim As HWnd hTree = GetDlgItem(HWND_FRMRECENT, IDC_FRMRECENT_TREEVIEW)
+
+ Treeview_DeleteAllItems(hTree)
+
+ '' RECENT FILES
+ wzStr = UCase(L(10, "Recent Files"))
+ hNode = TreeView_AppendItem( hTree, TVI_ROOT, wzStr )
+ hFirstNode = hNode
+ gApp.hRecentFilesRootNode = hNode
+ Treeview_SetBold( hTree, hNode, TRUE)
+ For i As Long = 0 To 9
+ ' If the file no longer exists then remove it from the MRU list
+ gConfig.MRU(i) = ProcessFromCurdriveApp(gConfig.MRU(i))
+ If AfxFileExists(gConfig.MRU(i)) Then
+ TreeView_AppendItem( hTree, hNode, gConfig.MRU(i) )
+ fEmpty = False
+ End If
+ Next
+ If fEmpty Then
+ wzStr = @L(11,"(Empty)")
+ TreeView_AppendItem( hTree, hNode, wzStr, 0 )
+ End If
+ Treeview_Expand(hTree, hNode, TVE_EXPAND)
+
+
+ '' RECENT PROJECTS
+ wzStr = UCase(L(219, "Recent Projects"))
+ hNode = TreeView_AppendItem( hTree, TVI_ROOT, wzStr )
+ gApp.hRecentProjectsRootNode = hNode
+ Treeview_SetBold( hTree, hNode, TRUE)
+ For i As Long = 0 To 9
+ ' If the file no longer exists then remove it from the MRU list
+ gConfig.MRUPROJECT(i) = ProcessFromCurdriveApp(gConfig.MRUPROJECT(i))
+ If AfxFileExists(gConfig.MRUPROJECT(i)) Then
+ TreeView_AppendItem( hTree, hNode, gConfig.MRUPROJECT(i) )
+ fEmpty = False
+ End If
+ Next
+ If fEmpty Then
+ wzStr = @L(11,"(Empty)")
+ TreeView_AppendItem( hTree, hNode, wzStr )
+ End If
+ Treeview_Expand(hTree, hNode, TVE_EXPAND)
+
+ ' Set the view to the first line
+ TreeView_EnsureVisible(hTree, hFirstNode)
+
+ Function = 0
+
+End Function
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+public Function frmRecent_PositionWindows() As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMRECENT)
+ If pWindow = 0 Then Exit Function
+
+ ' Get the entire client area
+ Dim As Rect rc
+ GetClientRect(HWND_FRMRECENT, @rc)
+
+ Dim As HWnd hBtn
+ Dim As Long nLeft, nTop, nWidth, nHeight
+
+ nTop = pWindow->ScaleY(12)
+ hBtn = GetDlgItem(HWND_FRMRECENT, IDC_FRMRECENT_BTNNEWFILE)
+ SetWindowPos( hBtn, 0, pWindow->ScaleX(28), nTop, _
+ rc.right-pWindow->ScaleX(56), pWindow->ScaleY(28), _
+ SWP_SHOWWINDOW Or SWP_NOZORDER )
+ AfxRedrawWindow(hBtn)
+
+ nTop = nTop + pWindow->ScaleY(40)
+ hBtn = GetDlgItem(HWND_FRMRECENT, IDC_FRMRECENT_BTNOPENFILE)
+ SetWindowPos( hBtn, 0, pWindow->ScaleX(28), nTop, _
+ rc.right-pWindow->ScaleX(56), pWindow->ScaleY(28), _
+ SWP_SHOWWINDOW Or SWP_NOZORDER )
+ AfxRedrawWindow(hBtn)
+
+ nTop = nTop + pWindow->ScaleY(40)
+ hBtn = GetDlgItem(HWND_FRMRECENT, IDC_FRMRECENT_BTNNEWPROJECT)
+ SetWindowPos( hBtn, 0, pWindow->ScaleX(28), nTop, _
+ rc.right-pWindow->ScaleX(56), pWindow->ScaleY(28), _
+ SWP_SHOWWINDOW Or SWP_NOZORDER )
+ AfxRedrawWindow(hBtn)
+
+ nTop = nTop + pWindow->ScaleY(40)
+ hBtn = GetDlgItem(HWND_FRMRECENT, IDC_FRMRECENT_BTNOPENPROJECT)
+ SetWindowPos( hBtn, 0, pWindow->ScaleX(28), nTop, _
+ rc.right-pWindow->ScaleX(56), pWindow->ScaleY(28), _
+ SWP_SHOWWINDOW Or SWP_NOZORDER )
+ AfxRedrawWindow(hBtn)
+
+ nTop = nTop + pWindow->ScaleY(48)
+ hBtn = GetDlgItem(HWND_FRMRECENT, IDC_FRMRECENT_TREEVIEW)
+ SetWindowPos( hBtn, 0, pWindow->ScaleX(4), nTop, _
+ rc.Right-rc.Left-pWindow->ScaleX(8), rc.bottom - nTop, _
+ SWP_SHOWWINDOW Or SWP_NOZORDER )
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmMain
+' ========================================================================================
+private Function frmRecent_OnSize( ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+ If state <> SIZE_MINIMIZED Then
+ ' Position all of the child windows
+ frmRecent_PositionWindows
+ End If
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmRecent
+' ========================================================================================
+private Function frmRecent_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+ Select Case id
+ Case IDC_FRMRECENT_BTNNEWFILE
+ If codeNotify = BN_CLICKED Then
+ OnCommand_FileNew(HWND_FRMMAIN)
+ End If
+ Case IDC_FRMRECENT_BTNOPENFILE
+ If codeNotify = BN_CLICKED Then
+ OnCommand_FileOpen(HWND_FRMMAIN)
+ End If
+ Case IDC_FRMRECENT_BTNNEWPROJECT
+ If codeNotify = BN_CLICKED Then
+ OnCommand_ProjectNew(HWND_FRMMAIN)
+ End If
+ Case IDC_FRMRECENT_BTNOPENPROJECT
+ If codeNotify = BN_CLICKED Then
+ OnCommand_ProjectOpen(HWND_FRMMAIN)
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmRecent
+' ========================================================================================
+private Function frmRecent_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(hWnd)
+
+ DIM pButton AS CXpButton ptr
+ pButton = AfxCXpButtonPtr(hwnd, IDC_FRMRECENT_BTNNEWFILE)
+ if pButton then delete pButton
+ pButton = AfxCXpButtonPtr(hwnd, IDC_FRMRECENT_BTNOPENFILE)
+ if pButton then delete pButton
+ pButton = AfxCXpButtonPtr(hwnd, IDC_FRMRECENT_BTNNEWPROJECT)
+ if pButton then delete pButton
+ pButton = AfxCXpButtonPtr(hwnd, IDC_FRMRECENT_BTNOPENPROJECT)
+ if pButton then delete pButton
+
+ Dim As HFONT hFont
+ Dim As HWnd hTree
+ hTree = GetDlgItem( hWnd, IDC_FRMRECENT_TREEVIEW)
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed frmRecent Treeview controls.
+' ========================================================================================
+private Function frmRecent_Tree_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ ' Convert our ENTER key presses into LBUTTONDBLCLK to process them similarly
+ If (uMsg = WM_KEYUP) And (Loword(wParam) = VK_RETURN) Then uMsg = WM_LBUTTONDBLCLK
+
+ Select Case uMsg
+
+ Case WM_GETDLGCODE
+ ' All keyboard input
+ Function = DLGC_WANTALLKEYS
+ Exit Function
+
+ Case WM_LBUTTONDBLCLK
+ dim as hwnd hTree = hWnd
+ dim As HTREEITEM hItem = Treeview_GetSelection(hTree)
+ If hItem Then
+ ' Get the text for the line that was double clicked on.
+ Dim As CWSTR wzStr = String(MAX_PATH, 0)
+ TreeView_GetItemText( hTree, hItem, wzStr, MAX_PATH )
+ If AfxFileExists(wzStr) Then
+ If Treeview_GetParent(hTree, hItem) = gApp.hRecentProjectsRootNode then
+ frmMain_OpenProjectSafely(HWND_FRMMAIN, wzStr)
+ Elseif Treeview_GetParent(hTree, hItem) = gApp.hRecentFilesRootNode then
+ frmMain_OpenFileSafely(HWND_FRMMAIN, _
+ False, _ ' bIsNewFile
+ False, _ ' bIsTemplate
+ true, _ ' bShowInTab
+ false, _ ' bIsInclude
+ wzStr, _ ' pwszName
+ 0 ) ' pDocIn
+ End If
+ End If
+ frmMain_PositionWindows
+ SetFocusScintilla
+ End If
+ Exit Function
+
+ Case WM_KEYUP
+ Select Case Loword(wParam)
+ Case VK_RETURN ' already processed in WM_LBUTTONDBLCLK
+ End Select
+ Exit Function
+
+ Case WM_CHAR ' prevent the annoying beep!
+ If wParam = VK_RETURN Then Return 0
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass HWnd, @frmRecent_Tree_SubclassProc, uIdSubclass
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmRecent Window procedure
+' ========================================================================================
+private Function frmRecent_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_SIZE, frmRecent_OnSize)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmRecent_OnCommand)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmRecent_OnDestroy)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmRecent_Show
+' ========================================================================================
+public Function frmRecent_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMRECENT = pWindow->Create( hWndParent, "Recent Window", @frmRecent_WndProc, 0, 0, 250, 0, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+ pWindow->SetFont( "Segoe UI Semibold", 9)
+ pWindow->Brush = GetSysColorBrush(COLOR_BTNFACE)
+
+ DIM pButton AS CXpButton ptr
+ pButton = new CXpButton(pWindow, IDC_FRMRECENT_BTNNEWFILE, L(411, "New File"), 0, 0, 0, 0)
+ pButton->SetFont(pWindow->CreateFont( "Segoe UI Semibold", 10))
+ pButton->DisableTheming
+ pButton->SetTextForeColor(BGR(255,255,250))
+ pButton->SetButtonBkColor(BGR(9,71,113))
+ pButton->SetButtonBkColorHot(BGR(63,63,70))
+
+ pButton = new CXpButton(pWindow, IDC_FRMRECENT_BTNOPENFILE, L(248, "Open File"), 0, 0, 0, 0)
+ pButton->SetFont(pWindow->CreateFont( "Segoe UI Semibold", 10))
+ pButton->DisableTheming
+ pButton->SetTextForeColor(BGR(255,255,250))
+ pButton->SetButtonBkColor(BGR(9,71,113))
+ pButton->SetButtonBkColorHot(BGR(63,63,70))
+
+ pButton = new CXpButton(pWindow, IDC_FRMRECENT_BTNOPENPROJECT, L(249, "Open Project"), 0, 0, 0, 0)
+ pButton->SetFont(pWindow->CreateFont( "Segoe UI Semibold", 10))
+ pButton->DisableTheming
+ pButton->SetTextForeColor(BGR(255,255,250))
+ pButton->SetButtonBkColor(BGR(9,71,113))
+ pButton->SetButtonBkColorHot(BGR(63,63,70))
+
+ pButton = new CXpButton(pWindow, IDC_FRMRECENT_BTNNEWPROJECT, L(180, "New Project"), 0, 0, 0, 0)
+ pButton->SetFont(pWindow->CreateFont( "Segoe UI Semibold", 10))
+ pButton->DisableTheming
+ pButton->SetTextForeColor(BGR(255,255,250))
+ pButton->SetButtonBkColor(BGR(9,71,113))
+ pButton->SetButtonBkColorHot(BGR(63,63,70))
+
+ Dim As HWnd hTree = _
+ pWindow->AddControl("TREEVIEW", , IDC_FRMRECENT_TREEVIEW, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or _
+ TVS_SHOWSELALWAYS Or TVS_FULLROWSELECT Or TVS_TRACKSELECT, _
+ WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmRecent_Tree_SubclassProc), IDC_FRMRECENT_TREEVIEW, Cast(DWORD_PTR, @pWindow))
+
+ Dim As HFONT hFont = pWindow->CreateFont("Segoe UI", 9)
+ SendMessage( hTree, WM_SETFONT, Cast(WPARAM, hFont), CTRUE )
+ SendMessage( hTree, TVM_SETITEMHEIGHT, pWindow->ScaleY(24), 0 )
+ SendMessage( hTree, TVM_SETEXTENDEDSTYLE, TVS_EX_DOUBLEBUFFER, TVS_EX_DOUBLEBUFFER)
+ SendMessage( hTree, TVM_SETBKCOLOR, 0, Cast(LPARAM, GetSysColor(COLOR_BTNFACE)) )
+
+ frmRecent_LoadTreeview
+ frmRecent_PositionWindows
+
+ Function = 0
+
+End Function
+
+
+
diff --git a/src/frmSnippets.bi b/src/frmSnippets.bi
index e208e7fe..ba797d79 100644
--- a/src/frmSnippets.bi
+++ b/src/frmSnippets.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmSnippets.bi.bak b/src/frmSnippets.bi.bak
new file mode 100644
index 00000000..e208e7fe
--- /dev/null
+++ b/src/frmSnippets.bi.bak
@@ -0,0 +1,37 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#include once "clsDocument.bi"
+
+#DEFINE IDC_FRMSNIPPETS_LIST1 1000
+#DEFINE IDC_FRMSNIPPETS_TXTDESCRIPTION 1001
+#DEFINE IDC_FRMSNIPPETS_TXTTRIGGER 1002
+#DEFINE IDC_FRMSNIPPETS_TXTCODE 1003
+#DEFINE IDC_FRMSNIPPETS_LABEL1 1004
+#DEFINE IDC_FRMSNIPPETS_LABEL2 1005
+#DEFINE IDC_FRMSNIPPETS_LABEL3 1006
+#DEFINE IDC_FRMSNIPPETS_LABEL4 1007
+#DEFINE IDC_FRMSNIPPETS_CMDUP 1008
+#DEFINE IDC_FRMSNIPPETS_CMDDOWN 1009
+#DEFINE IDC_FRMSNIPPETS_CMDINSERT 1010
+#DEFINE IDC_FRMSNIPPETS_CMDDELETE 1011
+#DEFINE IDC_FRMSNIPPETS_CMDOK 1012
+#DEFINE IDC_FRMSNIPPETS_LBLPARAMETERS 1013
+#DEFINE IDM_FRMSNIPPETS_PARAMETERBASE 2000
+
+declare function frmSnippets_DoInsertSnippet( byval pDoc as clsDocument ptr ) as Boolean
+declare Function frmSnippets_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+
diff --git a/src/frmSnippets.inc b/src/frmSnippets.inc
index dc38adc8..40562689 100644
--- a/src/frmSnippets.inc
+++ b/src/frmSnippets.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmSnippets.inc.bak b/src/frmSnippets.inc.bak
new file mode 100644
index 00000000..dc38adc8
--- /dev/null
+++ b/src/frmSnippets.inc.bak
@@ -0,0 +1,697 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmSnippets.bi"
+
+' Create an array that holds all options in the replaceable parameters for snippets.
+Dim shared gSnippetParameter(...) as CWSTR => _
+ { "CLIPBOARD", _
+ "CURSOR_POSITION", _
+ "FILENAME", _
+ "FILENAME_SHORT", _
+ "CURRENT_YEAR", _
+ "CURRENT_YEAR_SHORT", _
+ "CURRENT_MONTH", _
+ "CURRENT_MONTH_NAME", _
+ "CURRENT_MONTH_NAME_SHORT", _
+ "CURRENT_DAY", _
+ "CURRENT_DAY_NAME", _
+ "CURRENT_DAY_NAME_SHORT", _
+ "CURRENT_HOUR", _
+ "CURRENT_MINUTE", _
+ "CURRENT_SECOND" _
+ }
+
+
+' ========================================================================================
+' Create the right-click popup Snippets Parameters menu
+' ========================================================================================
+private Function frmSnippets_CreateSnippetsParametersMenu() As HMENU
+
+ Dim hPopUpMenu As HMENU = CreatePopupMenu()
+ for i as long = lbound(gSnippetParameter) to ubound(gSnippetParameter)
+ AppendMenu( hPopUpMenu, MF_ENABLED or MF_STRING, _
+ IDM_FRMSNIPPETS_PARAMETERBASE + i, gSnippetParameter(i) )
+ next
+
+ Function = hPopupMenu
+
+End Function
+
+
+' ========================================================================================
+' Replace any embedded Parameters in the code text
+' ========================================================================================
+private function frmSnippets_DoReplaceParameters( byval wszInsertText as CWSTR ) as CWSTR
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+
+ dim as CWSTR wszText = wszInsertText
+
+ ' Contents of the clipboard
+ wszText = AfxStrReplace( wszText, "{CLIPBOARD}", AfxGetClipboardText )
+
+ ' Filename (full path and name)
+ if pDoc then
+ wszText = AfxStrReplace( wszText, "{FILENAME}", pDoc->DiskFilename )
+ wszText = AfxStrReplace( wszText, "{FILENAME_SHORT}", AfxStrPathname( "NAMEX", pDoc->DiskFilename ))
+ end if
+
+ ' The current year
+ wszText = AfxStrReplace( wszText, "{CURRENT_YEAR}", wstr(AfxLocalYear) )
+
+ ' The current year's last two digits
+ wszText = AfxStrReplace( wszText, "{CURRENT_YEAR_SHORT}", right( wstr(AfxLocalYear), 2) )
+
+ ' The month as two digits (example '02')
+ wszText = AfxStrReplace( wszText, "{CURRENT_MONTH}", AfxStrRSet(wstr(AfxLocalMonth), 2, "0") )
+
+ ' The full name of the month (example 'July')
+ wszText = AfxStrReplace( wszText, "{CURRENT_MONTH_NAME}", AfxLocalMonthName )
+
+ ' The short name of the month (example 'Jul')
+ wszText = AfxStrReplace( wszText, "{CURRENT_MONTH_NAME_SHORT}", AfxLocalShortMonthName )
+
+ ' The day of the month as two digits (example '09')
+ wszText = AfxStrReplace( wszText, "{CURRENT_DAY}", AfxStrRSet(wstr(AfxLocalDay), 2, "0") )
+
+ ' The name of day (example 'Monday')
+ wszText = AfxStrReplace( wszText, "{CURRENT_DAY_NAME}", AfxLocalDayName )
+
+ ' The short name of the day (example 'Mon')
+ wszText = AfxStrReplace( wszText, "{CURRENT_DAY_NAME_SHORT}", AfxLocalDayShortName )
+
+ dim as CWSTR wszCurTime = AfxLocalTimeStr( "HHmmss" )
+
+ ' The current hour in 24-hour clock format
+ wszText = AfxStrReplace( wszText, "{CURRENT_HOUR}", left(wszCurTime, 2) )
+
+ ' The current minute
+ wszText = AfxStrReplace( wszText, "{CURRENT_MINUTE}", mid(wszCurTime, 3, 2) )
+
+ ' The current second
+ wszText = AfxStrReplace( wszText, "{CURRENT_SECOND}", right(wszCurTime, 2) )
+
+ function = wszText
+end function
+
+
+' ========================================================================================
+' Attempt to insert/expand a user snippet
+' ========================================================================================
+public function frmSnippets_DoInsertSnippet( byval pDoc as clsDocument ptr ) as Boolean
+ if pDoc = 0 then exit function
+
+ Dim As HWnd hEdit = pDoc->hWndActiveScintilla
+ Dim As Long curPos = SendMessage( hEdit, SCI_GETCURRENTPOS, 0, 0)
+
+ ' Get the current word at the cursor
+ dim as string strWord = ucase( pDoc->GetWord )
+ dim as string strReplaceText
+
+ ' Search the snippets array for a matching trigger
+ for i as long = lbound(gConfig.Snippets) to ubound(gConfig.Snippets)
+ if ucase( gConfig.Snippets(i).wszTrigger ) = strWord then
+ ' Insert the snippet by replacing the current word
+ SendMessage( hEdit, SCI_SETSELECTIONSTART, curPos - len(strWord), 0)
+ SendMessage( hEdit, SCI_SETSELECTIONEND, curPos, 0)
+ curPos = curPos - len(strWord)
+ ' Replace the selection (SCI_REPLACESEL fails if text is "" so use Cut instead for that scenario)
+ If Len(strWord) = 0 Then
+ SendMessage( hEdit, SCI_CUT, 0, 0 )
+ Else
+ strReplaceText = frmSnippets_DoReplaceParameters( gConfig.Snippets(i).wszCode )
+
+ ' Check of the {CURSOR_POSITION} parameter exists. This is where we want to
+ ' position our cursor after the edit it made.
+ dim as string strParam = "{CURSOR_POSITION}"
+ dim as long iPos = instr( strReplaceText, strParam )
+ if iPos then strReplaceText = AfxStrRemove( strReplaceText, strParam )
+ SciExec( hEdit, SCI_REPLACESEL, 0, Strptr(strReplaceText) )
+ if iPos then SciExec( hEdit, SCI_GOTOPOS, curPos + iPos - 1, 0 )
+
+ End If
+ return true
+ end if
+ next
+
+ return false
+end function
+
+
+' ========================================================================================
+' Load all of the snippets descriptions into the listbox
+' ========================================================================================
+private function frmSnippets_LoadListBox( byval hParent as hwnd ) as Long
+ dim hList1 as hwnd = GetDlgItem(hParent, IDC_FRMSNIPPETS_LIST1)
+
+ ListBox_ResetContent(hList1)
+ for i as long = lbound(gConfig.SnippetsTemp) to ubound(gConfig.SnippetsTemp)
+ ListBox_AddString(hList1, gConfig.SnippetsTemp(i).wszDescription.sptr)
+ NEXT
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Swap two entries in the snippets Listbox
+' ========================================================================================
+private function frmSnippets_SwapListBoxItems( byval Item1 as long, _
+ Byval Item2 as long _
+ ) as Long
+ dim as hwnd hList1 = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_LIST1)
+
+ ' Swap the array values
+ swap gConfig.SnippetsTemp(Item1), gConfig.SnippetsTemp(Item2)
+
+ ListBox_ReplaceString(hList1, Item1, gConfig.SnippetsTemp(Item1).wszDescription)
+ ListBox_ReplaceString(hList1, Item2, gConfig.SnippetsTemp(Item2).wszDescription)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Set the snippets information depending on what listbox entry is selected
+' ========================================================================================
+private function frmSnippets_SetTextboxes() as long
+ dim as hwnd hList1 = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_LIST1)
+ dim as hwnd hText1 = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTDESCRIPTION)
+ dim as hwnd hText2 = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTTRIGGER)
+ dim as hwnd hText3 = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTCODE)
+
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+ if nCurSel < 0 THEN
+ AfxSetWindowText( hText1, "")
+ AfxSetWindowText( hText2, "")
+ AfxSetWindowText( hText3, "")
+ EnableWindow(hText1, false)
+ EnableWindow(hText2, false)
+ EnableWindow(hText3, false)
+ else
+ AfxSetWindowText( hText1, gConfig.SnippetsTemp(nCurSel).wszDescription)
+ AfxSetWindowText( hText2, gConfig.SnippetsTemp(nCurSel).wszTrigger)
+ AfxSetWindowText( hText3, gConfig.SnippetsTemp(nCurSel).wszCode)
+ EnableWindow(hText1, true)
+ EnableWindow(hText2, true)
+ EnableWindow(hText3, true)
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Processes messages for the subclassed code textbox window.
+' ========================================================================================
+private Function frmSnippets_TextBox_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+
+ Select Case uMsg
+
+ case WM_CONTEXTMENU
+ ' Override the default edit control menu with our own to show a list
+ ' of replaceable parameters.
+ dim pt as POINT
+ Dim hPopUpMenu As HMENU = frmSnippets_CreateSnippetsParametersMenu()
+ GetCursorPos @pt
+ TrackPopupMenu( hPopUpMenu, 0, pt.x, pt.y, 0, HWND_FRMSNIPPETS, ByVal Null )
+ DestroyMenu hPopUpMenu
+ return true
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass HWnd, @frmSnippets_TextBox_SubclassProc, uIdSubclass
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmSnippets
+' ========================================================================================
+private Function frmSnippets_OnCreate( ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmSnippets
+' ========================================================================================
+private Function frmSnippets_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim as hwnd hList1 = GetDlgItem( HWND, IDC_FRMSNIPPETS_LIST1)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+
+ ' Convert a ListBox DoubleClick into pressing OK button action
+ if (id = IDC_FRMSNIPPETS_LIST1) AndAlso (codeNotify = LBN_DBLCLK) THEN
+ id = IDOK: codeNotify = BN_CLICKED
+ END IF
+
+ Select Case id
+ case IDM_FRMSNIPPETS_PARAMETERBASE + lbound(gSnippetParameter) to _
+ IDM_FRMSNIPPETS_PARAMETERBASE + ubound(gSnippetParameter)
+
+ ' Create the parameter to insert
+ dim wszText as wstring * MAX_PATH
+ wszText = "{" & gSnippetParameter( id-IDM_FRMSNIPPETS_PARAMETERBASE ) & "}"
+
+ ' Insert the parameter at the current textbox location.
+ SendMessage( GetDlgItem(HWND, IDC_FRMSNIPPETS_TXTCODE), _
+ EM_REPLACESEL, true, cast(LPARAM, @wszText) )
+
+ case IDC_FRMSNIPPETS_LIST1
+ if codeNotify = LBN_SELCHANGE THEN
+ frmSnippets_SetTextboxes()
+ END IF
+
+ case IDC_FRMSNIPPETS_TXTDESCRIPTION
+ if codeNotify = EN_CHANGE THEN
+ ' Update the temp array and the Listbox
+ if nCurSel > -1 THEN
+ gConfig.SnippetsTemp(nCurSel).wszDescription = AfxGetWindowText(hwndCtl)
+ ListBox_ReplaceString(hList1, nCurSel, gConfig.SnippetsTemp(nCurSel).wszDescription)
+ END IF
+ end if
+
+ case IDC_FRMSNIPPETS_TXTTRIGGER
+ if codeNotify = EN_CHANGE THEN
+ ' Update the temp array
+ if nCurSel > -1 THEN
+ gConfig.SnippetsTemp(nCurSel).wszTrigger = AfxGetWindowText(hwndCtl)
+ END IF
+ end if
+
+ case IDC_FRMSNIPPETS_TXTCODE
+ if codeNotify = EN_CHANGE THEN
+ ' Update the temp array
+ if nCurSel > -1 THEN
+ gConfig.SnippetsTemp(nCurSel).wszCode = AfxGetWindowText(hwndCtl)
+ END IF
+ end if
+
+ case IDC_FRMSNIPPETS_CMDUP
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > 0 THEN
+ frmSnippets_SwapListBoxItems( nCurSel, nCurSel - 1 )
+ END IF
+ end if
+
+ case IDC_FRMSNIPPETS_CMDDOWN
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel < ListBox_GetCount(hList1) - 1 THEN
+ frmSnippets_SwapListBoxItems( nCurSel, nCurSel + 1 )
+ END IF
+ end if
+
+ case IDC_FRMSNIPPETS_CMDINSERT
+ if codeNotify = BN_CLICKED THEN
+ if ubound(gConfig.SnippetsTemp) = -1 THEN
+ redim gConfig.SnippetsTemp(0)
+ nCurSel = 0
+ Else
+ redim preserve gConfig.SnippetsTemp(ubound(gConfig.SnippetsTemp)+1)
+ if nCurSel = -1 THEN nCurSel = 0
+ ' insert the item above current entry in the internal array
+ for i as long = ubound(gConfig.SnippetsTemp) to nCurSel + 1 step -1
+ gConfig.SnippetsTemp(i) = gConfig.SnippetsTemp(i-1)
+ NEXT
+ END IF
+ gConfig.SnippetsTemp(nCurSel).wszDescription = ""
+ gConfig.SnippetsTemp(nCurSel).wszTrigger = ""
+ gConfig.SnippetsTemp(nCurSel).wszCode = ""
+ ' reload the listbox
+ frmSnippets_LoadListBox(HWND)
+ nCurSel = Min(nCurSel, ubound(gConfig.SnippetsTemp))
+ ListBox_SetCurSel(hList1, nCurSel)
+ frmSnippets_SetTextboxes()
+ SetFocus GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTDESCRIPTION )
+ end if
+
+ case IDC_FRMSNIPPETS_CMDDELETE
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN
+ if MessageBox( HWND, L(87, "Are you sure you want to delete this Snippet?"), L(276,"Confirm"), _
+ MB_YESNOCANCEL Or MB_ICONINFORMATION Or MB_DEFBUTTON1 ) = IDYES then
+ if ubound(gConfig.SnippetsTemp) = 0 THEN
+ erase gConfig.SnippetsTemp
+ nCurSel = -1
+ else
+ ' remove the item from the internal array
+ for i as long = nCurSel to ubound(gConfig.SnippetsTemp) - 1
+ gConfig.SnippetsTemp(i) = gConfig.SnippetsTemp( i + 1 )
+ NEXT
+ redim preserve gConfig.BuildsTemp( ubound(gConfig.SnippetsTemp) - 1 )
+ END IF
+ ' reload the listbox
+ frmSnippets_LoadListBox(HWND)
+ nCurSel = Min( nCurSel, ubound(gConfig.SnippetsTemp) )
+ ListBox_SetCurSel(hList1, nCurSel)
+ frmSnippets_SetTextboxes()
+ SetFocus hList1
+ end if
+ END IF
+ end if
+
+ Case IDC_FRMSNIPPETS_CMDOK
+ If codeNotify = BN_CLICKED Then
+ ' Copy the temporary items to the main array
+ redim gConfig.Snippets( ubound(gConfig.SnippetsTemp) )
+ for i as long = lbound(gConfig.SnippetsTemp) to ubound(gConfig.SnippetsTemp)
+ gConfig.Snippets(i) = gConfig.SnippetsTemp(i)
+ NEXT
+ erase gConfig.SnippetsTemp
+ gConfig.SaveSnippets
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ end if
+
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+private Function frmSnippets_PositionWindows() As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMSNIPPETS)
+ if pWindow = 0 then exit function
+
+ dim as hwnd hCtrl
+ dim as long nLeft, nTop, nWidth, nHeight, cx, cy
+
+ ' Get the entire client area
+ Dim As Rect rc
+ GetClientRect( HWND_FRMSNIPPETS, @rc )
+
+ ' The command buttons are initially positioned at 48 pixels from the bottom of the form
+ cy = pWindow->ScaleY(48)
+
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_CMDUP )
+ AfxGetWindowLocation( hCtrl, nLeft, nTop )
+ AfxSetWindowLocation( hCtrl, nLeft, rc.bottom - cy )
+
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_CMDDOWN )
+ AfxGetWindowLocation( hCtrl, nLeft, nTop )
+ AfxSetWindowLocation( hCtrl, nLeft, rc.bottom - cy )
+
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_CMDINSERT )
+ AfxGetWindowLocation( hCtrl, nLeft, nTop )
+ AfxSetWindowLocation( hCtrl, nLeft, rc.bottom - cy )
+
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_CMDDELETE )
+ AfxGetWindowLocation( hCtrl, nLeft, nTop )
+ AfxSetWindowLocation( hCtrl, nLeft, rc.bottom - cy )
+
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_CMDOK )
+ cx = pWindow->ScaleX(168)
+ nLeft = rc.right - cx
+ AfxSetWindowLocation( hCtrl, nLeft, rc.bottom - cy )
+ dim as long nLeftOK = nLeft
+
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_LBLPARAMETERS )
+ AfxGetWindowLocation( hCtrl, nLeft, nTop )
+ AfxSetWindowLocation( hCtrl, nLeft, rc.bottom - cy )
+ nHeight = AfxGetWindowHeight( hCtrl )
+ AfxSetWindowSize( hCtrl, nLeftOK - nLeft, nHeight )
+
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDCANCEL )
+ cx = pWindow->ScaleX(86)
+ AfxSetWindowLocation( hCtrl, rc.right - cx, rc.bottom - cy )
+
+ ' The listbox is positioned 60 pixels from the bottom
+ cy = pWindow->ScaleY(60)
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_LIST1 )
+ AfxGetWindowLocation( hCtrl, nLeft, nTop )
+ nWidth = AfxGetWindowWidth( hCtrl )
+ AfxSetWindowSize( hCtrl, nWidth, rc.bottom - nTop - cy )
+
+ ' The textboxes are positioned 10 pixels from the right
+ cx = pWindow->ScaleX(10)
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTDESCRIPTION )
+ AfxGetWindowLocation( hCtrl, nLeft, nTop )
+ nHeight = AfxGetWindowHeight( hCtrl )
+ AfxSetWindowSize( hCtrl, rc.right - nLeft - cx, nHeight )
+
+ hCtrl = GetDlgItem( HWND_FRMSNIPPETS, IDC_FRMSNIPPETS_TXTCODE )
+ AfxGetWindowLocation( hCtrl, nLeft, nTop )
+ nHeight = AfxGetWindowHeight( hCtrl )
+ AfxSetWindowSize( hCtrl, rc.right - nLeft - cx, rc.bottom - nTop - cy )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmSnippets
+' ========================================================================================
+private Function frmSnippets_OnSize( ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+ If state <> SIZE_MINIMIZED Then
+ ' Position all of the child windows
+ frmSnippets_PositionWindows
+ End If
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmSnippets
+' ========================================================================================
+private Function frmSnippets_OnClose( byval HWnd As HWnd ) As LRESULT
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND)
+ if pWindow then
+ ' Save the window size and placement. Use the pWindow version in order to
+ ' get the coordinates UnScaled. We do this because rcSnippets is fed to
+ ' pWindow->Create and that function will rescale the values.
+ pWindow->GetWindowRect( @gConfig.rcSnippets )
+ end if
+
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow( HWnd )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmSnippets
+' ========================================================================================
+private Function frmSnippets_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ ' Delete the font we created and applied to the multiline textbox
+ DeleteObject( AfxGetWindowFont( GetDlgItem(hwnd, IDC_FRMSNIPPETS_TXTCODE) ))
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmSnippets Window procedure
+' ========================================================================================
+private Function frmSnippets_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmSnippets_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmSnippets_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmSnippets_OnDestroy)
+ HANDLE_MSG (HWnd, WM_SIZE, frmSnippets_OnSize)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmSnippets_OnCommand)
+
+ Case WM_GETMINMAXINFO
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND)
+ if pWindow = 0 then exit function
+ DefWindowProc(hwnd, uMsg, wParam, lParam)
+ Dim pMinMaxInfo As MINMAXINFO Ptr
+ pMinMaxInfo = Cast(MINMAXINFO Ptr,lParam)
+ pMinMaxInfo->ptMinTrackSize.x = pWindow->ScaleX( 622 )
+ pMinMaxInfo->ptMinTrackSize.y = pWindow->ScaleY( 436 )
+ pMinMaxInfo->ptMaxTrackSize.x = pMinMaxInfo->ptMaxTrackSize.x
+ pMinMaxInfo->ptMaxTrackSize.y = pMinMaxInfo->ptMaxTrackSize.y
+ return 0
+
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmSnippets_Show
+' ========================================================================================
+public Function frmSnippets_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ DIM hBitmap AS HBITMAP
+ dim hCtrl as HWnd
+ dim wszImage as wstring * 100
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ ' Resize the Form should the user have previously manually resized it.
+ dim as long nLeft, nTop, nWidth, nHeight
+ If IsRectEmpty( @gConfig.rcSnippets ) = false then
+ nLeft = gConfig.rcSnippets.left
+ nTop = gConfig.rcSnippets.top
+ nWidth = gConfig.rcSnippets.right - gConfig.rcSnippets.left
+ nHeight = gConfig.rcSnippets.bottom - gConfig.rcSnippets.top
+ else
+ Dim rcWork As Rect = pWindow->GetWorkArea
+ nWidth = (rcWork.Right - rcWork.Left) * .60
+ nHeight = (rcWork.Bottom - rcWork.Top) * .80
+ end if
+
+ Dim As HWnd hForm = _
+ pWindow->Create(hWndParent, L(88,"User Snippets"), _
+ @frmSnippets_WndProc, nLeft, nTop, nWidth, nHeight, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN or WS_THICKFRAME, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT )
+
+ If IsRectEmpty( @gConfig.rcSnippets ) then
+ pWindow->Center(pWindow->hWindow, hWndParent)
+ end if
+
+ ' Set the small and large icon for the main window (must be set after main window is created)
+ pWindow->BigIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 32, 32, LR_SHARED)
+ pWindow->SmallIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 16, 16, LR_SHARED)
+
+ pWindow->AddControl("LISTBOX", , IDC_FRMSNIPPETS_LIST1, "", 10, 10, 218, 362, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or _
+ LBS_NOINTEGRALHEIGHT Or LBS_HASSTRINGS, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR )
+
+ pWindow->AddControl("LABEL", , IDC_FRMSNIPPETS_LABEL1, L(278,"Description") & ":", 240, 11, 91, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMSNIPPETS_TXTDESCRIPTION, "", 240, 32, 372, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMSNIPPETS_LABEL2, L(89,"Trigger") & ":", 240, 56, 100, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMSNIPPETS_TXTTRIGGER, "", 240, 77, 130, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("LABEL", , IDC_FRMSNIPPETS_LABEL4, "(" & L(90,"Press TAB in code editor to activate") & ")", 376, 77, 350, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("LABEL", , IDC_FRMSNIPPETS_LABEL3, L(328,"Code") & ":", 240, 101, 91, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ hCtrl = _
+ pWindow->AddControl("MULTILINETEXTBOX", , IDC_FRMSNIPPETS_TXTCODE, "", 240, 122, 372, 270, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or _ 'WS_HSCROLL or WS_VSCROLL or _
+ ES_LEFT Or ES_MULTILINE or ES_WANTRETURN or ES_AUTOHSCROLL or ES_AUTOVSCROLL or WS_HSCROLL or WS_VSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmSnippets_TextBox_SubclassProc), IDC_FRMSNIPPETS_TXTCODE, Cast(DWORD_PTR, @pWindow))
+ dim as HFONT _hFont = pWindow->CreateFont( gConfig.EditorFontname, Val(**gConfig.EditorFontsize) )
+ AfxSetWindowFont( hCtrl, _hFont )
+
+ pWindow->AddControl("BUTTON", , IDC_FRMSNIPPETS_CMDINSERT, L(281, "Insert"), 8, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMSNIPPETS_CMDDELETE, L(282, "Delete"), 87, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ hCtrl = _
+ pWindow->AddControl("BUTTON", , IDC_FRMSNIPPETS_CMDUP, wszTriangleUp, 166, 388, 28, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghMenuBar.hFontSymbolLargeBold, false )
+
+ hCtrl = _
+ pWindow->AddControl("BUTTON", , IDC_FRMSNIPPETS_CMDDOWN, wszTriangleDown, 199, 388, 28, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghMenuBar.hFontSymbolLargeBold, false )
+
+ pWindow->AddControl("LABEL", , IDC_FRMSNIPPETS_LBLPARAMETERS, L(172,"Use right-click popup menu to insert parameters"), _
+ 240, 388, 212, 34, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMSNIPPETS_CMDOK, L(0,"OK"), 454, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(1,"Cancel"), 536, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ HWND_FRMSNIPPETS = hForm
+
+ ' Copy all of the Snippets to the SnippetsTemp array because we will work with
+ ' temporary copies until the user hits OK.
+ redim gConfig.SnippetsTemp(ubound(gConfig.Snippets))
+ for i as long = lbound(gConfig.Snippets) to ubound(gConfig.Snippets)
+ gConfig.SnippetsTemp(i) = gConfig.Snippets(i)
+ NEXT
+ frmSnippets_LoadListBox( hForm )
+
+ ListBox_SetCurSel( GetDlgItem(hForm, IDC_FRMSNIPPETS_LIST1), 0 )
+ frmSnippets_SetTextboxes()
+
+ frmSnippets_PositionWindows
+
+ SetFocus GetDlgItem(hForm, IDC_FRMSNIPPETS_LIST1)
+
+ ' Process Windows messages(modal)
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the frmSnippets CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
diff --git a/src/frmStatusBar.inc b/src/frmStatusBar.inc
index 2240145e..ccf9be11 100644
--- a/src/frmStatusBar.inc
+++ b/src/frmStatusBar.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmStatusBar.inc.bak b/src/frmStatusBar.inc.bak
new file mode 100644
index 00000000..2240145e
--- /dev/null
+++ b/src/frmStatusBar.inc.bak
@@ -0,0 +1,322 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+Function frmStatusBar_PositionWindows() As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN_STATUSBAR)
+ If pWindow = 0 Then Exit Function
+
+ ' Get the entire client area
+ Dim As Rect rc
+ GetClientRect(HWND_FRMMAIN_STATUSBAR, @rc)
+
+ dim as long i = 0
+ dim as long nLeft = rc.left
+ dim as long nSpacer = pWindow->ScaleX(4)
+
+ ' the text for each panel is set in frmMain_SetStatusbar which then calls this
+ ' function to determine proper sizing and placement.
+
+ '''' LEFT ALIGNED STATUSBAR PANELS ''''
+ i = 0 ' Ln 23, Col 20
+ gSBPanels(i).rc.Left = nLeft
+ gSBPanels(i).rc.top = rc.top
+ gSBPanels(i).rc.right = nLeft + _
+ pWindow->ScaleX( getTextWidth( HWND_FRMMAIN_STATUSBAR, gSBPanels(i).wszText, ghStatusBar.hFontStatusBar, 4 ) )
+ gSBPanels(i).rc.bottom = rc.bottom
+ gSBPanels(i).nID = IDM_GOTO
+ nLeft = gSBPanels(i).rc.right + nSpacer
+
+ '''' RIGHT ALIGNED STATUSBAR PANELS ''''
+ grcGripper = rc
+ grcGripper.top = (rc.bottom-rc.top) / 2
+ grcGripper.left = rc.right - (nSpacer * 4)
+
+ i = 6 ' CRLF
+ dim as long nRight = grcGripper.left
+ gSBPanels(i).rc.Left = nRight - _
+ pWindow->ScaleX( getTextWidth( HWND_FRMMAIN_STATUSBAR, gSBPanels(i).wszText, ghStatusBar.hFontStatusBar, 4 ) )
+ gSBPanels(i).rc.top = rc.top
+ gSBPanels(i).rc.right = nRight
+ gSBPanels(i).rc.bottom = rc.bottom
+ gSBPanels(i).nID = IDM_LINEENDINGS
+ nRight = gSBPanels(i).rc.left - nSpacer
+
+ i -= 1 ' UTF-8
+ gSBPanels(i).rc.Left = nRight - _
+ pWindow->ScaleX( getTextWidth( HWND_FRMMAIN_STATUSBAR, gSBPanels(i).wszText, ghStatusBar.hFontStatusBar, 4 ) )
+ gSBPanels(i).rc.top = rc.top
+ gSBPanels(i).rc.right = nRight
+ gSBPanels(i).rc.bottom = rc.bottom
+ gSBPanels(i).nID = IDM_FILEENCODING
+ nRight = gSBPanels(i).rc.left - nSpacer
+
+ i -= 1 ' Spaces: 3
+ gSBPanels(i).rc.Left = nRight - _
+ pWindow->ScaleX( getTextWidth( HWND_FRMMAIN_STATUSBAR, gSBPanels(i).wszText, ghStatusBar.hFontStatusBar, 4 ) )
+ gSBPanels(i).rc.top = rc.top
+ gSBPanels(i).rc.right = nRight
+ gSBPanels(i).rc.bottom = rc.bottom
+ gSBPanels(i).nID = IDM_SPACES
+ nRight = gSBPanels(i).rc.left - nSpacer
+
+ i -= 1 ' Main/Resource/Module/Normal
+ if gApp.IsProjectActive then
+ gSBPanels(i).rc.Left = nRight - _
+ pWindow->ScaleX( getTextWidth( HWND_FRMMAIN_STATUSBAR, gSBPanels(i).wszText, ghStatusBar.hFontStatusBar, 4 ) )
+ gSBPanels(i).rc.top = rc.top
+ gSBPanels(i).rc.right = nRight
+ gSBPanels(i).rc.bottom = rc.bottom
+ gSBPanels(i).nID = IDM_PROJECTFILETYPE
+ nRight = gSBPanels(i).rc.left - nSpacer
+ else
+ SetRectEmpty( @gSBPanels(i).rc )
+ end if
+
+ i -= 1 ' Build Configuration
+ gSBPanels(i).rc.Left = nRight - _
+ pWindow->ScaleX( getTextWidth( HWND_FRMMAIN_STATUSBAR, gSBPanels(i).wszText, ghStatusBar.hFontStatusBar, 4 ) )
+ gSBPanels(i).rc.top = rc.top
+ gSBPanels(i).rc.right = nRight
+ gSBPanels(i).rc.bottom = rc.bottom
+ gSBPanels(i).nID = IDM_BUILDCONFIG
+ nRight = gSBPanels(i).rc.left - nSpacer
+
+ '''' THE MESSAGES PANEL FILLS THE REMAINING AVAILABLE SPACE ''''
+ i = 1 ' Compile status and error messages
+ gSBPanels(i).rc.Left = gSBPanels(0).rc.right
+ gSBPanels(i).rc.top = rc.top
+ gSBPanels(i).rc.right = gSBPanels(2).rc.Left
+ gSBPanels(i).rc.bottom = rc.bottom
+ gSBPanels(i).nID = IDM_VIEWOUTPUT
+
+ AfxRedrawWindow( HWND_FRMMAIN_STATUSBAR )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmStatusBar
+' ========================================================================================
+Function frmStatusBar_OnSize( _
+ ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+ If state <> SIZE_MINIMIZED Then
+ frmStatusBar_PositionWindows()
+ End If
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmStatusBar Window procedure
+' ========================================================================================
+Function frmStatusBar_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ static as long prev_idxHot = -1
+ static as long curr_idxHot = -1
+ static as boolean resizing
+ static as POINT prev_pt
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_SIZE, frmStatusBar_OnSize)
+
+ case WM_DESTROY
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(HWnd)
+ If pWindow = 0 Then Delete pWindow
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_LBUTTONDOWN
+ ' Are we over the resize gripper
+' dim as POINT pt: GetCursorPos( @pt )
+' MapWindowPoints( HWND_DESKTOP, HWnd, cast( POINT ptr, @pt ), 1 )
+' if PtInRect( @grcGripper, pt ) then
+' SetCursor LoadImage( Null, MAKEINTRESOURCEW(OCR_SIZENWSE), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or LR_SHARED )
+' resizing = true
+' prev_pt = pt
+ SetCapture( HWnd )
+' end if
+
+ case WM_MOUSEMOVE
+ Dim tme As TrackMouseEvent
+ tme.cbSize = Sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER Or TME_LEAVE
+ tme.hwndTrack = HWnd
+ TrackMouseEvent(@tme)
+
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, HWnd, cast( POINT ptr, @pt ), 1 )
+
+ ' Are we over the resize gripper
+' if PtInRect( @grcGripper, pt ) then
+' SetCursor LoadImage( Null, MAKEINTRESOURCEW(OCR_SIZENWSE), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or LR_SHARED )
+' else
+' SetCursor( LoadCursor( null, IDC_ARROW ))
+' end if
+ if resizing then
+' dim as long xDelta = prev_pt.x - pt.x
+' dim as long yDelta = prev_pt.y - pt.y
+' ' Resize the main form
+' dim as RECT rcMain = AfxGetWindowRect( HWND_FRMMAIN )
+' dim as long nWidth = rcMain.right - rcMain.left - xDelta
+' dim as long nHeight = rcMain.bottom - rcMain.top - yDelta
+' SetWindowPos( HWND_FRMMAIN, 0, 0, 0, nWidth, nHeight, SWP_NOMOVE or SWP_NOZORDER )
+ else
+ ' Are we over one of the status bar panels
+ curr_idxHot = -1
+ for i as long = lbound(gSBPanels) to ubound(gSBPanels)
+ if PtInRect( @gSBPanels(i).rc, pt ) then
+ ' Only make hot panels that have actual text
+ if len(gSBPanels(i).wszText) then
+ curr_idxHot = i
+ gSBPanels(i).isHot = true
+ end if
+ else
+ gSBPanels(i).isHot = false
+ end if
+ next
+ if curr_idxHot <> prev_idxHot then
+ AfxRedrawWindow( HWnd )
+ prev_idxHot = curr_idxHot
+ end if
+ end if
+
+ case WM_MOUSELEAVE
+ for i as long = lbound(gSBPanels) to ubound(gSBPanels)
+ gSBPanels(i).isHot = false
+ next
+ prev_idxHot = -1
+ curr_idxHot = -1
+ AfxRedrawWindow( HWnd )
+
+ case WM_LBUTTONUP
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, HWnd, cast( POINT ptr, @pt ), 1 )
+ SetCursor( LoadCursor( null, IDC_ARROW ))
+ ReleaseCapture
+ resizing = false
+ ' Are we over one of the status bar panels
+ for i as long = lbound(gSBPanels) to ubound(gSBPanels)
+ if PtInRect( @gSBPanels(i).rc, pt ) then
+ PostMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(gSBPanels(i).nID, 0), 0 )
+ exit for
+ end if
+ next
+
+ case WM_PAINT
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDc
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN_STATUSBAR)
+ If pWindow = 0 Then Exit Function
+
+ hDC = BeginPaint(hWnd, @ps)
+
+ SaveDC(hDC)
+ dim as long nWidth = ps.rcPaint.right - ps.rcPaint.left
+ dim as long nHeight = ps.rcPaint.bottom - ps.rcPaint.top
+
+ Dim memDC as HDC ' Double buffering
+ Dim hbit As HBITMAP ' Double buffering
+
+ memDC = CreateCompatibleDC( hDC )
+ hbit = CreateCompatibleBitmap( hDC, nWidth, nHeight )
+
+ SaveDC(memDC)
+ SelectObject( memDC, hbit )
+
+ if ghStatusBar.hFontStatusBar then SelectObject(memDC, ghStatusBar.hFontStatusBar)
+
+ FillRect( memDC, @ps.rcPaint, ghStatusBar.hPanelBrush )
+
+ ' paint the panels
+ for i as long = lbound(gSBPanels) to ubound(gSBPanels)
+ SetBkColor( memDC, iif( gSBPanels(i).isHot, ghStatusBar.BackColorHot, ghStatusBar.BackColor) )
+ SetTextColor( memDC, iif( gSBPanels(i).isHot, ghStatusBar.ForeColorHot, ghStatusBar.ForeColor) )
+ FillRect( memDC, @gSBPanels(i).rc, iif( gSBPanels(i).isHot, ghStatusBar.hBackBrushHot, ghStatusBar.hBackBrush) )
+ dim as long wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, gSBPanels(i).wszText.sptr, -1, Cast(lpRect, @gSBPanels(i).rc), wsStyle )
+
+ ' if this is the compile result panel then display the green/success or red/failure "icon"
+ if i = 1 then
+ if (gApp.IsProjectLoading = false) andalso (gApp.IsFileLoading = false) then
+ dim as COLORREF clr = ghStatusBar.BackColor
+ if gApp.hIconPanel = ghIconGood then clr = ghGeneral.iconsuccess
+ if gApp.hIconPanel = ghIconBad then clr = ghGeneral.iconfail
+ dim as long txtWidth = getTextWidth( HWND_FRMMAIN_STATUSBAR, gSBPanels(i).wszText, ghStatusBar.hFontStatusBar, 0 )
+ SetTextColor( memDC, clr )
+ dim as RECT rcBitmap = gSBPanels(i).rc
+ dim as long halfWidth = (rcBitmap.right-rcBitmap.left) / 2
+ rcBitmap.right = rcBitmap.left + halfWidth - pWindow->ScaleX((txtWidth / 2))
+ rcBitmap.left = rcBitmap.right - pWindow->ScaleX(16)
+
+ dim as long wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER or DT_SINGLELINE
+ DrawText( memDC, wszCompileResultIcon, -1, Cast(lpRect, @rcBitmap), wsStyle )
+ end if
+ end if
+ next
+
+ BitBlt hDC, 0, 0, nWidth, nHeight, memDC, 0, 0, SRCCOPY
+
+ ' Cleanup
+ RestoreDC(memDC, -1)
+ If hbit Then DeleteObject(hbit)
+ If memDC Then DeleteDC(memDC)
+ RestoreDC(hDC, -1)
+
+ EndPaint hWnd, @ps
+
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmStatusBar_Show
+' ========================================================================================
+Function frmStatusBar_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMMAIN_STATUSBAR = pWindow->Create( hWndParent, "", @frmStatusBar_WndProc, _
+ 0, 0, 0, STATUSBAR_HEIGHT, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ frmStatusBar_PositionWindows()
+ Function = 0
+
+End Function
+
diff --git a/src/frmStatusBarEditor.bi b/src/frmStatusBarEditor.bi
index 0dfe652f..b878b48d 100644
--- a/src/frmStatusBarEditor.bi
+++ b/src/frmStatusBarEditor.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmStatusBarEditor.bi.bak b/src/frmStatusBarEditor.bi.bak
new file mode 100644
index 00000000..0dfe652f
--- /dev/null
+++ b/src/frmStatusBarEditor.bi.bak
@@ -0,0 +1,53 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#DEFINE IDC_FRMSTATUSBAREDITOR_CMDOK 1000
+#DEFINE IDC_FRMSTATUSBAREDITOR_CMDPICSELECT 1001
+#DEFINE IDC_FRMSTATUSBAREDITOR_PICIMAGE 1002
+#DEFINE IDC_FRMSTATUSBAREDITOR_CMDPANELINSERT 1003
+#DEFINE IDC_FRMSTATUSBAREDITOR_CMDPANELDELETE 1004
+#DEFINE IDC_FRMSTATUSBAREDITOR_CMDPANELDOWN 1005
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL6 1006
+#DEFINE IDC_FRMSTATUSBAREDITOR_TXTMINWIDTH 1007
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL7 1008
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL5 1009
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL4 1010
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL3 1011
+#DEFINE IDC_FRMSTATUSBAREDITOR_COMBOAUTOSIZE 1012
+#DEFINE IDC_FRMSTATUSBAREDITOR_COMBOBORDERSTYLE 1013
+#DEFINE IDC_FRMSTATUSBAREDITOR_COMBOSTYLE 1014
+#DEFINE IDC_FRMSTATUSBAREDITOR_COMBOALIGNMENT 1015
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL2 1016
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL1 1017
+#DEFINE IDC_FRMSTATUSBAREDITOR_TXTTOOLTIP 1018
+#DEFINE IDC_FRMSTATUSBAREDITOR_TXTTEXT 1019
+#DEFINE IDC_FRMSTATUSBAREDITOR_LSTPANELS 1020
+#DEFINE IDC_FRMSTATUSBAREDITOR_FRAME1 1021
+#DEFINE IDC_FRMSTATUSBAREDITOR_CMDPANELUP 1022
+#Define IDC_FRMSTATUSBAREDITOR_CHKDISPLAYONFORM 1024
+#Define IDC_FRMSTATUSBAREDITOR_CMDPANELADD 1025
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL8 1026
+#DEFINE IDC_FRMSTATUSBAREDITOR_TXTWIDTH 1027
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL9 1028
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL10 1029
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL11 1030
+#DEFINE IDC_FRMSTATUSBAREDITOR_LABEL12 1031
+#DEFINE IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLOR 1032
+#DEFINE IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLORHOT 1033
+#DEFINE IDC_FRMSTATUSBAREDITOR_COMBOFORECOLOR 1034
+#DEFINE IDC_FRMSTATUSBAREDITOR_COMBOFORECOLORHOT 1035
+
+declare Function frmStatusBarEditor_CreateFakeStatusBar( ByVal pDoc as clsDocument ptr ) As Long
+declare Function frmStatusBarEditor_Show( ByVal hWndParent As HWnd, byval nDefaultPanel as Long ) as LRESULT
diff --git a/src/frmStatusBarEditor.inc b/src/frmStatusBarEditor.inc
index 85688ccc..3e846068 100644
--- a/src/frmStatusBarEditor.inc
+++ b/src/frmStatusBarEditor.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmStatusBarEditor.inc.bak b/src/frmStatusBarEditor.inc.bak
new file mode 100644
index 00000000..85688ccc
--- /dev/null
+++ b/src/frmStatusBarEditor.inc.bak
@@ -0,0 +1,909 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmStatusBarEditor.bi"
+#include once "clsPanelItem.bi"
+#include once "clsConfig.bi"
+
+
+' ========================================================================================
+' Create the statusbar to display on the Form
+' ========================================================================================
+public Function frmStatusBarEditor_CreateFakeStatusBar( ByVal pDoc as clsDocument ptr ) As Long
+
+ if pDoc = 0 then exit function
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr( pDoc->hWndForm )
+ if pWindow = 0 then exit function
+
+ ' Only create the StatusBar if PanelItems actually exist.
+ if pDoc->StatusBarExists = false then
+ ShowWindow( pDoc->hWndStatusBar, SW_HIDE )
+ exit function
+ end if
+
+ dim rc as RECT
+ GetClientRect( pDoc->hWndForm, @rc )
+
+ dim as long nHeight = AfxGetWindowHeight( pDoc->hWndStatusBar )
+ SetWindowPos( pDoc->hWndStatusBar, 0, _
+ 0, rc.bottom - nHeight, rc.right, nHeight, _
+ SWP_NOZORDER )
+
+
+ ' Size the panels in order to accommodate autosize
+ dim as long lb = 0
+ dim as long ub = ubound(pDoc->PanelItems)
+ dim as long nPanelWidth, nPanelMinWidth, nTotalPanelWidths
+ dim as long nSpringIndex = -1
+ Dim As Long nTemp(ub) ' panel widths (-1 if Spring)
+ Dim As Long nWidths(ub) ' final panel cummulative widths array
+
+ Dim pWindowMain As CWindow Ptr = AfxCWindowPtr( HWND_FRMMAIN )
+ SendMessage( pDoc->hWndStatusBar, WM_SETFONT, cast(WPARAM, pWindowMain->font), cast(LPARAM, CTRUE))
+
+ dim as single cx = pWindow->rxRatio
+
+ for i as long = lb to ub
+ dim as long nPanelWidth = val( pDoc->PanelItems(i).wszWidth ) * cx
+ dim as long nPanelMinWidth = val( pDoc->PanelItems(i).wszMinWidth ) * cx
+
+ dim as single cx = pWindow->rxRatio
+
+ select case ucase( pDoc->PanelItems(i).wszAutoSize )
+ case "STATUSBARPANELAUTOSIZE.NONE"
+ nPanelWidth = val( pDoc->PanelItems(i).wszWidth ) * cx
+ nPanelMinWidth = val( pDoc->PanelItems(i).wszMinWidth ) * cx
+ if nPanelWidth < nPanelMinWidth then nPanelWidth = nPanelMinWidth
+ case "STATUSBARPANELAUTOSIZE.CONTENTS"
+ dim as WString * MAX_PATH wszBuffer = " " & pDoc->PanelItems(i).wszText & " "
+ dim as long nTextWidth = GetTextWidthPixels( pDoc->hWndStatusBar, wszBuffer )
+ ' Also need to calculate the width of any defined panel image.
+ ' ImageName is held in pProp.wszPropValue
+ dim as long nImageWidth
+ if len(pDoc->PanelItems(i).pProp.wszPropValue) then
+ nImageWidth = AfxScaleX(20) ' 16 + 4 padding
+ end if
+ nPanelWidth = nTextWidth + nImageWidth
+ if nPanelWidth < nPanelMinWidth then nPanelWidth = nPanelMinWidth
+ case "STATUSBARPANELAUTOSIZE.SPRING"
+ nSpringIndex = i
+ nPanelWidth = 0
+ end select
+ nTemp(i) = nPanelWidth
+ nTotalPanelWidths = nTotalPanelWidths + nPanelWidth
+ NEXT
+
+ ' Handle the Panel that may have been designated as AutoSize = Spring
+ if nSpringIndex <> -1 then
+ nTemp(nSpringIndex) = MAX(0, rc.right - nTotalPanelWidths)
+ end if
+
+ ' Build the cumulative Panel Widths array that gets sent to the StatusBar
+ for i as long = lb to ub
+ nWidths(i) = iif(i, nWidths(i-1), 0) + nTemp(i)
+ next
+ StatusBar_SetParts( pDoc->hWndStatusBar, (ub-lb)+1, @nWidths(0))
+
+ ' Set the text/icons for the panels. Need to do this after the widths are set.
+ ' Basically, a call to SetText with SBT_OWNERDRAW will fire WM_DRAWITEM in the
+ ' parent form. That is where the images and icons are actually drawn.
+ for i as long = lb to ub
+ StatusBar_SetText( pDoc->hWndStatusBar, i, "", SBT_OWNERDRAW )
+ next
+
+ ShowWindow( pDoc->hWndStatusBar, SW_SHOW )
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Display the entries in the StatusBarEditor Listbox
+' ========================================================================================
+private Function frmStatusBarEditor_DisplayListBox( ByVal nIndex As Long ) As Long
+
+ ' Display the panel items in the listbox
+ dim hList as hwnd = GetDlgItem( HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_LSTPANELS )
+
+ ListBox_ResetContent( hList )
+ for i as long = 0 to ubound(gPanelItems)
+ gPanelItems(i).wszName = "StatusBar Panel " & i
+ ListBox_AddString( hList, gPanelItems(i).wszName.sptr )
+ next
+ ListBox_SetCurSel( hList, nIndex )
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Swap two entries in the StatusBarEditor Listbox
+' ========================================================================================
+private function frmStatusBarEditor_SwapListBoxItems( byval Item1 as long, _
+ Byval Item2 as long _
+ ) as Long
+ ' Do not swap the Panel Name
+ dim as CWSTR wszPanelName1 = gPanelItems(Item1).wszName
+ dim as CWSTR wszPanelName2 = gPanelItems(Item2).wszName
+
+ ' Swap the array values
+ swap gPanelItems(Item1), gPanelItems(Item2)
+
+ gPanelItems(Item1).wszName = wszPanelName1
+ gPanelItems(Item2).wszName = wszPanelName2
+
+ frmStatusBarEditor_DisplayListBox( Item2 )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Set the frmStatusBarEditor textboxes and options depending on what listbox entry is selected
+' ========================================================================================
+private function frmStatusBarEditor_SetTextboxes() as long
+ dim as HWND hListBox = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_LSTPANELS)
+ dim as long nCurSel = ListBox_GetCurSel( hListBox )
+ dim as Boolean fEnabled = iif( nCurSel < 0, false, true)
+ if ListBox_GetCount( hListBox ) = 0 then fEnabled = false
+
+ dim wszText as WString * MAX_PATH
+ dim as HWND hCtrl
+ dim as long nIndex
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_TXTTEXT)
+ EnableWindow( hCtrl, fEnabled)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszText else wszText = ""
+ AfxSetWindowText( hCtrl, wszText )
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_TXTTOOLTIP)
+ EnableWindow( hCtrl, fEnabled)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszTooltip else wszText = ""
+ AfxSetWindowText( hCtrl, wszText )
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_COMBOALIGNMENT)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszAlignment else wszText = ""
+ nIndex = ComboBox_FindStringExact( hCtrl, -1, @wszText )
+ ComboBox_SetCurSel( hCtrl, nIndex)
+ EnableWindow( hCtrl, fEnabled)
+
+ ' BorderStyle is deprecated as of v2.0.4 as it has no effect
+ ' in WinFBE programs where Windows Themes are enabled.
+ 'hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_COMBOBORDERSTYLE)
+ 'if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszBorderStyle else wszText = ""
+ 'nIndex = ComboBox_FindStringExact( hCtrl, -1, @wszText )
+ 'ComboBox_SetCurSel( hCtrl, nIndex)
+ 'EnableWindow( hCtrl, fEnabled)
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_COMBOAUTOSIZE)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszAutoSize else wszText = ""
+ nIndex = ComboBox_FindStringExact( hCtrl, -1, @wszText )
+ ComboBox_SetCurSel( hCtrl, nIndex)
+ EnableWindow( hCtrl, fEnabled)
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_TXTWIDTH)
+ EnableWindow( hCtrl, fEnabled)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszWidth else wszText = ""
+ AfxSetWindowText( hCtrl, wszText )
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_TXTMINWIDTH)
+ EnableWindow( hCtrl, fEnabled)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszMinWidth else wszText = ""
+ AfxSetWindowText( hCtrl, wszText )
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_CMDPICSELECT)
+ EnableWindow( hCtrl, fEnabled )
+
+ ' Display any panel image
+ dim pImageCtx as CImageCtx PTR = AfxCImageCtxPtr(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_PICIMAGE)
+ if pImageCtx = 0 then exit function
+
+ if nCurSel <> -1 then
+ dim pImageType as IMAGES_TYPE ptr
+ dim wszImageName as wstring * MAX_PATH
+ dim as CWSTR wszFilename
+ wszImageName = gPanelItems(nCurSel).pProp.wszPropValue
+ pImageType = GetImagesTypePtr(wszImageName)
+
+ hCtrl = GetDlgItem( HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_PICIMAGE )
+ if pImageType then
+ wszFilename = pImageType->wszFileName
+ pImageCtx->LoadImageFromFile(wszFilename)
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMSTATUSBAREDITOR)
+ if pWindow then
+ pImageCtx->SetImageWidth( pWindow->ScaleX(pImageCtx->GetImageWidth) )
+ pImageCtx->SetImageHeight( pWindow->ScaleY(pImageCtx->GetImageHeight) )
+ end if
+ pImageCtx->SetImageAdjustment( GDIP_IMAGECTX_ACTUALSIZE, CTRUE )
+ ShowWindow( hCtrl, SW_SHOW )
+ else
+ ShowWindow( hCtrl, SW_HIDE )
+ end if
+ end if
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLOR)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszBackColor else wszText = ""
+ AfxSetWindowText( hCtrl, wszText )
+ EnableWindow( hCtrl, fEnabled)
+ AfxRedrawWindow(hCtrl)
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_COMBOFORECOLOR)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszForeColor else wszText = ""
+ AfxSetWindowText( hCtrl, wszText )
+ EnableWindow( hCtrl, fEnabled)
+ AfxRedrawWindow(hCtrl)
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLORHOT)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszBackColorHot else wszText = ""
+ AfxSetWindowText( hCtrl, wszText )
+ EnableWindow( hCtrl, fEnabled)
+ AfxRedrawWindow(hCtrl)
+
+ hCtrl = GetDlgItem(HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_COMBOFORECOLORHOT)
+ if nCurSel <> -1 then wszText = gPanelItems(nCurSel).wszForeColorHot else wszText = ""
+ AfxSetWindowText( hCtrl, wszText )
+ EnableWindow( hCtrl, fEnabled)
+ AfxRedrawWindow(hCtrl)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmStatusBarEditor
+' ========================================================================================
+private Function frmStatusBarEditor_OnCreate( ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmStatusBarEditor
+' ========================================================================================
+private Function frmStatusBarEditor_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim as hwnd hList1 = GetDlgItem( HWND, IDC_FRMSTATUSBAREDITOR_LSTPANELS)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+
+ Select Case id
+ case IDC_FRMSTATUSBAREDITOR_LSTPANELS
+ if codeNotify = LBN_SELCHANGE THEN
+ frmStatusBarEditor_SetTextboxes()
+ END IF
+
+
+ CASE IDC_FRMSTATUSBAREDITOR_TXTTEXT
+ if codeNotify = EN_CHANGE THEN
+ if nCurSel > -1 THEN gPanelItems(nCurSel).wszText = AfxGetWindowText(hwndCtl)
+ end if
+
+
+ CASE IDC_FRMSTATUSBAREDITOR_TXTTOOLTIP
+ if codeNotify = EN_CHANGE THEN
+ if nCurSel > -1 THEN gPanelItems(nCurSel).wszTooltip = AfxGetWindowText(hwndCtl)
+ end if
+
+
+ case IDC_FRMSTATUSBAREDITOR_COMBOALIGNMENT
+ if codeNotify = CBN_SELCHANGE THEN
+ if nCurSel > -1 THEN gPanelItems(nCurSel).wszAlignment = AfxGetWindowText(hwndCtl)
+ END IF
+
+
+ ' BorderStyle is deprecated as of v2.0.4 as it has no effect
+ ' in WinFBE programs where Windows Themes are enabled.
+ 'case IDC_FRMSTATUSBAREDITOR_COMBOBORDERSTYLE
+ ' if codeNotify = CBN_SELCHANGE THEN
+ ' if nCurSel > -1 THEN gPanelItems(nCurSel).wszBorderStyle = AfxGetWindowText(hwndCtl)
+ ' END IF
+
+
+ case IDC_FRMSTATUSBAREDITOR_COMBOAUTOSIZE
+ if codeNotify = CBN_SELCHANGE THEN
+ if nCurSel > -1 THEN
+ dim as CWSTR wszAutoSize = AfxGetWindowText(hwndCtl)
+ ' Only one panel can have AutoSize set to Spring. Reset all panels
+ ' that have Spring set and then set this panel to have the Spring.
+ if wszAutoSize = "StatusBarPanelAutoSize.Spring" then
+ for i as long = lbound(gPanelItems) to ubound(gPanelItems)
+ if gPanelItems(i).wszAutoSize = "StatusBarPanelAutoSize.Spring" then
+ gPanelItems(i).wszAutoSize = "StatusBarPanelAutoSize.None"
+ end if
+ next
+ end if
+ gPanelItems(nCurSel).wszAutoSize = wszAutoSize
+ end if
+ END IF
+
+
+ CASE IDC_FRMSTATUSBAREDITOR_TXTWIDTH
+ if codeNotify = EN_CHANGE THEN
+ if nCurSel > -1 THEN gPanelItems(nCurSel).wszWidth = AfxGetWindowText(hwndCtl)
+ end if
+
+
+ CASE IDC_FRMSTATUSBAREDITOR_TXTMINWIDTH
+ if codeNotify = EN_CHANGE THEN
+ if nCurSel > -1 THEN gPanelItems(nCurSel).wszMinWidth = AfxGetWindowText(hwndCtl)
+ end if
+
+
+ case IDC_FRMSTATUSBAREDITOR_CMDPANELUP
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > 0 THEN
+ frmStatusBarEditor_SwapListboxItems(nCurSel, nCurSel - 1)
+ END IF
+ end if
+
+
+ case IDC_FRMSTATUSBAREDITOR_CMDPANELDOWN
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel < ListBox_GetCount(hList1)-1 THEN
+ frmStatusBarEditor_SwapListboxItems(nCurSel, nCurSel + 1)
+ END IF
+ end if
+
+
+ case IDC_FRMSTATUSBAREDITOR_CMDPANELADD
+ if codeNotify = BN_CLICKED THEN
+ if ubound(gPanelItems) = -1 THEN
+ redim gPanelItems(0)
+ nCurSel = 0
+ Else
+ Redim Preserve gPanelItems(Ubound(gPanelItems)+1)
+ nCurSel = Ubound(gPanelItems)
+ END IF
+ dim newPanelItem as clsPanelItem
+ gPanelItems(nCurSel) = newPanelItem
+ frmStatusBarEditor_DisplayListBox( nCurSel )
+ frmStatusBarEditor_SetTextBoxes
+ end if
+
+
+ case IDC_FRMSTATUSBAREDITOR_CMDPANELINSERT
+ if codeNotify = BN_CLICKED THEN
+ if ubound(gPanelItems) = -1 THEN
+ redim gPanelItems(0)
+ nCurSel = 0
+ Else
+ Redim Preserve gPanelItems(Ubound(gPanelItems)+1)
+ if nCurSel = -1 THEN nCurSel = 0
+ for i as long = ubound(gPanelItems) to nCurSel + 1 step -1
+ gPanelItems(i) = gPanelItems(i-1)
+ NEXT
+ END IF
+ dim newPanelItem as clsPanelItem
+ gPanelItems(nCurSel) = newPanelItem
+ frmStatusBarEditor_DisplayListBox( nCurSel )
+ frmStatusBarEditor_SetTextBoxes
+ end if
+
+
+ case IDC_FRMSTATUSBAREDITOR_CMDPANELDELETE
+ If codeNotify = BN_CLICKED Then
+ if nCurSel > -1 THEN
+ if ubound(gPanelItems) = 0 THEN
+ erase gPanelItems
+ nCurSel = -1
+ else
+ ' remove the item from the internal array
+ for i as long = nCurSel to ubound(gPanelItems) - 1
+ gPanelItems(i) = gPanelItems(i+1)
+ NEXT
+ redim preserve gPanelItems(ubound(gPanelItems)-1)
+ END IF
+ nCurSel = Min(nCurSel, ubound(gPanelItems))
+ frmStatusBarEditor_DisplayListBox( nCurSel )
+ frmStatusBarEditor_SetTextBoxes
+ end if
+ end if
+
+
+ case IDC_FRMSTATUSBAREDITOR_CMDPICSELECT
+ If codeNotify = BN_CLICKED Then
+ if nCurSel > -1 then
+ frmImageManager_Show( HWND, @gPanelItems(nCurSel).pProp )
+ frmStatusBarEditor_SetTextBoxes
+ end if
+ end if
+
+
+ Case IDC_FRMSTATUSBAREDITOR_CMDOK
+ If codeNotify = BN_CLICKED Then
+ ' Copy the temporary array back to the form's panel items
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ dim as long numItems = ubound(gPanelItems)
+ if numItems > -1 then
+ redim pDoc->PanelItems(numItems)
+ for i as long = lbound(gPanelItems) to ubound(gPanelItems)
+ pDoc->PanelItems(i) = gPanelItems(i)
+ next
+ else
+ erase pDoc->PanelItems
+ end if
+ ' Save the value indicating that we want the statusbar to display in
+ ' the generated code for the form.
+ pDoc->GenerateStatusBar = _
+ iif(Button_GetCheck(GetDlgItem(HWND, IDC_FRMSTATUSBAREDITOR_CHKDISPLAYONFORM)) = BST_CHECKED, true, false)
+ pDoc->UserModified = true
+ end if
+ SendMessage(HWnd, WM_CLOSE, 0, 0)
+ Exit Function
+ end if
+
+
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmStatusBarEditor
+' ========================================================================================
+private Function frmStatusBarEditor_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Reset the global PanelItems array
+ erase gPanelItems
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow( HWnd )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmStatusBarEditor
+' ========================================================================================
+private Function frmStatusBarEditor_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_MEASUREITEM message for window/dialog: frmStatusBarEditor
+' ========================================================================================
+private Function frmStatusBarEditor_OnMeasureItem( ByVal HWnd As HWnd, _
+ ByVal lpmis As MEASUREITEMSTRUCT Ptr _
+ ) As Long
+ ' Set the height of the List box items.
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ lpmis->itemHeight = pWindow->ScaleY(20)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DRAWITEM message for window/dialog: frmStatusBarEditor
+' ========================================================================================
+private Function frmStatusBarEditor_OnDrawItem( ByVal HWnd As HWnd, _
+ ByVal lpdis As Const DRAWITEMSTRUCT Ptr _
+ ) As Long
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ if pWindow = 0 THEN exit function
+
+ dim as hwnd hList1 = GetDlgItem( HWND, IDC_FRMSTATUSBAREDITOR_LSTPANELS)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+
+ Dim As HBRUSH hBrush, hBrushOld
+ Dim As RECT rc, rc2
+ dim as CWSTR wszPropValue
+ Dim wszText As WString * MAX_PATH
+
+
+ Select Case lpdis->itemAction
+ Case ODA_DRAWENTIRE, ODA_SELECT
+
+ SaveDC(lpdis->hDC)
+
+ ' CLEAR BACKGROUND
+ If (lpdis->itemState And ODS_SELECTED) Then
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHT))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHTTEXT))
+ hBrush = GetSysColorBrush(COLOR_HIGHLIGHT)
+ else
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_WINDOW))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT))
+ hBrush = GetSysColorBrush(COLOR_WINDOW)
+ end if
+ SelectObject(lpdis->hDC, hBrush)
+ FillRect(lpdis->hDC, @rc, hBrush)
+
+ ' Exit if no panel is selected
+ if nCurSel = -1 then exit function
+
+ ' COMBOBOX FOR BACK/FORE COLORS
+ select case lpdis->CtlID
+ case IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLOR
+ wszPropValue = gPanelItems(nCurSel).wszBackColor
+ case IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLORHOT
+ wszPropValue = gPanelItems(nCurSel).wszBackColorHot
+ case IDC_FRMSTATUSBAREDITOR_COMBOFORECOLOR
+ wszPropValue = gPanelItems(nCurSel).wszForeColor
+ case IDC_FRMSTATUSBAREDITOR_COMBOFORECOLORHOT
+ wszPropValue = gPanelItems(nCurSel).wszForeColorHot
+ end select
+
+ rc = lpdis->rcItem
+
+ dim as CWSTR wszList, wszValue
+ wszList = AfxStrParse(wszPropValue, 1, "|")
+ wszValue = AfxStrParse(wszPropValue, 2, "|")
+ wszText = wszValue
+ if wszList = "CUSTOM" then wszText = "Custom Color"
+
+ rc.left = pWindow->ScaleX(6)
+ rc.top = rc.top + pWindow->ScaleY(2)
+ rc.right = rc.left + pWindow->ScaleX(16)
+ rc.bottom = rc.bottom - pWindow->ScaleY(2)
+
+ dim as COLORREF rgbClr = GetRGBColorFromProperty(wszPropValue)
+ hBrush = CreateSolidBrush(rgbClr)
+
+ ' DRAW COLOR RECT
+ hBrushOld = SelectObject(lpdis->hDC, hBrush)
+ Rectangle( lpdis->hDC, rc.Left, rc.Top, rc.Right, rc.Bottom)
+ SelectObject( lpdis->hDC, hBrushOld)
+ rc.left = rc.right + pWindow->ScaleX(4)
+ rc.right = lpdis->rcItem.right
+ DeleteObject(hBrush)
+
+ SelectObject(lpdis->hDC, AfxGetWindowFont(hwnd) )
+ DrawText( lpdis->hDC, _
+ wszText, _
+ -1, Cast(lpRect, @rc), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER or DT_NOPREFIX)
+
+ end select
+
+ RestoreDC(lpdis->hDC, -1)
+
+ return True
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed color comboboxes.
+' ========================================================================================
+private Function frmStatusBarEditor_ComboBox_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ Select Case uMsg
+
+ Case WM_GETDLGCODE
+ ' All keyboard input
+ Function = DLGC_WANTALLKEYS
+ Exit Function
+
+
+ case WM_SYSKEYDOWN
+ 'This should suppress the Alt+Down arrow that invokes the combolist dropdown.
+ return true
+
+
+ case WM_KEYDOWN
+ ' Only allow the TAB key to pass through.
+ Select Case wParam
+ Case VK_TAB
+ ' move input fcous to the next/prev control in the tab order
+ dim as Boolean bBackward = iif( GetKeyState(VK_SHIFT) < 0, true, false )
+ Dim As HWnd hCtrl = GetNextDlgTabItem( GetParent(hwnd), HWND, bBackward)
+ SetFocus(hCtrl)
+
+ case else
+ return true
+ end select
+
+
+ case WM_LBUTTONDOWN, WM_LBUTTONDBLCLK
+ ' Catch the mouse down click in order to prevent the subsequent CBN_DROPDOWN and CBN_SELCHANGE
+ ' messages. We don't want the dropdown to show. We will show the popup color selector
+ ' instead.
+ SetFocus(HWND)
+
+ dim as hwnd hList1 = GetDlgItem( HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_LSTPANELS)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+ if nCurSel = -1 then return true
+
+ dim as long nID = GetDlgCtrlID( hwnd )
+ select case nID
+ case IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLOR
+ gPanelItems(nCurSel).pPropColor.wszPropValue = gPanelItems(nCurSel).wszBackColor
+ case IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLORHOT
+ gPanelItems(nCurSel).pPropColor.wszPropValue = gPanelItems(nCurSel).wszBackColorHot
+ case IDC_FRMSTATUSBAREDITOR_COMBOFORECOLOR
+ gPanelItems(nCurSel).pPropColor.wszPropValue = gPanelItems(nCurSel).wszForeColor
+ case IDC_FRMSTATUSBAREDITOR_COMBOFORECOLORHOT
+ gPanelItems(nCurSel).pPropColor.wszPropValue = gPanelItems(nCurSel).wszForeColorHot
+ end select
+ gPanelItems(nCurSel).idColorCombo = nID
+
+ dim as RECT rc
+ GetWindowRect( hwnd, @rc )
+ ' initialize the color popup if not already done so
+ frmVDColors_Show( hwnd, gPanelItems(nCurSel).pPropColor.wszPropValue )
+ dim as long nWidth = AfxGetWindowWidth(HWND_FRMVDCOLORS)
+ SetWindowPos( HWND_FRMVDCOLORS, HWND_TOP, _
+ rc.right - nWidth, rc.bottom, _
+ 0, 0, SWP_NOSIZE or SWP_SHOWWINDOW)
+
+ return true
+
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass HWnd, @frmStatusBarEditor_ComboBox_SubclassProc, uIdSubclass
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+
+' ========================================================================================
+' frmStatusBarEditor Window procedure
+' ========================================================================================
+private Function frmStatusBarEditor_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmStatusBarEditor_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmStatusBarEditor_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmStatusBarEditor_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmStatusBarEditor_OnCommand)
+ HANDLE_MSG (HWnd, WM_MEASUREITEM, frmStatusBarEditor_OnMeasureItem)
+ HANDLE_MSG (HWnd, WM_DRAWITEM, frmStatusBarEditor_OnDrawItem)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmStatusBarEditor_Show
+' ========================================================================================
+public Function frmStatusBarEditor_Show( ByVal hWndParent As HWnd, byval nDefaultPanel as Long ) as LRESULT
+
+ DIM hBitmap AS HBITMAP
+ dim hCtrl as HWnd
+ dim wszImage as wstring * 100
+
+
+ ' Create the main window and child controls
+ Dim pWindow as CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ Dim As HWnd hForm = _
+ pWindow->Create( hWndParent, L(314,"Statusbar Editor"), _
+ @frmStatusBarEditor_WndProc, 0, 0, 508, 478, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->SetClientSize(508, 478)
+ pWindow->Center
+
+ HWND_FRMSTATUSBAREDITOR = hForm
+
+ pWindow->AddControl("LISTBOX", , IDC_FRMSTATUSBAREDITOR_LSTPANELS, "", 21, 14, 465, 84, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or LBS_NOINTEGRALHEIGHT, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMSTATUSBAREDITOR_CMDPANELUP, "", 21, 102, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWUP", "IMAGE_ARROWUP16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMSTATUSBAREDITOR_CMDPANELDOWN, "", 48, 102, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWDOWN", "IMAGE_ARROWDOWN16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMSTATUSBAREDITOR_CMDPANELADD, L(380, "Add"), 77, 102, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_FLAT Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMSTATUSBAREDITOR_CMDPANELINSERT, L(281, "Insert"), 152, 102, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_FLAT Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMSTATUSBAREDITOR_CMDPANELDELETE, L(282, "Delete"), 227, 102, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_FLAT Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL1, L(150,"Text") & ":", 21, 135, 93, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMSTATUSBAREDITOR_TXTTEXT, "", 114, 134, 372, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL2, L(235,"Tooltip Text") & ":", 21, 160, 93, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMSTATUSBAREDITOR_TXTTOOLTIP, "", 114, 158, 372, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL3, L(236,"Alignment") & ":", 21, 194, 93, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMSTATUSBAREDITOR_COMBOALIGNMENT, "", 114, 190, 207, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL6, L(239,"Autosize") & ":", 21, 222, 93, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMSTATUSBAREDITOR_COMBOAUTOSIZE, "", 114, 219, 207, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL8, L(381,"Width") & ":", 21, 250, 93, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMSTATUSBAREDITOR_TXTWIDTH, "", 114, 247, 207, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL7, L(245,"Minimum Width") & ":", 21, 277, 93, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMSTATUSBAREDITOR_TXTMINWIDTH, "", 114, 273, 207, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL9, L(397,"BackColor") & ":", 21, 304, 93, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLOR, "", 114, 300, 207, 21, _
+ WS_CHILD or WS_VISIBLE or WS_TABSTOP Or CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED or CBS_HASSTRINGS, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmStatusBarEditor_ComboBox_SubclassProc), IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLOR, Cast(DWORD_PTR, @pWindow))
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL10, L(399,"ForeColor") & ":", 21, 331, 93, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMSTATUSBAREDITOR_COMBOFORECOLOR, "", 114, 327, 207, 21, _
+ WS_CHILD or WS_VISIBLE or WS_TABSTOP Or CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED or CBS_HASSTRINGS, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmStatusBarEditor_ComboBox_SubclassProc), IDC_FRMSTATUSBAREDITOR_COMBOFORECOLOR, Cast(DWORD_PTR, @pWindow))
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL11, L(398,"BackColorHot") & ":", 21, 358, 93, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLORHOT, "", 114, 354, 207, 21, _
+ WS_CHILD or WS_VISIBLE or WS_TABSTOP Or CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED or CBS_HASSTRINGS, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmStatusBarEditor_ComboBox_SubclassProc), IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLORHOT, Cast(DWORD_PTR, @pWindow))
+
+ pWindow->AddControl("LABEL", , IDC_FRMSTATUSBAREDITOR_LABEL11, L(400,"ForeColorHot") & ":", 21, 385, 93, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMSTATUSBAREDITOR_COMBOFORECOLORHOT, "", 114, 381, 207, 21, _
+ WS_CHILD or WS_VISIBLE or WS_TABSTOP Or CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED or CBS_HASSTRINGS, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmStatusBarEditor_ComboBox_SubclassProc), IDC_FRMSTATUSBAREDITOR_COMBOFORECOLORHOT, Cast(DWORD_PTR, @pWindow))
+
+
+ pWindow->AddControl("BUTTON", , IDC_FRMSTATUSBAREDITOR_CMDPICSELECT, "...", 350, 290, 26, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ ' Add an image control
+ DIM pImageCtx AS CImageCtx = CImageCtx(pWindow, IDC_FRMSTATUSBAREDITOR_PICIMAGE, , 384, 219, 60, 60)
+
+ pWindow->AddControl("GROUPBOX", , IDC_FRMSTATUSBAREDITOR_FRAME1, L(246,"Image"), 342, 185, 144, 128, _
+ WS_CHILD Or WS_VISIBLE Or BS_TEXT Or BS_LEFT Or BS_NOTIFY Or BS_GROUPBOX, _
+ WS_EX_TRANSPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMSTATUSBAREDITOR_CHKDISPLAYONFORM, L(237,"Display on Form"), 21, 443, 175, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMSTATUSBAREDITOR_CMDOK, L(0,"OK"), 331, 431, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(1,"Cancel"), 412, 431, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ ' Copy the form's panel items to the temporary array for editing
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ hCtrl = GetDlgItem( hForm, IDC_FRMSTATUSBAREDITOR_CHKDISPLAYONFORM )
+ Button_SetCheck( hCtrl, iif(pDoc->GenerateStatusBar, BST_CHECKED, BST_UNCHECKED))
+ dim as long numItems = ubound(pDoc->PanelItems)
+ if numItems > -1 then
+ redim gPanelItems(numItems)
+ for i as long = 0 to numItems
+ gPanelItems(i) = pDoc->PanelItems(i)
+ next
+ end if
+ end if
+
+
+ ' Load the comboboxes
+ hCtrl = GetDlgItem( hForm, IDC_FRMSTATUSBAREDITOR_COMBOALIGNMENT )
+ ComboBox_AddString( hCtrl, @wstr("StatusBarPanelAlignment.Left") )
+ ComboBox_AddString( hCtrl, @wstr("StatusBarPanelAlignment.Center") )
+ ComboBox_AddString( hCtrl, @wstr("StatusBarPanelAlignment.Right") )
+
+ ' BorderStyle is deprecated as of v2.0.4 as it has no effect
+ ' in WinFBE programs where Windows Themes are enabled.
+ 'hCtrl = GetDlgItem( hForm, IDC_FRMSTATUSBAREDITOR_COMBOBORDERSTYLE )
+ 'ComboBox_AddString( hCtrl, @wstr("StatusBarPanelBorderStyle.None") )
+ 'ComboBox_AddString( hCtrl, @wstr("StatusBarPanelBorderStyle.Sunken") )
+ 'ComboBox_AddString( hCtrl, @wstr("StatusBarPanelBorderStyle.Raised") )
+
+ hCtrl = GetDlgItem( hForm, IDC_FRMSTATUSBAREDITOR_COMBOAUTOSIZE )
+ ComboBox_AddString( hCtrl, @wstr("StatusBarPanelAutoSize.None") )
+ ComboBox_AddString( hCtrl, @wstr("StatusBarPanelAutoSize.Contents") )
+ ComboBox_AddString( hCtrl, @wstr("StatusBarPanelAutoSize.Spring") )
+
+
+ frmStatusBarEditor_DisplayListBox( nDefaultPanel )
+ frmStatusBarEditor_SetTextboxes()
+ SetFocus( GetDlgItem( HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_LSTPANELS ) )
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents( SW_SHOW )
+
+ ' Delete the frmStatusBarEditor CWindow class manually allocated memory
+ Delete pWindow
+
+ function = 0
+end function
+
diff --git a/src/frmTemplates.bi b/src/frmTemplates.bi
index e3b8f1e8..8a531ec6 100644
--- a/src/frmTemplates.bi
+++ b/src/frmTemplates.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmTemplates.bi.bak b/src/frmTemplates.bi.bak
new file mode 100644
index 00000000..e3b8f1e8
--- /dev/null
+++ b/src/frmTemplates.bi.bak
@@ -0,0 +1,19 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+#Define IDC_FRMTEMPLATES_LISTBOX 1000
+
+declare Function frmTemplates_Show (ByVal hParent As HWnd) As LRESULT
diff --git a/src/frmTemplates.inc b/src/frmTemplates.inc
index e37bba84..48587c82 100644
--- a/src/frmTemplates.inc
+++ b/src/frmTemplates.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmTemplates.inc.bak b/src/frmTemplates.inc.bak
new file mode 100644
index 00000000..e37bba84
--- /dev/null
+++ b/src/frmTemplates.inc.bak
@@ -0,0 +1,251 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmTemplates.bi"
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmTemplates
+' ========================================================================================
+private Function frmTemplates_OnCreate( ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ EnableWindow GetParent(HWnd), False
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmTemplates
+' ========================================================================================
+private Function frmTemplates_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+ Select Case id
+ Case IDOK
+ If codeNotify = BN_CLICKED Then
+ ' Let the IDC_FRMTEMPLATES_LISTBOX message to process it
+ SendMessage( HWnd, WM_COMMAND, MAKELONG(IDC_FRMTEMPLATES_LISTBOX, LBN_DBLCLK), 0 )
+ Exit Function
+ End If
+
+ Case IDCANCEL ' button clicked or ESC pressed
+ If codeNotify = BN_CLICKED Then
+ SendMessage ( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+
+ Case IDC_FRMTEMPLATES_LISTBOX
+ If codeNotify = LBN_DBLCLK Then
+ ' Get the handle of the Listbox
+ Dim hListBox As HWnd = GetDlgItem(HWnd, IDC_FRMTEMPLATES_LISTBOX)
+ ' Get the current selection
+ Dim curSel As Long = SendMessage(hListBox, LB_GETCURSEL, 0, 0)
+ If curSel = LB_ERR Then Exit Function
+ ' Get the stored index
+ Dim pwszPath As WString Ptr = Cast(WString Ptr, SendMessage(hListBox, LB_GETITEMDATA, Cast(WPARAM, curSel), 0))
+ If pwszPath = 0 Then Exit Function
+ ' Open the template
+ If pwszPath Then
+ dim pDoc as clsDocument ptr
+ pDoc = frmMain_OpenFileSafely( _
+ HWND_FRMMAIN, _
+ False, _ ' bIsNewFile
+ true, _ ' bIsTemplate
+ True, _ ' bShowInTab
+ false, _ ' bIsInclude
+ *pwszPath, _ ' wszName
+ 0 ) ' pDocIn
+
+ ' Ensure that the code window scrolls to the correct location
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ Dim As Long curPos = SciExec( hEdit, SCI_GETCURRENTPOS, 0, 0)
+ SciExec( hEdit, SCI_GOTOPOS, curPos, 0 )
+
+ End If
+ ' Close the dialog
+ SendMessage HWnd, WM_CLOSE, 0, 0
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmTemplates
+' ========================================================================================
+private Function frmTemplates_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableWindow GetParent(HWnd), True
+ DestroyWindow HWnd
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmTemplates
+' ========================================================================================
+private Function frmTemplates_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Templates window procedure
+' ========================================================================================
+private Function frmTemplates_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmTemplates_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmTemplates_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmTemplates_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmTemplates_OnCommand)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' Templates popup dialog
+' ========================================================================================
+public Function frmTemplates_Show( ByVal hParent As HWnd ) As LRESULT
+
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hParent)->DPI
+
+ pWindow->Create( hParent, L(176,"Templates"), @frmTemplates_WndProc, _
+ 0, 0, 0, 0, WS_CAPTION Or WS_POPUPWINDOW, WS_EX_WINDOWEDGE )
+ pWindow->SetClientSize(420,395)
+ pWindow->Center(pWindow->hWindow, hParent)
+
+ ' Set the small and large icon for the main window (must be set after main window is created)
+ pWindow->BigIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 32, 32, LR_SHARED)
+ pWindow->SmallIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 16, 16, LR_SHARED)
+
+ ' Add a listbox
+ Dim hListBox As HWnd = pWindow->AddControl("ListBox", , IDC_FRMTEMPLATES_LISTBOX, "", _
+ WS_CHILD Or WS_VISIBLE Or WS_HSCROLL Or WS_VSCROLL Or WS_BORDER Or WS_TABSTOP Or _
+ LBS_STANDARD Or LBS_HASSTRINGS Or LBS_SORT Or LBS_NOTIFY Or LBS_NOINTEGRALHEIGHT, WS_EX_CLIENTEDGE)
+
+ pWindow->SetWindowPos( hListBox, Null, 8, 8, 400, 337, SWP_NOZORDER )
+ SendMessage( hListBox, LB_SETHORIZONTALEXTENT, Cast(WPARAM, 600 * pWindow->rxRatio), 0 )
+
+ ' Add the buttons
+ pWindow->AddControl("Button", , IDOK, L(0,"&OK"), 245, 353, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_FLAT Or BS_DEFPUSHBUTTON, WS_EX_NOPARENTNOTIFY)
+ pWindow->AddControl("Button", , IDCANCEL, L(1,"&Cancel"), 333, 353, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_FLAT, WS_EX_NOPARENTNOTIFY)
+
+ ' Search templates
+ DIM hSearch as HANDLE
+ dim WFD AS WIN32_FIND_DATAW
+ dim as long FileNo, nType, nCount, nItem, idx, nLin
+
+ DIM wszPath AS WSTRING * MAX_PATH
+ dim wszCurPath AS WSTRING * MAX_PATH
+ dim wszText AS WSTRING * MAX_PATH
+ DIM wszFullPath AS WSTRING * MAX_PATH * 2
+
+ wszPath = AfxGetExePathName + "Templates\"
+ wszCurPath = wszPath + "*.fbtpl"
+
+ ' Count the number of files and dimension the array
+ ' REDIM PRESERVE causes problems
+ hSearch = FindFirstFile(wszCurPath, @WFD)
+ IF hSearch <> INVALID_HANDLE_VALUE THEN
+ DO
+ IF (WFD.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY THEN
+ nCount = nCount + 1
+ END IF
+ LOOP WHILE FindNextFile(hSearch, @WFD)
+ FindClose(hSearch)
+ END IF
+
+ ' Dimension the array
+ IF nCount = 0 THEN EXIT FUNCTION
+ DIM rgwszPaths(nCount - 1) AS WSTRING * MAX_PATH
+ idx = 0
+
+ ' Find the files
+ dim pStream as CTextStream
+ hSearch = FindFirstFile(wszCurPath, @WFD)
+ IF hSearch <> INVALID_HANDLE_VALUE THEN
+ DO
+ IF (WFD.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY THEN
+ wszFullPath = wszPath & WFD.cFileName
+ ' The start of a template file contains 4 lines of meta data
+ ' For example:
+ ' 2
+ ' FBGUI
+ ' .bas
+ ' CWindow: COM: Explorer Browser in a tab page
+
+ ' Get the description
+ if pStream.Open(wszFullPath) = S_OK then
+ nLin = 0
+ DO UNTIL pStream.EOS
+ wszText = pStream.ReadLine
+ nLin = nLin + 1
+ IF nLin = 1 THEN nType = VAL(wszText)
+ IF nType < 1 OR nType > 2 THEN EXIT DO
+ IF nType = 1 AND nLin = 3 THEN EXIT DO
+ IF nType = 2 AND nLin = 4 THEN EXIT DO
+ LOOP
+ pStream.Close
+
+ if len(wszText) then
+ ' Display the description in the listbox
+ nItem = SendMessage(hListBox, LB_ADDSTRING, 0, cast(LPARAM, @wszText))
+ ' Store the full path in the array
+ rgwszPaths(idx) = wszFullPath
+ ' Store a pointer to the element of the array in the listbox item
+ SendMessage(hListBox, LB_SETITEMDATA, nItem, cast(LPARAM, @rgwszPaths(idx) ))
+ idx = idx + 1
+ IF idx > UBOUND(rgwszPaths) THEN EXIT DO
+ end if
+
+ END IF
+ END IF
+ LOOP WHILE FindNextFile(hSearch, @WFD)
+ FindClose(hSearch)
+ END IF
+
+ ShowWindow( pWindow->hWindow, SW_SHOW )
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents
+
+ ' Delete the frmTemplates CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
+
+
diff --git a/src/frmToolBarEditor.bi b/src/frmToolBarEditor.bi
index 04e287fb..e84100ad 100644
--- a/src/frmToolBarEditor.bi
+++ b/src/frmToolBarEditor.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmToolBarEditor.bi.bak b/src/frmToolBarEditor.bi.bak
new file mode 100644
index 00000000..04e287fb
--- /dev/null
+++ b/src/frmToolBarEditor.bi.bak
@@ -0,0 +1,42 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#DEFINE IDC_FRMTOOLBAREDITOR_CMDOK 1000
+#DEFINE IDC_FRMTOOLBAREDITOR_CMDCANCEL 1001
+#DEFINE IDC_FRMTOOLBAREDITOR_LSTBUTTONS 1002
+#DEFINE IDC_FRMTOOLBAREDITOR_CMDBUTTONUP 1003
+#DEFINE IDC_FRMTOOLBAREDITOR_CMDBUTTONDOWN 1004
+#Define IDC_FRMTOOLBAREDITOR_CMDBUTTONADD 1005
+#DEFINE IDC_FRMTOOLBAREDITOR_CMDBUTTONINSERT 1006
+#DEFINE IDC_FRMTOOLBAREDITOR_CMDBUTTONDELETE 1007
+#DEFINE IDC_FRMTOOLBAREDITOR_COMBOSIZE 1008
+#DEFINE IDC_FRMTOOLBAREDITOR_COMBOBUTTONTYPE 1009
+#DEFINE IDC_FRMTOOLBAREDITOR_TXTTOOLTIP 1010
+#DEFINE IDC_FRMTOOLBAREDITOR_TXTNORMALIMAGE 1011
+#DEFINE IDC_FRMTOOLBAREDITOR_TXTHOTIMAGE 1012
+#DEFINE IDC_FRMTOOLBAREDITOR_TXTDISABLEDIMAGE 1013
+#DEFINE IDC_FRMTOOLBAREDITOR_CMDNORMALIMAGE 1014
+#DEFINE IDC_FRMTOOLBAREDITOR_CMDHOTIMAGE 1015
+#DEFINE IDC_FRMTOOLBAREDITOR_CMDDISABLEDIMAGE 1016
+#DEFINE IDC_FRMTOOLBAREDITOR_LABEL1 1017
+#DEFINE IDC_FRMTOOLBAREDITOR_LABEL2 1018
+#DEFINE IDC_FRMTOOLBAREDITOR_LABEL3 1019
+#DEFINE IDC_FRMTOOLBAREDITOR_LABEL4 1020
+#DEFINE IDC_FRMTOOLBAREDITOR_LABEL5 1021
+#DEFINE IDC_FRMTOOLBAREDITOR_LABEL6 1022
+#Define IDC_FRMTOOLBAREDITOR_CHKDISPLAYONFORM 1023
+
+declare Function frmToolBarEditor_CreateFakeToolBar( ByVal pDoc as clsDocument ptr ) As Long
+declare Function frmToolBarEditor_Show( ByVal hWndParent As HWnd ) as LRESULT
diff --git a/src/frmToolBarEditor.inc b/src/frmToolBarEditor.inc
index 798d263a..e10163e5 100644
--- a/src/frmToolBarEditor.inc
+++ b/src/frmToolBarEditor.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmToolBarEditor.inc.bak b/src/frmToolBarEditor.inc.bak
new file mode 100644
index 00000000..798d263a
--- /dev/null
+++ b/src/frmToolBarEditor.inc.bak
@@ -0,0 +1,740 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmToolBarEditor.bi"
+#include once "clsToolBarItem.bi"
+#include once "clsDocument.bi"
+
+
+' Temporary ToolBarItem array to hold items while they are being
+' edited in the Menu Editor.
+dim shared gToolBarItems(any) as clsToolBarItem
+
+
+' ========================================================================================
+' Processes messages for the subclassed Rebar/ToolBar.
+' ========================================================================================
+public FUNCTION FakeToolBar_SubclassProc( BYVAL hwnd AS HWND, _ ' Control window handle
+ BYVAL uMsg AS UINT, _ ' Type of message
+ BYVAL wParam AS WPARAM, _ ' First message parameter
+ BYVAL lParam AS LPARAM, _ ' Second message parameter
+ BYVAL uIdSubclass AS UINT_PTR, _ ' The subclass ID
+ BYVAL dwRefData AS DWORD_PTR _ ' Pointer to reference data
+ ) AS LRESULT
+
+ dim pDoc as clsDocument ptr = cast(clsDocument ptr, dwRefData)
+
+ SELECT CASE uMsg
+
+ CASE WM_GETDLGCODE
+ ' All keyboard input
+ FUNCTION = DLGC_WANTALLKEYS
+ EXIT FUNCTION
+
+ case WM_LBUTTONUP
+ PostMessage( HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_TOOLBAREDITOR, 0), 0 )
+
+ Case WM_MOUSEACTIVATE
+ ' Defeat this message so that mouse clicks do not activate the control.
+ Function = MA_NOACTIVATE: uMsg = WM_NULL
+ Exit Function
+
+ Case WM_SETCURSOR
+ Function = CTRUE: uMsg = WM_NULL
+ Exit Function
+
+ Case WM_SETFOCUS
+ ' Defeat the caret activation, for some
+ ' reason MA_NOACTIVATE does not work for right clicks.
+ Function = 0: uMsg = WM_NULL
+ Exit Function
+
+ CASE WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hwnd, @FakeToolBar_SubclassProc, uIdSubclass )
+
+ END SELECT
+
+ ' Default processing of Windows messages
+ FUNCTION = DefSubclassProc(hwnd, uMsg, wParam, lParam)
+
+END FUNCTION
+
+
+' ========================================================================================
+' Create the "fake" toolbar to display on the Form
+' ========================================================================================
+public Function frmToolBarEditor_CreateFakeToolBar( ByVal pDoc as clsDocument ptr ) As Long
+
+ if pDoc = 0 then exit function
+
+ ' If Rebar and ToolBar already exist then recreate them
+ if (pDoc->hWndRebar) andalso (pDoc->hWndToolBar) then
+ DestroyWindow pDoc->hWndRebar: pDoc->hWndRebar = 0
+ DestroyWindow pDoc->hWndToolBar: pDoc->hWndToolBar = 0
+ end if
+ if pDoc->ToolBarExists = false then exit function
+
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr( pDoc->hWndForm )
+ if pWindow = 0 then exit function
+
+ dim rc as RECT
+ GetClientRect( pDoc->hWndForm, @rc )
+
+ ' Create the Rebar and ToolBar
+ Dim As HWnd hRebar = _
+ pWindow->AddControl("Rebar", pDoc->hWndForm, IDC_FAKEREBAR, "", 0, 0, 0, 0, _
+ WS_CHILD or WS_VISIBLE OR WS_BORDER OR WS_CLIPCHILDREN OR _
+ WS_CLIPSIBLINGS OR CCS_NODIVIDER OR RBS_VARHEIGHT OR RBS_BANDBORDERS Or CCS_NOPARENTALIGN)
+
+ Dim As HWnd hToolBar = _
+ pWindow->AddControl("Toolbar", pDoc->hWndForm, IDC_FAKETOOLBAR, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_VISIBLE Or TBSTYLE_TOOLTIPS Or TBSTYLE_FLAT Or CCS_NODIVIDER Or CCS_NOPARENTALIGN)
+
+ pDoc->hWndRebar = hRebar
+ pDoc->hWndToolBar = hToolBar
+
+ ' Allow drop down arrows
+ SendMessage( hToolBar, TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS )
+
+ ' Determine the Image size
+ dim as long nImageSize = 24
+ select case **pDoc->wszToolBarSize
+ case "SIZE_16": nImageSize = 16
+ case "SIZE_24": nImageSize = 24
+ case "SIZE_32": nImageSize = 32
+ case "SIZE_48": nImageSize = 48
+ end select
+
+ ' We only need to create a Normal ImageList for purposes of displaying in the Designer.
+ Dim As HIMAGELIST hImageListNormal
+ Dim cx As Long = nImageSize * pWindow->DPI \ 96
+ hImageListNormal = ImageList_Create( cx, cx, ILC_COLOR32 Or ILC_MASK, 20, 1)
+ dim wszImageName as wstring * 1024
+
+ ' Add buttons to the toolbar
+ Dim As Long i, ii
+
+ dim as long lb = 0
+ dim as long ub = ubound(pDoc->ToolBarItems)
+
+ for i as long = lb to ub
+
+ ii = -1
+ wszImageName = pDoc->ToolBarItems(i).pPropNormalImage.wszPropValue
+ if len(wszImageName) then
+ dim pImageType as IMAGES_TYPE ptr = GetImagesTypePtr(wszImageName)
+ if pImageType then
+ ii = AfxGdipAddIconFromFile(hImageListNormal, pImageType->wszFileName)
+ end if
+ end if
+
+ select case **pDoc->ToolBarItems(i).wszButtonType
+ case "ToolBarButton.Button"
+ Toolbar_AddButton hToolBar, ii, 0
+
+ case "ToolBarButton.Separator"
+ Toolbar_AddSeparator hToolBar
+
+ case "ToolBarButton.DropDown"
+ Toolbar_AddButton hToolBar, ii, 0, 0, TBSTYLE_DROPDOWN
+
+ case "ToolBarButton.WholeDropDown"
+ Toolbar_AddButton hToolBar, ii, 0, 0, BTNS_WHOLEDROPDOWN
+ end select
+
+ next
+
+ ' Attach the ImageList to the toolbar
+ SendMessage hToolBar, TB_SETIMAGELIST, 0, Cast(LPARAM, hImageListNormal)
+
+ ' Size the toolbar
+ SendMessage hToolBar, TB_AUTOSIZE, 0, 0
+
+ ' Add the band containing the toolbar control to the rebar
+ ' The size of the REBARBANDINFOW is different in Vista/Windows 7
+ Dim rbbi As REBARBANDINFOW
+ If (AfxWindowsVersion >= 600) AndAlso (AfxComCtlVersion >= 600) Then
+ rbbi.cbSize = REBARBANDINFO_V6_SIZE
+ Else
+ rbbi.cbSize = REBARBANDINFO_V3_SIZE
+ End If
+
+ ' Insert the toolbar in the rebar control
+ rbbi.fMask = RBBIM_STYLE Or RBBIM_CHILD Or RBBIM_CHILDSIZE Or _
+ RBBIM_SIZE Or RBBIM_ID Or RBBIM_IDEALSIZE Or RBBIM_COLORS
+ rbbi.fStyle = RBBS_CHILDEDGE Or RBBS_GRIPPERALWAYS
+ rbbi.hwndChild = hToolbar
+ rbbi.cxMinChild = 270 * pWindow->rxRatio
+ rbbi.cyMinChild = Hiword(SendMessageW(hToolBar, TB_GETBUTTONSIZE, 0, 0))
+ rbbi.cx = 270 * pWindow->rxRatio
+ rbbi.cxIdeal = 270 * pWindow->rxRatio
+ rbbi.clrFore = GetSysColor(COLOR_BTNTEXT)
+ rbbi.clrBack = GetSysColor(COLOR_BTNFACE)
+
+ ' Insert band into rebar
+ SendMessage hRebar, RB_INSERTBANDW, -1, Cast(LPARAM, @rbbi)
+
+ SetWindowSubclass( hRebar, CAST(SUBCLASSPROC, @FakeToolBar_SubclassProc), 0, CAST(DWORD_PTR, pDoc))
+ SetWindowSubclass( hToolBar, CAST(SUBCLASSPROC, @FakeToolBar_SubclassProc), 0, CAST(DWORD_PTR, pDoc))
+
+ ShowWindow( hToolBar, SW_SHOW )
+ ShowWindow( hRebar, SW_SHOW )
+
+ ' Position the Rebar below any existing fake topmenu.
+ dim as long nTopMenu_Height, nToolBar_Height
+ nToolBar_Height = AfxGetWindowHeight( hRebar )
+ if pDoc->hWndFakeMenu then
+ nTopMenu_Height = AfxGetWindowHeight( pDoc->hWndFakeMenu )
+ end if
+ SetWindowPos hRebar, 0, 0, nTopMenu_Height, rc.right, nToolBar_Height, SWP_NOZORDER
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Display the details of this ToolBarItem
+' ========================================================================================
+private Function frmToolBarEditor_DisplayToolBarItem() As Long
+
+ dim as long nCurSel, nIndex
+ dim as Boolean bEnabled = true
+
+ nCurSel = Listbox_GetCurSel( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_LSTBUTTONS) )
+ If nCurSel = -1 Then Exit Function
+
+ ' Button type
+ nIndex = ComboBox_FindStringExact( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_COMBOBUTTONTYPE), -1, gToolBarItems(nCurSel).wszButtonType.sptr)
+ ComboBox_SetCurSel( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_COMBOBUTTONTYPE), nIndex)
+ ' If this is a Separator button then disable the Images and Tooltip
+ If nIndex = 1 Then bEnabled = false ' Separator index is 1
+
+ AfxSetWindowText( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_TXTTOOLTIP), gToolBarItems(nCurSel).wszToolTip)
+ AfxSetWindowText( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_TXTNORMALIMAGE), gToolBarItems(nCurSel).pPropNormalImage.wszPropValue)
+ AfxSetWindowText( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_TXTHOTIMAGE), gToolBarItems(nCurSel).pPropHotImage.wszPropValue)
+ AfxSetWindowText( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_TXTDISABLEDIMAGE), gToolBarItems(nCurSel).pPropDisabledImage.wszPropValue)
+
+ EnableWindow( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_TXTTOOLTIP), bEnabled )
+ EnableWindow( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_TXTNORMALIMAGE), bEnabled )
+ EnableWindow( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_TXTHOTIMAGE), bEnabled )
+ EnableWindow( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_TXTDISABLEDIMAGE), bEnabled )
+
+ EnableWindow( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_CMDNORMALIMAGE), bEnabled )
+ EnableWindow( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_CMDHOTIMAGE), bEnabled )
+ EnableWindow( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_CMDDISABLEDIMAGE), bEnabled )
+
+ SetFocus( GetDlgItem(HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_COMBOBUTTONTYPE) )
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Display the entries in the ToolBarEditor Listbox
+' ========================================================================================
+private Function frmToolBarEditor_DisplayListBox( ByVal nIndex As Long ) As Long
+
+ ' Display the button items in the listbox
+ dim hList as hwnd = GetDlgItem( HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_LSTBUTTONS )
+
+ ListBox_ResetContent( hList )
+ for i as long = 0 to ubound(gToolBarItems)
+ gToolBarItems(i).wszName = "ToolBar Button " & i
+ ListBox_AddString( hList, gToolBarItems(i).wszName.sptr )
+ next
+ ListBox_SetCurSel( hList, nIndex )
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Swap two entries in the ToolBarEditor Listbox
+' ========================================================================================
+private function frmToolBarEditor_SwapListBoxItems( byval Item1 as long, _
+ Byval Item2 as long _
+ ) as Long
+ ' Do not swap the Button Name
+ dim as CWSTR wszButtonName1 = gToolBarItems(Item1).wszName
+ dim as CWSTR wszButtonName2 = gToolBarItems(Item2).wszName
+
+ ' Swap the array values
+ swap gToolBarItems(Item1), gToolBarItems(Item2)
+
+ gToolBarItems(Item1).wszName = wszButtonName1
+ gToolBarItems(Item2).wszName = wszButtonName2
+
+ frmToolBarEditor_DisplayListBox( Item2 )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmToolBarEditor
+' ========================================================================================
+private Function frmToolBarEditor_OnCreate( ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmToolBarEditor
+' ========================================================================================
+private Function frmToolBarEditor_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim as HWND hListBox = GetDlgItem( HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_LSTBUTTONS)
+ dim as long nCurSel = ListBox_GetCurSel(hListBox)
+
+ Select Case id
+
+ case IDC_FRMTOOLBAREDITOR_LSTBUTTONS
+ If codeNotify = LBN_SELCHANGE Then
+ frmToolBarEditor_DisplayToolBarItem
+ end if
+
+
+ Case IDC_FRMTOOLBAREDITOR_CHKDISPLAYONFORM
+ If codeNotify = BN_CLICKED Then
+ ' Don't need to store the value. We will check it when the
+ ' ToolBar Editor is closed.
+ End If
+
+
+ case IDC_FRMTOOLBAREDITOR_COMBOSIZE
+ if codeNotify = CBN_SELCHANGE THEN
+ ' Don't need to store the value. We will check it when the
+ ' ToolBar Editor is closed.
+ END IF
+
+
+ case IDC_FRMTOOLBAREDITOR_COMBOBUTTONTYPE
+ if codeNotify = CBN_SELCHANGE THEN
+ if nCurSel > -1 THEN
+ gToolBarItems(nCurSel).wszButtonType = AfxGetWindowText(hwndCtl)
+ frmToolBarEditor_DisplayToolBarItem
+ end if
+ END IF
+
+
+ CASE IDC_FRMTOOLBAREDITOR_TXTTOOLTIP
+ if codeNotify = EN_CHANGE THEN
+ if nCurSel > -1 THEN gToolBarItems(nCurSel).wszTooltip = AfxGetWindowText(hwndCtl)
+ end if
+
+
+ case IDC_FRMTOOLBAREDITOR_CMDBUTTONUP
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > 0 THEN
+ frmToolBarEditor_SwapListboxItems(nCurSel, nCurSel - 1)
+ END IF
+ end if
+
+
+ case IDC_FRMTOOLBAREDITOR_CMDBUTTONDOWN
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel < ListBox_GetCount(hListBox)-1 THEN
+ frmToolBarEditor_SwapListboxItems(nCurSel, nCurSel + 1)
+ END IF
+ end if
+
+
+ case IDC_FRMTOOLBAREDITOR_CMDBUTTONADD
+ if codeNotify = BN_CLICKED THEN
+ if ubound(gToolBarItems) = -1 THEN
+ redim gToolBarItems(0)
+ nCurSel = 0
+ Else
+ Redim Preserve gToolBarItems(Ubound(gToolBarItems)+1)
+ nCurSel = Ubound(gToolBarItems)
+ END IF
+ dim newToolBarItem as clsToolBarItem
+ gToolBarItems(nCurSel) = newToolBarItem
+ frmToolBarEditor_DisplayListBox( nCurSel )
+ frmToolBarEditor_DisplayToolBarItem
+ end if
+
+
+ case IDC_FRMTOOLBAREDITOR_CMDBUTTONINSERT
+ if codeNotify = BN_CLICKED THEN
+ if ubound(gToolBarItems) = -1 THEN
+ redim gToolBarItems(0)
+ nCurSel = 0
+ Else
+ Redim Preserve gToolBarItems(Ubound(gToolBarItems)+1)
+ if nCurSel = -1 THEN nCurSel = 0
+ for i as long = ubound(gToolBarItems) to nCurSel + 1 step -1
+ gToolBarItems(i) = gToolBarItems(i-1)
+ NEXT
+ END IF
+ dim newToolBarItem as clsToolBarItem
+ gToolBarItems(nCurSel) = newToolBarItem
+ frmToolBarEditor_DisplayListBox( nCurSel )
+ frmToolBarEditor_DisplayToolBarItem
+ end if
+
+
+ case IDC_FRMTOOLBAREDITOR_CMDBUTTONDELETE
+ If codeNotify = BN_CLICKED Then
+ if nCurSel > -1 THEN
+ if ubound(gToolBarItems) = 0 THEN
+ erase gToolBarItems
+ nCurSel = -1
+ else
+ ' remove the item from the internal array
+ for i as long = nCurSel to ubound(gToolBarItems) - 1
+ gToolBarItems(i) = gToolBarItems(i+1)
+ NEXT
+ redim preserve gToolBarItems(ubound(gToolBarItems)-1)
+ END IF
+ nCurSel = Min(nCurSel, ubound(gToolBarItems))
+ frmToolBarEditor_DisplayListBox( nCurSel )
+ frmToolBarEditor_DisplayToolBarItem
+ end if
+ end if
+
+
+ case IDC_FRMTOOLBAREDITOR_CMDNORMALIMAGE
+ If codeNotify = BN_CLICKED Then
+ if nCurSel > -1 then
+ frmImageManager_Show( HWND, @gToolBarItems(nCurSel).pPropNormalImage )
+ if gToolBarItems(nCurSel).pPropHotImage.wszPropValue = "" then
+ gToolBarItems(nCurSel).pPropHotImage.wszPropValue = _
+ gToolBarItems(nCurSel).pPropNormalImage.wszPropValue
+ end if
+ if gToolBarItems(nCurSel).pPropDisabledImage.wszPropValue = "" then
+ gToolBarItems(nCurSel).pPropDisabledImage.wszPropValue = _
+ gToolBarItems(nCurSel).pPropNormalImage.wszPropValue
+ end if
+ frmToolBarEditor_DisplayToolBarItem
+ end if
+ end if
+
+
+ case IDC_FRMTOOLBAREDITOR_CMDHOTIMAGE
+ If codeNotify = BN_CLICKED Then
+ if nCurSel > -1 then
+ frmImageManager_Show( HWND, @gToolBarItems(nCurSel).pPropHotImage )
+ if gToolBarItems(nCurSel).pPropNormalImage.wszPropValue = "" then
+ gToolBarItems(nCurSel).pPropNormalImage.wszPropValue = _
+ gToolBarItems(nCurSel).pPropHotImage.wszPropValue
+ end if
+ if gToolBarItems(nCurSel).pPropDisabledImage.wszPropValue = "" then
+ gToolBarItems(nCurSel).pPropDisabledImage.wszPropValue = _
+ gToolBarItems(nCurSel).pPropHotImage.wszPropValue
+ end if
+ frmToolBarEditor_DisplayToolBarItem
+ end if
+ end if
+
+
+ case IDC_FRMTOOLBAREDITOR_CMDDISABLEDIMAGE
+ If codeNotify = BN_CLICKED Then
+ if nCurSel > -1 then
+ frmImageManager_Show( HWND, @gToolBarItems(nCurSel).pPropDisabledImage )
+ if gToolBarItems(nCurSel).pPropNormalImage.wszPropValue = "" then
+ gToolBarItems(nCurSel).pPropNormalImage.wszPropValue = _
+ gToolBarItems(nCurSel).pPropDisabledImage.wszPropValue
+ end if
+ if gToolBarItems(nCurSel).pPropHotImage.wszPropValue = "" then
+ gToolBarItems(nCurSel).pPropHotImage.wszPropValue = _
+ gToolBarItems(nCurSel).pPropDisabledImage.wszPropValue
+ end if
+ frmToolBarEditor_DisplayToolBarItem
+ end if
+ end if
+
+
+ Case IDC_FRMTOOLBAREDITOR_CMDOK
+ If codeNotify = BN_CLICKED Then
+ ' Copy the temporary array back to the form's button items
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ dim as long numItems = ubound(gToolBarItems)
+ if numItems > -1 then
+ redim pDoc->ToolBarItems(numItems)
+ for i as long = lbound(gToolBarItems) to ubound(gToolBarItems)
+ pDoc->ToolBarItems(i) = gToolBarItems(i)
+ next
+ else
+ erase pDoc->ToolBarItems
+ end if
+ ' Save the value indicating that we want the toolbar to display in
+ ' the generated code for the form.
+ pDoc->GenerateToolBar = _
+ iif(Button_GetCheck(GetDlgItem(HWND, IDC_FRMTOOLBAREDITOR_CHKDISPLAYONFORM)) = BST_CHECKED, true, false)
+
+ dim as long nIndex = ComboBox_GetCurSel( GetDlgItem(HWND, IDC_FRMTOOLBAREDITOR_COMBOSIZE) )
+ pDoc->wszToolBarSize = AfxGetComboBoxText( GetDlgItem(HWND, IDC_FRMTOOLBAREDITOR_COMBOSIZE), nIndex )
+ pDoc->UserModified = true
+ end if
+ SendMessage(HWnd, WM_CLOSE, 0, 0)
+ Exit Function
+ end if
+
+
+ Case IDC_FRMTOOLBAREDITOR_CMDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage(HWnd, WM_CLOSE, 0, 0)
+ Exit Function
+ End If
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmToolBarEditor
+' ========================================================================================
+private Function frmToolBarEditor_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Reset the global ToolBarItems array
+ erase gToolBarItems
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow( HWnd )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmToolBarEditor
+' ========================================================================================
+private Function frmToolBarEditor_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmToolBarEditor Window procedure
+' ========================================================================================
+private Function frmToolBarEditor_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmToolBarEditor_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmToolBarEditor_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmToolBarEditor_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmToolBarEditor_OnCommand)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmToolBarEditor_Show
+' ========================================================================================
+public Function frmToolBarEditor_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ DIM hBitmap AS HBITMAP
+ dim hCtrl as HWnd
+ dim wszImage as wstring * 100
+
+
+ ' Create the main window and child controls
+ Dim pWindow as CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ Dim As HWnd hForm = _
+ pWindow->Create( hWndParent, L(313,"ToolBar Editor"), _
+ @frmToolBarEditor_WndProc, 0, 0, 508, 380, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->SetClientSize(508, 380)
+ pWindow->Center
+
+ HWND_FRMTOOLBAREDITOR = hForm
+
+ pWindow->AddControl("LISTBOX", , IDC_FRMTOOLBAREDITOR_LSTBUTTONS, "", 21, 14, 465, 84, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or LBS_NOINTEGRALHEIGHT, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMTOOLBAREDITOR_CMDBUTTONUP, "", 21, 102, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWUP", "IMAGE_ARROWUP16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMTOOLBAREDITOR_CMDBUTTONDOWN, "", 48, 102, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWDOWN", "IMAGE_ARROWDOWN16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMTOOLBAREDITOR_CMDBUTTONADD, L(380, "Add"), 77, 102, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_FLAT Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMTOOLBAREDITOR_CMDBUTTONINSERT, L(281, "Insert"), 152, 102, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_FLAT Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMTOOLBAREDITOR_CMDBUTTONDELETE, L(282, "Delete"), 227, 102, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_FLAT Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("LABEL", , IDC_FRMTOOLBAREDITOR_LABEL1, L(378,"Images") & ":", 305, 107, 100, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMTOOLBAREDITOR_COMBOSIZE, "", 411, 102, 75, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+
+ pWindow->AddControl("LABEL", , IDC_FRMTOOLBAREDITOR_LABEL2, L(383,"Button Type") & ":", 21, 145, 93, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMTOOLBAREDITOR_COMBOBUTTONTYPE, "", 134, 142, 352, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMTOOLBAREDITOR_LABEL3, L(235,"Tooltip Text") & ":", 21, 181, 93, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMTOOLBAREDITOR_TXTTOOLTIP, "", 134, 177, 352, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+
+ pWindow->AddControl("LABEL", , IDC_FRMTOOLBAREDITOR_LABEL4, L(384,"Normal Image") & ":", 21, 209, 93, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMTOOLBAREDITOR_TXTNORMALIMAGE, "", 134, 205, 320, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMTOOLBAREDITOR_CMDNORMALIMAGE, "", 462, 204, 22, 22, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWDOWN", "IMAGE_ARROWDOWN16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+
+ pWindow->AddControl("LABEL", , IDC_FRMTOOLBAREDITOR_LABEL5, L(385,"Hot Image") & ":", 21, 237, 93, 21, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMTOOLBAREDITOR_TXTHOTIMAGE, "", 134, 233, 320, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMTOOLBAREDITOR_CMDHOTIMAGE, "", 462, 232, 22, 22, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWDOWN", "IMAGE_ARROWDOWN16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+
+ pWindow->AddControl("LABEL", , IDC_FRMTOOLBAREDITOR_LABEL6, L(386,"Disabled Image") & ":", 21, 265, 93, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMTOOLBAREDITOR_TXTDISABLEDIMAGE, "", 134, 261, 320, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMTOOLBAREDITOR_CMDDISABLEDIMAGE, "", 462, 260, 22, 22, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWDOWN", "IMAGE_ARROWDOWN16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+
+ pWindow->AddControl("CHECKBOX", , IDC_FRMTOOLBAREDITOR_CHKDISPLAYONFORM, L(237,"Display on Form"), 21, 345, 175, 16, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMTOOLBAREDITOR_CMDOK, L(0,"OK"), 331, 333, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMTOOLBAREDITOR_CMDCANCEL, L(1,"Cancel"), 412, 333, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ ' Copy the form's toolbar items to the temporary array for editing
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ hCtrl = GetDlgItem( hForm, IDC_FRMTOOLBAREDITOR_CHKDISPLAYONFORM )
+ Button_SetCheck( hCtrl, iif(pDoc->GenerateToolBar, BST_CHECKED, BST_UNCHECKED))
+ dim as long numItems = ubound(pDoc->ToolBarItems)
+ if numItems > -1 then
+ redim gToolBarItems(numItems)
+ for i as long = 0 to numItems
+ gToolBarItems(i) = pDoc->ToolBarItems(i)
+ next
+ end if
+ end if
+
+
+ ' Load the comboboxes
+ hCtrl = GetDlgItem( hForm, IDC_FRMTOOLBAREDITOR_COMBOSIZE )
+ ComboBox_AddString( hCtrl, @wstr("SIZE_16") )
+ ComboBox_AddString( hCtrl, @wstr("SIZE_24") )
+ ComboBox_AddString( hCtrl, @wstr("SIZE_32") )
+ ComboBox_AddString( hCtrl, @wstr("SIZE_48") )
+ dim as long nIndex = ComboBox_FindStringExact( hCtrl, -1, pDoc->wszToolBarSize.sptr )
+ ComboBox_SetCurSel( hCtrl, nIndex)
+
+ hCtrl = GetDlgItem( hForm, IDC_FRMTOOLBAREDITOR_COMBOBUTTONTYPE )
+ ComboBox_AddString( hCtrl, @wstr("ToolBarButton.Button") )
+ ComboBox_AddString( hCtrl, @wstr("ToolBarButton.Separator") )
+ ComboBox_AddString( hCtrl, @wstr("ToolBarButton.DropDown") )
+ ComboBox_AddString( hCtrl, @wstr("ToolBarButton.WholeDropDown") )
+
+ frmToolBarEditor_DisplayListBox( 0 )
+ frmToolBarEditor_DisplayToolBarItem
+ SetFocus( GetDlgItem( HWND_FRMTOOLBAREDITOR, IDC_FRMTOOLBAREDITOR_LSTBUTTONS ) )
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents( SW_SHOW )
+
+ ' Delete the frmToolBarEditor CWindow class manually allocated memory
+ Delete pWindow
+
+End Function
+
+
+
+
+
diff --git a/src/frmTopTabs.bi b/src/frmTopTabs.bi
index 598795dd..cbebe1fb 100644
--- a/src/frmTopTabs.bi
+++ b/src/frmTopTabs.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmTopTabs.bi.bak b/src/frmTopTabs.bi.bak
new file mode 100644
index 00000000..598795dd
--- /dev/null
+++ b/src/frmTopTabs.bi.bak
@@ -0,0 +1,17 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+declare function frmTopTabs_PositionWindows() as LRESULT
+
+
+
diff --git a/src/frmTopTabs.inc b/src/frmTopTabs.inc
index 3e066b74..4ec5e6c9 100644
--- a/src/frmTopTabs.inc
+++ b/src/frmTopTabs.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmTopTabs.inc.bak b/src/frmTopTabs.inc.bak
new file mode 100644
index 00000000..3e066b74
--- /dev/null
+++ b/src/frmTopTabs.inc.bak
@@ -0,0 +1,786 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+' ========================================================================================
+' Show or hide the drop down shadow that will display below the top tabs control. The
+' width of the shadow is also influenced by whether the Find/Replace dialog is active.
+' ========================================================================================
+function frmTopTabs_ShowShadow() as long
+
+ if IsWindowVisible( HWND_FRMMAIN_TOPTABS ) = 0 then exit function
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+
+ if pDoc then
+ dim as RECT rcFindReplace = AfxGetWindowRect( HWND_FRMFINDREPLACE )
+ dim as RECT rcTopTabs = AfxGetWindowRect( HWND_FRMMAIN_TOPTABS )
+ dim as long nLeftWidth = rcTopTabs.right - rcTopTabs.left
+
+ dim as long nLine = SciExec( pDoc->hWindow(0), SCI_GETFIRSTVISIBLELINE, 0, 0)
+ dim as long nShow = iif( nLine > 0, SW_SHOWNA, SW_HIDE )
+
+ ' if the Find/Replace popup window is active then we always show the show
+ ' the shadow window is a popup style so need to use screen coordinates
+ if IsWindowVisible( HWND_FRMFINDREPLACE ) then
+ nShow = SW_SHOWNA
+ nLeftWidth = rcFindReplace.left - rcTopTabs.left
+ end if
+
+ SetWindowPos( HWND_FRMMAIN_TOPTABS_SHADOW, 0, _
+ rcTopTabs.left, rcTopTabs.bottom, _
+ nLeftWidth, AfxGetWindowHeight( HWND_FRMMAIN_TOPTABS_SHADOW ), _
+ SWP_NOZORDER or SWP_NOACTIVATE )
+
+ ShowWindow( HWND_FRMMAIN_TOPTABS_SHADOW, nShow )
+
+ else
+ ShowWindow( HWND_FRMMAIN_TOPTABS_SHADOW, SW_HIDE )
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Adjust all of the Tab rects left and right dimensions by the incoming amount
+' ========================================================================================
+function frmTopTabs_AdjustTabRects( byval nAdjAmount as long ) as long
+ ' nAdjAmount can be +/-
+ dim pDoc as clsDocument ptr
+
+ for i as long = lbound(gTTabCtl.tabs) to ubound(gTTabCtl.tabs)
+ pDoc = gTTabCtl.tabs(i).pDoc
+ if pDoc then
+ gTTabCtl.tabs(i).rcTab.left += nAdjAmount
+ gTTabCtl.tabs(i).rcTab.right += nAdjAmount
+ gTTabCtl.tabs(i).rcIcon.left += nAdjAmount
+ gTTabCtl.tabs(i).rcIcon.right += nAdjAmount
+ gTTabCtl.tabs(i).rcText.left += nAdjAmount
+ gTTabCtl.tabs(i).rcText.right += nAdjAmount
+ gTTabCtl.tabs(i).rcClose.left += nAdjAmount
+ gTTabCtl.tabs(i).rcClose.right += nAdjAmount
+ end if
+ next
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+function frmTopTabs_PositionWindows() As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN_TOPTABS)
+ If pWindow = 0 Then Exit Function
+
+ ' Get the entire client area
+ Dim As Rect rc: GetClientRect( HWND_FRMMAIN_TOPTABS, @rc )
+
+ ' Calculate the RECT positions for all of the top tabs
+ dim pDoc as clsDocument ptr
+ dim as long nTextWidth = 0
+ dim as long nLeft = rc.left
+ dim as long TabHeight = TOPTABS_HEIGHT
+ dim as long rcTextWidth = 70
+ dim as long rcCloseWidth = 20
+ dim as long rcIconWidth = 20 ' currently not using an icon in the tabs
+ dim as long rightBorderWidth = 2
+ dim as long hmargin = 3
+ dim as long ActionPanelWidth = 114
+ dim as long ActionButtonWidth = 24
+ dim as long ActionButtonHeight = 22
+ dim as long PrevTabsButtonWidth = 20
+ dim as long PrevTabsButtonHeight = 20
+
+ ' calculate the right hand side Action area panel that holds the
+ ' more actions "..." button.
+ gTTabCtl.rcActionPanel = rc
+ gTTabCtl.rcActionPanel.left = gTTabCtl.rcActionPanel.right - pWindow->ScaleX( ActionPanelWidth )
+
+ ' calculate the Prev and Next Tabs buttons
+ dim as long vmargin = (TabHeight - PrevTabsButtonHeight) / 2
+ gTTabCtl.rcPrevTabs.left = gTTabCtl.rcActionPanel.left + pWindow->ScaleX( hmargin * 2)
+ gTTabCtl.rcPrevTabs.top = rc.top + pWindow->ScaleY(vmargin)
+ gTTabCtl.rcPrevTabs.bottom = gTTabCtl.rcPrevTabs.top + pWindow->ScaleY( PrevTabsButtonHeight )
+ gTTabCtl.rcPrevTabs.right = gTTabCtl.rcPrevTabs.left + pWindow->ScaleX( PrevTabsButtonWidth )
+
+ gTTabCtl.rcNextTabs.left = gTTabCtl.rcPrevTabs.right + pWindow->ScaleX( hmargin )
+ gTTabCtl.rcNextTabs.top = rc.top + pWindow->ScaleY(vmargin)
+ gTTabCtl.rcNextTabs.bottom = gTTabCtl.rcNextTabs.top + pWindow->ScaleY( PrevTabsButtonHeight )
+ gTTabCtl.rcNextTabs.right = gTTabCtl.rcNextTabs.left + pWindow->ScaleX( PrevTabsButtonWidth )
+
+ ' calculate the split editor button
+ gTTabCtl.rcSplitEditor.left = gTTabCtl.rcNextTabs.right + pWindow->ScaleX( hmargin )
+ gTTabCtl.rcSplitEditor.top = rc.top + pWindow->ScaleY(vmargin)
+ gTTabCtl.rcSplitEditor.bottom = gTTabCtl.rcSplitEditor.top + pWindow->ScaleY( PrevTabsButtonHeight )
+ gTTabCtl.rcSplitEditor.right = gTTabCtl.rcSplitEditor.left + pWindow->ScaleX( PrevTabsButtonWidth )
+
+ ' calculate the actual more actions "..." button itself
+ vmargin = (TabHeight - ActionButtonHeight) / 2
+ gTTabCtl.rcActionButton.left = gTTabCtl.rcSplitEditor.right + pWindow->ScaleX( hmargin )
+ gTTabCtl.rcActionButton.top = rc.top + pWindow->ScaleY(vmargin)
+ gTTabCtl.rcActionButton.bottom = gTTabCtl.rcActionButton.top + pWindow->ScaleY( ActionButtonHeight )
+ gTTabCtl.rcActionButton.right = gTTabCtl.rcActionButton.left + pWindow->ScaleY( ActionButtonWidth )
+
+ for i as long = lbound(gTTabCtl.tabs) to ubound(gTTabCtl.tabs)
+ pDoc = gTTabCtl.tabs(i).pDoc
+ if pDoc then
+ ' Determine the length of the text
+ gTTabCtl.tabs(i).wszText = AfxStrPathname( "NAMEX", pDoc->DiskFilename )
+ nTextWidth = getTextWidth( HWND_FRMMAIN_TOPTABS, gTTabCtl.tabs(i).wszText, ghMenuBar.hFontMenuBar, 0 )
+ if nTextWidth < 70 then nTextWidth = 70
+
+ ' calculate the various tab dimensions
+ gTTabCtl.tabs(i).rcTab = rc
+ gTTabCtl.tabs(i).rcTab.Left = nLeft
+ gTTabCtl.tabs(i).rcTab.Right = nLeft + pWindow->ScaleX(rcIconWidth + nTextWidth + hmargin + rcCloseWidth + hmargin + rightBorderWidth)
+
+ gTTabCtl.tabs(i).rcIcon = gTTabCtl.tabs(i).rcTab
+ gTTabCtl.tabs(i).rcIcon.top = gTTabCtl.tabs(i).rcIcon.top + pWindow->ScaleY(vmargin)
+ gTTabCtl.tabs(i).rcIcon.bottom = gTTabCtl.tabs(i).rcIcon.top + pWindow->ScaleY(rcCloseWidth)
+ gTTabCtl.tabs(i).rcIcon.Left = gTTabCtl.tabs(i).rcTab.Left
+ gTTabCtl.tabs(i).rcIcon.Right = gTTabCtl.tabs(i).rcIcon.Left + pWindow->ScaleX(rcIconWidth)
+
+ gTTabCtl.tabs(i).rcText = gTTabCtl.tabs(i).rcTab
+ gTTabCtl.tabs(i).rcText.Left = gTTabCtl.tabs(i).rcIcon.Right
+ gTTabCtl.tabs(i).rcText.Right = gTTabCtl.tabs(i).rcText.Left + pWindow->ScaleX(nTextWidth)
+
+ gTTabCtl.tabs(i).rcClose = gTTabCtl.tabs(i).rcTab
+ gTTabCtl.tabs(i).rcClose.top = gTTabCtl.tabs(i).rcClose.top + pWindow->ScaleY(vmargin)
+ gTTabCtl.tabs(i).rcClose.bottom = gTTabCtl.tabs(i).rcClose.top + pWindow->ScaleY(rcCloseWidth)
+ gTTabCtl.tabs(i).rcClose.Left = gTTabCtl.tabs(i).rcText.Right + hmargin + hmargin
+ gTTabCtl.tabs(i).rcClose.Right = gTTabCtl.tabs(i).rcClose.Left + pWindow->ScaleX(rcCloseWidth)
+
+ gTTabCtl.tabs(i).pDoc = pDoc
+ gTTabCtl.tabs(i).isHot = false
+ nLeft = gTTabCtl.tabs(i).rcTab.Right
+ end if
+ next
+
+ ' We now know the exact width and postions of all tabs so now we need to calculate
+ ' and adjust the gTTabCtl.FirstDisplayTab based on where the gTTabCtl.CurSel is located.
+ if gTTabCtl.GetItemCount = 0 then
+ ShowWindow( HWND_FRMMAIN_TOPTABS_SHADOW, SW_HIDE )
+ else
+ ' Adjust all of the Rects based on the current starting tab position
+ dim as long nAdjAmount = gTTabCtl.tabs(gTTabCtl.FirstDisplayTab).rcTab.left
+ frmTopTabs_AdjustTabRects( -(nAdjAmount) )
+
+ gTTabCtl.ClientRightEdge = gTTabCtl.rcActionPanel.left
+
+ if gTTabCtl.CurSel = -1 then
+ ' Put If check for CurSel being invalid otherwise other tab calculations
+ ' Scenarios will fail via GPF on invalid array access.
+
+ ' SCENARIO #1
+ ' New gTTabCtl.CurSel is located before gTTabCtl.FirstDisplayTab so it is visually
+ ' not on screen. We simply need to move the gTTabCtl.CurSel rect into the
+ ' the first position (gTTabCtl.FirstDisplayTab) and adjust all rects accordingly.
+ elseif gTTabCtl.CurSel < gTTabCtl.FirstDisplayTab then
+ ' The amount of the adjustment is equal to the difference between the
+ ' current first tab's left edge and the new cursel's left edge.
+ nAdjAmount = gTTabCtl.tabs(gTTabCtl.FirstDisplayTab).rcTab.left - gTTabCtl.tabs(gTTabCtl.CurSel).rcTab.left
+ frmTopTabs_AdjustTabRects( nAdjAmount )
+ gTTabCtl.FirstDisplayTab = gTTabCtl.CurSel
+
+ ' SCENARIO #2
+ ' The gTTabCtl.CurSel is already located within view but the right client edge
+ ' for the tabcontrol may have grown wider so if the last tab's (ubound(gTTabCtl.tabs)
+ ' right edge falls before the right edge then there may be an opportunity to shift
+ ' all of the tabs right to help fill the space.
+ elseif gTTabCtl.tabs(gTTabCtl.CurSel).rcTab.right < gTTabCtl.ClientRightEdge then
+ if gTTabCtl.tabs(ubound(gTTabCtl.tabs)).rcTab.right < gTTabCtl.ClientRightEdge then
+ nAdjAmount = 0
+ if gTTabCtl.FirstDisplayTab - 1 >= 0 then
+ dim as long nTabWidth = _
+ gTTabCtl.tabs(gTTabCtl.FirstDisplayTab - 1).rcTab.Right - gTTabCtl.tabs(gTTabCtl.FirstDisplayTab - 1).rcTab.left
+ if gTTabCtl.tabs(ubound(gTTabCtl.tabs)).rcTab.right + nTabWidth <= gTTabCtl.ClientRightEdge then
+ frmTopTabs_AdjustTabRects( nTabWidth )
+ gTTabCtl.FirstDisplayTab = gTTabCtl.FirstDisplayTab - 1
+ end if
+ end if
+ end if
+
+ ' SCENARIO #3
+ ' gTTabCtl.CurSel is located past the tab control's right edge. We can begin
+ ' "removing" tabs at the start of the view until the gTTabCtl.CurSel tab comes
+ ' completely within view.
+ elseif gTTabCtl.tabs(gTTabCtl.CurSel).rcTab.right > gTTabCtl.ClientRightEdge then
+ ' need to determine how far to move the gTTabCtl.FirstDisplayTab
+ nAdjAmount = 0
+ for i as long = gTTabCtl.FirstDisplayTab to gTTabCtl.CurSel
+ ' remove the width of each successive tab starting with the
+ ' first tab and work our way until we reach the target tab.
+ dim as long nTabWidth = gTTabCtl.tabs(i).rcTab.Right - gTTabCtl.tabs(i).rcTab.left
+ nAdjAmount += nTabWidth
+ if gTTabCtl.tabs(gTTabCtl.CurSel).rcTab.Right - nAdjAmount <= gTTabCtl.ClientRightEdge then
+ gTTabCtl.FirstDisplayTab = i + 1
+ frmTopTabs_AdjustTabRects( -(nAdjAmount) )
+ exit for
+ end if
+ next
+ end if
+
+ ' sanity checks
+ if gTTabCtl.FirstDisplayTab > ubound(gTTabCtl.tabs) then
+ gTTabCtl.FirstDisplayTab = ubound(gTTabCtl.tabs)
+ elseif gTTabCtl.FirstDisplayTab < 0 then
+ gTTabCtl.FirstDisplayTab = 0
+ end if
+
+ end if
+ AfxRedrawWindow( HWND_FRMMAIN_TOPTABS )
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmTopTabs
+' ========================================================================================
+Function frmTopTabs_OnSize( _
+ ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+
+ If state <> SIZE_MINIMIZED Then
+ frmTopTabs_PositionWindows()
+ End If
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Do hit test to determine what tab is currently under the mouse cursor
+' ========================================================================================
+function getHotTabHitTest( byval hWin as HWnd ) as long
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ dim as long hotTab = -1
+ for i as long = lbound(gTTabCtl.tabs) to ubound(gTTabCtl.tabs)
+ if PtInRect( @gTTabCtl.tabs(i).rcTab, pt ) then
+ hotTab = i
+ gTTabCtl.tabs(i).isHot = true
+ else
+ gTTabCtl.tabs(i).isHot = false
+ end if
+ next
+ function = hotTab
+end function
+
+' ========================================================================================
+' Do hit test to determine if "X" close button on tab was clicked
+' ========================================================================================
+function isTabCloseHitTest( byval hWin as HWnd, byval idx as long ) as long
+ if gTTabCtl.IsSafeIndex(idx) = false then exit function
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ if PtInRect( @gTTabCtl.tabs(idx).rcClose, pt ) then return idx
+ function = -1
+end function
+
+' ========================================================================================
+' Do hit test to determine if "..." button in action Area was clicked
+' ========================================================================================
+function isActionButtonHitTest( byval hWin as HWnd ) as boolean
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ if PtInRect( @gTTabCtl.rcActionButton, pt ) then return true
+ function = false
+end function
+
+' ========================================================================================
+' Do hit test to determine if Prev Tabs button in action Area was clicked
+' ========================================================================================
+function isPrevTabsHitTest( byval hWin as HWnd ) as boolean
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ if PtInRect( @gTTabCtl.rcPrevTabs, pt ) then return true
+ function = false
+end function
+
+' ========================================================================================
+' Do hit test to determine if Next Tabs button in action Area was clicked
+' ========================================================================================
+function isNextTabsHitTest( byval hWin as HWnd ) as boolean
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ if PtInRect( @gTTabCtl.rcNextTabs, pt ) then return true
+ function = false
+end function
+
+' ========================================================================================
+' Do hit test to determine if SplitEditor button in action Area was clicked
+' ========================================================================================
+function isSplitEditorHitTest( byval hWin as HWnd ) as boolean
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ if PtInRect( @gTTabCtl.rcSplitEditor, pt ) then return true
+ function = false
+end function
+
+' ========================================================================================
+' Do hit test if over the Action Panel (no action but prevents other tooltips)
+' ========================================================================================
+function isActionPanelHitTest( byval hWin as HWnd ) as boolean
+ dim as POINT pt: GetCursorPos( @pt )
+ MapWindowPoints( HWND_DESKTOP, hWin, cast( POINT ptr, @pt ), 1 )
+ if PtInRect( @gTTabCtl.rcActionPanel, pt ) then return true
+ function = false
+end function
+
+' ========================================================================================
+' frmTopTabsShadow_WndProc Window procedure
+' ========================================================================================
+Function frmTopTabsShadow_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ case WM_DESTROY
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(HWnd)
+ If pWindow = 0 Then Delete pWindow
+ end select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+end function
+
+' ========================================================================================
+' frmTopTabs Window procedure
+' ========================================================================================
+Function frmTopTabs_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ static as long curr_idxHot = -1
+ static hTooltip as HWND
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_SIZE, frmTopTabs_OnSize)
+
+ case WM_DESTROY
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(HWnd)
+ If pWindow = 0 Then Delete pWindow
+ DestroyWindow( HWND_FRMMAIN_TOPTABS_SHADOW )
+
+ case WM_ERASEBKGND
+ return true
+
+ case WM_MOUSEMOVE
+ Dim tme As TrackMouseEvent
+ tme.cbSize = Sizeof(TrackMouseEvent)
+ tme.dwFlags = TME_HOVER Or TME_LEAVE
+ tme.hwndTrack = HWnd
+ TrackMouseEvent(@tme)
+
+ if IsWindow(hTooltip) = 0 then hTooltip = AfxAddTooltip( HWnd, "", false, false )
+
+ curr_idxHot = getHotTabHitTest( HWnd )
+ AfxRedrawWindow( HWnd )
+
+ if gApp.bDragTabActive then
+ if gTTabCtl.IsSafeIndex(curr_idxHot) = false then exit function
+ SetCursor( LoadCursor(0, MAKEINTRESOURCE(OCR_SIZEALL)) )
+ ' Swap the two elements in the array
+ swap gTTabCtl.tabs(gTTabCtl.CurSel), gTTabCtl.tabs(curr_idxHot)
+ gTTabCtl.SetFocusTab( curr_idxHot )
+ frmTopTabs_PositionWindows()
+ end if
+
+
+ case WM_MOUSELEAVE
+ ' this will reset all tabs isHot to -1 and curr_idxHot to -1
+ curr_idxHot = getHotTabHitTest( HWnd )
+ AfxDeleteTooltip( hTooltip, HWnd )
+ hTooltip = 0
+ AfxRedrawWindow( HWnd )
+
+
+ case WM_MOUSEHOVER
+ dim as CWSTR wszTooltip
+ ' test for Action Button, Filename caption or Close caption
+ curr_idxHot = getHotTabHitTest( HWnd )
+ if isPrevTabsHitTest( HWnd ) then
+ wszTooltip = L(431, "Scroll Tabs Left")
+ elseif isNextTabsHitTest( HWnd ) then
+ wszTooltip = L(432, "Scroll Tabs Right")
+ elseif isSplitEditorHitTest( HWnd ) then
+ wszTooltip = L(447, "Split Editor")
+ elseif isActionButtonHitTest( HWnd ) then
+ wszTooltip = L(430, "Tab List")
+ elseif isActionPanelHitTest( HWnd ) then
+ ' do nothing. no tooltip.
+ elseif isTabCloseHitTest( HWnd, curr_idxHot ) = curr_idxHot then
+ wszTooltip = L(86, "Close Tab")
+ else
+ if gTTabCtl.IsSafeIndex(curr_idxHot) = false then exit function
+ wszTooltip = gTTabCtl.tabs(curr_idxHot).pDoc->DiskFilename
+ end if
+ ' Display the tooltip
+ AfxSetTooltipText( hTooltip, HWnd, wszTooltip )
+ AfxRedrawWindow( HWnd )
+
+
+ case WM_RBUTTONDOWN
+ if isPrevTabsHitTest( HWnd ) then
+ elseif isNextTabsHitTest( HWnd ) then
+ elseif isSplitEditorHitTest( HWnd ) then
+ elseif isActionButtonHitTest( HWnd ) then
+ elseif isActionPanelHitTest( HWnd ) then
+ else
+ ' Create the popup menu
+ curr_idxHot = getHotTabHitTest( HWnd )
+ if gTTabCtl.IsSafeIndex(curr_idxHot) = false then exit function
+ gTTabCtl.SetFocusTab(curr_idxHot)
+ Dim As POINT pt
+ dim as HMENU hPopupMenu = CreateTopTabCtlContextMenu(curr_idxHot)
+ GetCursorPos @pt
+ TrackPopupMenu(hPopUpMenu, 0, pt.x, pt.y, 0, HWND_FRMMAIN, ByVal Null)
+ DestroyMenu hPopUpMenu
+ Return True ' prevent further processing that leads to WM_CONTEXTMENU
+ end if
+
+ case WM_LBUTTONDOWN
+ if isPrevTabsHitTest( HWnd ) then
+ elseif isNextTabsHitTest( HWnd ) then
+ elseif isSplitEditorHitTest( HWnd ) then
+ elseif isActionButtonHitTest( HWnd ) then
+ elseif isActionPanelHitTest( HWnd ) then
+ else
+ curr_idxHot = getHotTabHitTest( HWnd )
+ if gTTabCtl.IsSafeIndex(curr_idxHot) = false then exit function
+ if (isTabCloseHitTest( HWnd, curr_idxHot ) = curr_idxHot) and (curr_idxHot <> gTTabCtl.CurSel) then
+ ' we are mouse down on an "X" close on a tab that is not currently the active tab. We
+ ' will simply close that tab rather than bring it into focus and then delete.
+ ' allow the mouse message to eventually bubble up WM_LBUTTONUP where we do the close.
+ else
+ ' we have clicked on tab so bring it into focus
+ gTTabCtl.SetFocusTab( curr_idxHot )
+ if (wParam and MK_SHIFT) then
+ gApp.bDragTabActive = true
+ SetCursor( LoadCursor(0, MAKEINTRESOURCE(OCR_SIZEALL)) )
+ end if
+ AfxRedrawWindow( HWnd )
+ end if
+ SetCapture(hWnd)
+ end if
+
+ case WM_LBUTTONDBLCLK
+ ' This will have already fired WM_LBUTTONUP
+ ' If the tab holds a pDoc that is a visual designer form then we will toggle between
+ ' code and design by toggling the designer tab control.
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc then
+ if pDoc->IsDesigner then
+ pDoc->DesignTabsCurSel = iif(pDoc->DesignTabsCurSel = 0, 1, 0)
+ frmMain_PositionWindows
+ PostMessage( HWND_FRMMAIN, MSG_USER_GENERATECODE, 0, 0 )
+ end if
+ end if
+
+ case WM_LBUTTONUP
+ if isPrevTabsHitTest( HWnd ) then
+ ' if the first displayed tab is not index 0 then there must be tabs before it
+ ' that can be displayed. If no previous tabs then set focus to the first tab.
+ if gTTabCtl.FirstDisplayTab > 0 then
+ gTTabCtl.SetFocusTab( gTTabCtl.FirstDisplayTab - 1 )
+ else
+ gTTabCtl.SetFocusTab(0)
+ end if
+ elseif isNextTabsHitTest( HWnd ) then
+ ' determine if there are any tabs to the right of the current display view. Bring
+ ' the first one found (if any) into view. Keep track of the found tab because if
+ ' none found then simply set the CurSel to the last tab.
+ dim as long nFound = -1
+ for i as long = gTTabCtl.FirstDisplayTab to gTTabCtl.GetItemCount - 1
+ if gTTabCtl.tabs(i).rcTab.Left > gTTabCtl.ClientRightEdge then
+ nFound = i: exit for
+ exit for
+ end if
+ next
+ if nFound = -1 then nFound = gTTabCtl.GetItemCount - 1
+ gTTabCtl.SetFocusTab(nFound)
+
+ elseif isSplitEditorHitTest( HWnd ) then
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc then
+ pDoc->bEditorIsSplit = not pDoc->bEditorIsSplit
+ if pDoc->bEditorIsSplit then
+ dim as RECT rc = AfxGetWindowRect(pDoc->hWindow(0))
+ MapWindowPoints( HWND_DESKTOP, HWND_FRMMAIN, cast(POINT ptr, @rc), 2 )
+ pDoc->SplitY = (rc.bottom - rc.top) / 2
+ else
+ pDoc->SplitY = 0
+ end if
+ frmMain_PositionWindows()
+ end if
+
+ elseif isActionButtonHitTest( HWnd ) then
+ dim as HMENU hPopupMenu = CreateTopTabsActionButtonContextMenu()
+ ' Popup the menu to the bottom of the Action Button (right aligned)
+ dim as RECT rc = gTTabCtl.rcActionButton ' work with a copy
+ MapWindowPoints( HWND_FRMMAIN_TOPTABS, HWND_DESKTOP, cast(POINT ptr, @rc), 2 )
+ dim as long id = TrackPopupMenu(hPopUpMenu, _
+ TPM_RIGHTALIGN or TPM_RETURNCMD, _
+ rc.right, rc.bottom, 0, HWND_FRMMAIN, byval null)
+ ' Return value is 1 based because 0 indicates that menu was cancelled
+ if (id > 0) andalso (id <= gTTabCtl.GetItemCount) then
+ gTTabCtl.SetFocusTab(id-1)
+ end if
+ DestroyMenu( hPopUpMenu )
+ Return true ' prevent further processing that leads to WM_CONTEXTMENU
+
+ elseif isActionPanelHitTest( HWnd ) then
+ else
+ ' Reset the mouse pointer
+ SetCursor( LoadCursor( null, IDC_ARROW ))
+ ReleaseCapture
+ gApp.bDragTabActive = false
+ ' If we are still over an "X" close during buttonup then close the tab
+ curr_idxHot = getHotTabHitTest( HWnd )
+ if gTTabCtl.IsSafeIndex(curr_idxHot) = false then exit function
+ if isTabCloseHitTest( HWnd, curr_idxHot ) = curr_idxHot then
+ gTTabCtl.CloseTab( curr_idxHot )
+ frmTopTabs_PositionWindows()
+ end if
+ end if
+
+ case WM_PAINT
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDc
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN_TOPTABS)
+ If pWindow = 0 Then Exit Function
+
+ hDC = BeginPaint( hWnd, @ps )
+
+ SaveDC(hDC)
+ dim as long nWidth = ps.rcPaint.right - ps.rcPaint.left
+ dim as long nHeight = ps.rcPaint.bottom - ps.rcPaint.top
+
+ Dim memDC as HDC ' Double buffering
+ Dim hbit As HBITMAP ' Double buffering
+
+ memDC = CreateCompatibleDC( hDC )
+ hbit = CreateCompatibleBitmap( hDC, nWidth, nHeight )
+ If hbit Then hbit = SelectObject( memDC, hbit )
+
+ ' Fill in the entire back panel width across the top of the screen
+ FillRect( memDC, @ps.rcPaint, ghTopTabs.hPanelBrush )
+
+ ' Create a black pen that acts as the divider for each tab
+ dim as long penWidth = pWindow->ScaleX(1)
+ dim as HPEN hPenSolid = CreatePen( PS_SOLID, penWidth, ghTopTabs.Divider )
+ SelectObject( memDC, hPenSolid)
+
+ dim as HPEN hPenNull = CreatePen( PS_NULL, 1, 0 ) ' null/invisible pen
+
+ dim as POINT pt: GetCursorPos( @pt )
+ dim as RECT rc
+
+ ' All of the rc calculations have already been done in frmTopTabs_PostionWindows
+ if gTTabCtl.FirstDisplayTab > ubound(gTTabCtl.tabs) then gTTabCtl.FirstDisplayTab = lbound(gTTabCtl.tabs)
+ for i as long = gTTabCtl.FirstDisplayTab to ubound(gTTabCtl.tabs)
+ ' paint this tab based on active/inactive status
+ if i = gTTabCtl.CurSel then
+ SetBkColor( memDC, ghTopTabs.BackColorHot )
+ SetTextColor( memDC, ghTopTabs.ForeColorHot )
+ FillRect( memDC, @gTTabCtl.tabs(i).rcTab, ghTopTabs.hBackBrushHot )
+ else
+ SetBkColor( memDC, ghTopTabs.BackColor )
+ SetTextColor( memDC, ghTopTabs.ForeColor )
+ FillRect( memDC, @gTTabCtl.tabs(i).rcTab, ghTopTabs.hBackBrush )
+ end if
+
+ ' display the rcIcon
+ 'dim as long wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER or DT_SINGLELINE
+ 'SelectObject( memDC, ghMenuBar.hFontSymbolSmall )
+ 'DrawText( memDC, wszTabDocument, -1, Cast(lpRect, @gTTabCtl.tabs(i).rcIcon), wsStyle )
+
+ ' display the tab text
+ dim as long wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER or DT_SINGLELINE
+ SelectObject(memDC, ghMenuBar.hFontMenuBar)
+ DrawText( memDC, gTTabCtl.tabs(i).wszText.sptr, -1, Cast(lpRect, @gTTabCtl.tabs(i).rcText), wsStyle )
+
+ ' if this document is dirty then the dirty circle icon overrides the display of the close icon
+ ' unless the tab isHot. The dirty icon displays always for active and inactive tabs.
+ dim as boolean isDirty
+ If cbool(SciExec( gTTabCtl.tabs(i).pDoc->hWindow(0), SCI_GETMODIFY, 0, 0 )) then isDirty = true
+ if gTTabCtl.tabs(i).pDoc->UserModified then isDirty = true
+
+ if isDirty then
+ ' if mouse is over the rcClose then draw the close icon, otherwise draw the dirty circle
+ SelectObject( memDC, ghMenuBar.hFontSymbolSmall )
+ DrawText( memDC, wszCompileResultIcon, -1, Cast(lpRect, @gTTabCtl.tabs(i).rcClose), wsStyle )
+ end if
+
+ if (i = gTTabCtl.CurSel) or (gTTabCtl.tabs(i).isHot = true) then
+ ' if this is the active tab or it is mouse hot then display the close icon only
+ ' if the dirty icon is not already being displayed
+ rc = gTTabCtl.tabs(i).rcClose
+ if isDirty = false then
+ SelectObject( memDC, ghMenuBar.hFontSymbolSmall )
+ DrawText( memDC, wszClose, -1, Cast(lpRect, @rc), wsStyle )
+ end if
+ if (isTabCloseHitTest( HWnd, i ) = i) andalso (gApp.bDragTabActive = false) then
+ ' if we are hovered over the "X" close icon rect then highlight it
+ SelectPen( memDC, hPenNull )
+ SelectObject( memDC, ghTopTabs.hCloseBrushHot )
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ SetBkColor( memDC, ghTopTabs.CloseBackColorHot )
+ SelectObject( memDC, ghMenuBar.hFontSymbolSmall )
+ DrawText( memDC, wszClose, -1, Cast(lpRect, @rc), wsStyle )
+ end if
+ end if
+
+ ' Draw the righthand side black divider
+ SelectPen( memDC, hPenSolid )
+ MoveToEx( memDC, gTTabCtl.tabs(i).rcTab.Right - penWidth, gTTabCtl.tabs(i).rcTab.top, null )
+ LineTo( memDC, gTTabCtl.tabs(i).rcTab.Right - penWidth, gTTabCtl.tabs(i).rcTab.bottom )
+
+ next
+
+ ' Lastly, draw the TopTabs Action Area (basically, the little panel to the
+ ' right of all of the top tabs that has the "..." icon.
+ if gTTabCtl.GetItemCount then
+ ' paint the full Action Panel
+ FillRect( memDC, @gTTabCtl.rcActionPanel, ghTopTabs.hPanelBrush )
+
+ ' Draw the PrevTabs button
+ SelectObject( memDC, ghTopTabs.hPanelBrush )
+ SetBkColor( memDC, ghTopTabs.BackColor )
+ SetTextColor( memDC, ghTopTabs.ForeColorHot )
+ if isPrevTabsHitTest( HWnd ) then
+ SetBkColor( memDC, ghTopTabs.CloseBackColorHot )
+ SelectObject( memDC, ghTopTabs.hCloseBrushHot )
+ end if
+ rc = gTTabCtl.rcPrevTabs
+ SelectPen( memDC, hPenNull )
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ dim as long wsStyle = DT_NOPREFIX or DT_CENTER Or DT_TOP 'or DT_SINGLELINE
+ SelectObject(memDC, ghMenuBar.hFontSymbol)
+ DrawText( memDC, wszChevronLeft, -1, Cast(lpRect, @rc), wsStyle )
+
+ ' Draw the NextTabs button
+ SelectObject( memDC, ghTopTabs.hPanelBrush )
+ SetBkColor( memDC, ghTopTabs.BackColor )
+ SetTextColor( memDC, ghTopTabs.ForeColorHot )
+ if isNextTabsHitTest( HWnd ) then
+ SetBkColor( memDC, ghTopTabs.CloseBackColorHot )
+ SelectObject( memDC, ghTopTabs.hCloseBrushHot )
+ end if
+ rc = gTTabCtl.rcNextTabs
+ SelectPen( memDC, hPenNull )
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ wsStyle = DT_NOPREFIX or DT_CENTER Or DT_TOP 'or DT_SINGLELINE
+ SelectObject(memDC, ghMenuBar.hFontSymbol)
+ DrawText( memDC, wszChevronRight, -1, Cast(lpRect, @rc), wsStyle )
+
+ ' Draw the SplitEditor button
+ SelectObject( memDC, ghTopTabs.hPanelBrush )
+ SetBkColor( memDC, ghTopTabs.BackColor )
+ SetTextColor( memDC, ghTopTabs.ForeColorHot )
+ if isSplitEditorHitTest( HWnd ) then
+ SetBkColor( memDC, ghTopTabs.CloseBackColorHot )
+ SelectObject( memDC, ghTopTabs.hCloseBrushHot )
+ end if
+ rc = gTTabCtl.rcSplitEditor
+ SelectPen( memDC, hPenNull )
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ wsStyle = DT_NOPREFIX or DT_CENTER Or DT_TOP 'or DT_SINGLELINE
+ SelectObject(memDC, ghMenuBar.hFontSymbol)
+ DrawText( memDC, wszSplitEditor, -1, Cast(lpRect, @rc), wsStyle )
+
+ ' Draw the Action buttom "..."
+ SelectObject( memDC, ghTopTabs.hPanelBrush )
+ SetBkColor( memDC, ghTopTabs.BackColor )
+ SetTextColor( memDC, ghTopTabs.ForeColorHot )
+ if isActionButtonHitTest( HWnd ) then
+ SetBkColor( memDC, ghTopTabs.CloseBackColorHot )
+ SelectObject( memDC, ghTopTabs.hCloseBrushHot )
+ end if
+ rc = gTTabCtl.rcActionButton
+ SelectPen( memDC, hPenNull )
+ RoundRect( memDC, rc.left, rc.top, rc.right, rc.bottom, 20, 20 )
+ wsStyle = DT_NOPREFIX or DT_CENTER Or DT_VCENTER 'or DT_SINGLELINE
+ SelectObject(memDC, ghMenuBar.hFontSymbolLargeBold)
+ DrawText( memDC, wszMoreActions, -1, Cast(lpRect, @rc), wsStyle )
+ end if
+
+ BitBlt( hDC, 0, 0, nWidth, nHeight, memDC, 0, 0, SRCCOPY )
+
+ ' Cleanup
+ if hPenSolid then DeleteObject( hPenSolid )
+ if hPenNull then DeleteObject( hPenNull )
+ if hbit then DeleteObject( SelectObject(memDC, hbit) )
+ if memDC then DeleteDC( memDC )
+ RestoreDC( hDC, -1 )
+
+ EndPaint( hWnd, @ps )
+
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+
+' ========================================================================================
+' frmTopTabs_Show
+' ========================================================================================
+Function frmTopTabs_Show( ByVal hWndParent As HWnd ) As LRESULT
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowPtr(hwndParent)->DPI
+
+ HWND_FRMMAIN_TOPTABS = pWindow->Create( hWndParent, "", @frmTopTabs_WndProc, _
+ 0, 0, 0, TOPTABS_HEIGHT, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ ' Disable background erasing by only assigning the one style
+ pWindow->ClassStyle = CS_DBLCLKS
+
+ ' create semi-transparent window offset under our tabcontrol in order to simulate a shadow.
+ if gApp.isWineActive = false then
+ pWindow = New CWindow
+ pWindow->DPI = AfxCWindowPtr(HWND_FRMMAIN)->DPI
+ HWND_FRMMAIN_TOPTABS_SHADOW = pWindow->Create( HWND_FRMMAIN, "", _
+ @frmTopTabsShadow_WndProc, 0, 0, 0, pWindow->ScaleY(1), _
+ WS_POPUP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, WS_EX_LAYERED or WS_EX_NOACTIVATE )
+ pWindow->ClassStyle = CS_DBLCLKS
+ pWindow->Brush = GetSysColorBrush(COLOR_WINDOWTEXT + 1) ' black background
+ ' 0 totally transparent, 255 totally opaque
+ SetLayeredWindowAttributes( HWND_FRMMAIN_TOPTABS_SHADOW, GetSysColor(COLOR_WINDOWTEXT + 1) , 100, LWA_ALPHA )
+ end if
+
+ frmTopTabs_PositionWindows()
+ Function = 0
+
+End Function
+
diff --git a/src/frmUserTools.bi b/src/frmUserTools.bi
index 0b442294..f4b83a10 100644
--- a/src/frmUserTools.bi
+++ b/src/frmUserTools.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmUserTools.bi.bak b/src/frmUserTools.bi.bak
new file mode 100644
index 00000000..0b442294
--- /dev/null
+++ b/src/frmUserTools.bi.bak
@@ -0,0 +1,66 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#DEFINE IDC_FRMUSERTOOLS_LSTTOOLS 1000
+#DEFINE IDC_FRMUSERTOOLS_CMDINSERT 1001
+#DEFINE IDC_FRMUSERTOOLS_CMDDELETE 1002
+#DEFINE IDC_FRMUSERTOOLS_CMDUP 1003
+#DEFINE IDC_FRMUSERTOOLS_CMDDOWN 1004
+#DEFINE IDC_FRMUSERTOOLS_TXTTOOLNAME 1005
+#DEFINE IDC_FRMUSERTOOLS_TXTCOMMAND 1006
+#DEFINE IDC_FRMUSERTOOLS_TXTPARAMETERS 1007
+#DEFINE IDC_FRMUSERTOOLS_TXTKEY 1008
+#DEFINE IDC_FRMUSERTOOLS_LABEL1 1009
+#DEFINE IDC_FRMUSERTOOLS_LABEL2 1010
+#DEFINE IDC_FRMUSERTOOLS_LABEL3 1011
+#DEFINE IDC_FRMUSERTOOLS_CMDBROWSEEXE 1012
+#DEFINE IDC_FRMUSERTOOLS_LABEL4 1013
+#DEFINE IDC_FRMUSERTOOLS_TXTWORKINGFOLDER 1014
+#DEFINE IDC_FRMUSERTOOLS_CMDBROWSEFOLDER 1015
+#DEFINE IDC_FRMUSERTOOLS_LABEL5 1016
+#DEFINE IDC_FRMUSERTOOLS_LABEL6 1017
+#DEFINE IDC_FRMUSERTOOLS_CHKCTRL 1018
+#DEFINE IDC_FRMUSERTOOLS_CHKALT 1019
+#DEFINE IDC_FRMUSERTOOLS_CHKSHIFT 1020
+#DEFINE IDC_FRMUSERTOOLS_LABEL7 1021
+#DEFINE IDC_FRMUSERTOOLS_CHKPROMPT 1022
+#DEFINE IDC_FRMUSERTOOLS_CHKMINIMIZED 1023
+#DEFINE IDC_FRMUSERTOOLS_CHKWAIT 1024
+#DEFINE IDC_FRMUSERTOOLS_COMBOACTION 1025
+#DEFINE IDC_FRMUSERTOOLS_LABEL8 1026
+#DEFINE IDC_FRMUSERTOOLS_LABEL9 1027
+#Define IDC_FRMUSERTOOLS_CHKDISPLAYMENU 1028
+#Define IDC_FRMUSERTOOLS_CMDOK 1029
+
+' User Tool actions (selected, pre/post compile, after WinFBE starts up)
+const USERTOOL_ACTION_SELECTED = 0
+const USERTOOL_ACTION_PRECOMPILE = 1
+const USERTOOL_ACTION_POSTCOMPILE = 2
+const USERTOOL_ACTION_WINFBESTARTUP = 3
+
+common shared as HACCEL ghAccelUserTools
+
+declare Function frmUserTools_ExecuteUserTool( ByVal nToolNum As Long ) As Long
+declare Function frmUserTools_CreateAcceleratorTable() As Long
+declare Function frmUserTools_Show( ByVal hWndParent As HWnd ) as LRESULT
+declare Function updateUserToolsMenuItems() as long
+declare function createToolsMenuShortcut( byval nCtrlID as long ) as CWSTR
+
+
+
+
+
+
+
diff --git a/src/frmUserTools.inc b/src/frmUserTools.inc
index 07fe0457..9cb3fcc8 100644
--- a/src/frmUserTools.inc
+++ b/src/frmUserTools.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmUserTools.inc.bak b/src/frmUserTools.inc.bak
new file mode 100644
index 00000000..07fe0457
--- /dev/null
+++ b/src/frmUserTools.inc.bak
@@ -0,0 +1,793 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmUserTools.bi"
+#include once "clsConfig.bi"
+#include once "modMRU.bi"
+
+
+' ========================================================================================
+' Update the UserTools items in the topmenu array
+' ========================================================================================
+function updateUserToolsMenuItems() as long
+ ' clear MRU items already existing in the gTopMenu array. We overwrite and extend
+ ' the gTopMenu array rather than erase it because existing menus depend on the
+ ' array index that aready exist. The function also returns the width to use for
+ ' the resulting popup menu (based on text width metrics of each filename).
+ clearMRUFilesItems( IDM_USERTOOLS )
+
+ dim wszText as WSTRING * 256
+ dim as boolean hasTools = false
+ dim as long txtWidth = 0
+ dim as long nMenuWidth = -1
+
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_USERTOOLS, IDM_USERTOOLSDIALOG, 0, false, false )
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_USERTOOLS, 0, 0, false, true )
+
+ for i as long = lbound(gConfig.Tools) to ubound(gConfig.Tools)
+ hasTools = true
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_USERTOOLS, IDM_USERTOOLSBASE + i, 0, false, false )
+ wszText = gConfig.Tools(i).wszDescription
+ if gConfig.Tools(i).wszKey then
+ wszText = wszText & chr(9) & gConfig.Tools(i).wszKey
+ end if
+ txtWidth = getTextWidth( HWND_FRMMAIN_MENUBAR, wszText, ghMenuBar.hFontMenuBar, 30 )
+ if txtWidth > nMenuWidth then nMenuWidth = txtWidth
+ next
+
+ if hasTools = false then
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_USERTOOLS, IDM_USERTOOLSLIST, 0, false, false ) ' (empty)
+ end if
+
+ function = nMenuWidth
+end function
+
+
+' ========================================================================================
+' Prepare and Execute a user tool
+' ========================================================================================
+function frmUserTools_ExecuteUserTool( ByVal nToolNum As Long ) As Long
+
+ Dim ShExecInfo As SHELLEXECUTEINFOW
+ Dim pDocMain As clsDocument Ptr
+ Dim pDocCurrent As clsDocument Ptr
+
+ dim wszCommand As CWSTR
+ dim wszParameters As CWSTR
+ dim wszProjectName As CWSTR
+ dim wszMainSource As CWSTR
+ dim wszExeName As CWSTR
+ dim wszWord As CWSTR
+ dim wszWorkingFolder as CWSTR
+ dim sCurrentDir As String
+
+ dim nWndStyle As Long = SW_SHOWNORMAL
+
+
+ ' Make sure that the incoming Tool Number is valid
+ If (nToolNum < LBound(gConfig.Tools)) Orelse (nToolNum > UBound(gConfig.Tools)) Then exit function
+
+ If gConfig.Tools(nToolNum).IsPromptRun Then
+ If MessageBox( HWND_FRMMAIN, L(304,"Please confirm that you wish to run the following User Tool:") + vbcrlf + _
+ gConfig.Tools(nToolNum).wszDescription, L(276,"Confirm"), _
+ MB_ICONQUESTION Or MB_YESNOCANCEL ) <> IDYES Then
+ exit function
+ End If
+ End If
+
+ if gConfig.Tools(nToolNum).IsMinimized then nWndStyle = SW_SHOWMINNOACTIVE
+
+ ' Prepare the command line based on any substitute parameters
+ If Len(gConfig.Tools(nToolNum).wszParameters) Then
+
+ pDocCurrent = gTTabCtl.GetActiveDocumentPtr()
+
+ ' Do the substitutions for the command line parameters
+ If gApp.IsProjectActive Then
+ wszProjectName = AfxStrPathname("NAMEX", gApp.ProjectFilename)
+ pDocMain = gApp.GetMainDocumentPtr()
+ else
+ pDocMain = pDocCurrent
+ END IF
+
+ if pDocMain THEN wszMainSource = chr(34) + pDocMain->DiskFilename + chr(34)
+
+ wszParameters = gConfig.Tools(nToolNum).wszParameters
+ wszParameters = AfxStrReplace(wszParameters, "", wszProjectName)
+ wszParameters = AfxStrReplace(wszParameters, "
", wszProjectName)
+ wszParameters = AfxStrReplace(wszParameters, "", wszMainSource)
+ wszParameters = AfxStrReplace(wszParameters, "", wszMainSource)
+
+ dim as long idxBuild = frmBuildConfig_getActiveBuildIndex()
+ if (idxBuild > -1) andalso (pDocMain <> 0) THEN
+ wszExeName = gCompile.OutputFilename
+ if len(wszExeName) = 0 then
+ wszExeName = AfxStrPathname("PATH", pDocMain->DiskFilename) + _
+ AfxStrPathname("NAME", pDocMain->DiskFilename) + _
+ ".exe"
+ If Instr(Ucase(gConfig.Builds(idxBuild).wszOptions), " -DLL") orelse _
+ Instr(Ucase(gConfig.Builds(idxBuild).wszOptions), " -DYLIB") Then
+ wszExeName = AfxStrPathname("PATH", pDocMain->DiskFilename) + _
+ AfxStrPathname("NAME", pDocMain->DiskFilename) + _
+ ".dll"
+ end if
+ If Instr(Ucase(gConfig.Builds(idxBuild).wszOptions), " -LIB") then
+ wszExeName = AfxStrPathname("PATH", pDocMain->DiskFilename) + _
+ AfxStrPathname("NAME", pDocMain->DiskFilename) + _
+ ".a"
+ end if
+ end if
+ END IF
+ wszParameters = AfxStrReplace(wszParameters, "", wszExeName)
+ wszParameters = AfxStrReplace(wszParameters, "", wszExeName)
+
+ if pDocCurrent Then
+ ' Determine the word underneath the cursor
+ wszWord = Trim(pDocCurrent->GetWord, Any " ()*&^%$#@!~`:;'>", wszWord)
+ wszParameters = AfxStrReplace(wszParameters, "", wszWord)
+
+ end if
+
+ ' Change the working folder
+ sCurrentDir = CurDir
+ ' Is the specified working folder valid? If it is not, then maybe try same path
+ ' but use the current drive.
+ wszWorkingFolder = gConfig.Tools(nToolNum).wszWorkingFolder
+
+
+ If Len(wszWorkingFolder) Then
+ ' Convert relative path to absolute path if needed.
+ if AfxPathIsRelative(wszWorkingFolder) then
+ wszWorkingFolder = AfxPathCombine(AfxGetExePathName, wszWorkingFolder)
+ END IF
+ if AfxPathIsDirectory(wszWorkingFolder) = false then
+ wszWorkingFolder = left(AfxGetExePathName, 1) + mid(wszWorkingFolder, 2)
+ end if
+ ChDir gConfig.Tools(nToolNum).wszWorkingFolder
+ End If
+
+ ' Is the specified exe command to execute valid? If it is not, then maybe try same path
+ ' but use the current drive.
+ wszCommand = gConfig.Tools(nToolNum).wszCommand
+ ' Convert relative path to absolute path if needed.
+ if AfxPathIsRelative(wszCommand) then
+ wszCommand = AfxPathCombine(AfxGetExePathName, wszCommand)
+ END IF
+ if AfxPathFileExists(wszCommand) = false THEN
+ wszCommand = left(AfxGetExePathName, 1) + mid(wszCommand, 2)
+ END IF
+ wszCommand = wchr(34) + wszCommand + wchr(34)
+
+ With ShExecInfo
+ .cbSize = Len(SHELLEXECUTEINFOW)
+ .fMask = SEE_MASK_NOCLOSEPROCESS
+ .HWnd = 0
+ .lpVerb = Null
+ .lpFile = wszCommand
+ .lpParameters = wszParameters
+ .lpDirectory = 0
+ .nShow = nWndStyle
+ .hInstApp = 0
+ End With
+ ShellExecuteEx(@ShExecInfo)
+
+ if gConfig.Tools(nToolNum).IsWaitFinish then
+ ' Give the process 100 ms
+ while WaitForSingleObject(ShExecInfo.hProcess, 100) = WAIT_TIMEOUT
+ wend
+ end if
+
+ ' Restore the current drive/directory
+ ChDir sCurrentDir
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Create the keyboard shortcut text description.
+' ========================================================================================
+function createToolsMenuShortcut( byval nCtrlID as long ) as CWSTR
+ dim wszShortcut as CWSTR
+
+ If gConfig.Tools(nCtrlID).IsCtrl Then wszShortcut = "Ctrl+"
+ If gConfig.Tools(nCtrlID).IsShift Then wszShortcut = wszShortcut + "Shift+"
+ If gConfig.Tools(nCtrlID).IsAlt Then wszShortcut = wszShortcut + "Alt+"
+ wszShortcut = trim(wszShortcut + UCase(Trim(gConfig.Tools(nCtrlID).wszKey)), any " +")
+
+ return wszShortcut
+end function
+
+
+
+' ========================================================================================
+' Create an accelerator table based on selections for the user tools.
+' Also adds the Tools to the top menu.
+' ========================================================================================
+function frmUserTools_CreateAcceleratorTable() As Long
+
+ dim NumKeys As Long
+ dim nKey As Long
+ dim fVirt As Long
+
+ If ghAccelUserTools Then DestroyAcceleratorTable(ghAccelUserTools)
+ Dim a(any) As ACCEL
+
+ NumKeys = 0
+ For y as long = LBound(gConfig.Tools) To UBound(gConfig.Tools)
+
+ fVirt = FNOINVERT Or FVIRTKEY
+
+ If gConfig.Tools(y).IsCtrl Then fVirt = fVirt Or FCONTROL
+ If gConfig.Tools(y).IsShift Then fVirt = fVirt Or FSHIFT
+ If gConfig.Tools(y).IsAlt Then fVirt = fVirt Or FALT
+
+ nKey = 0 ' important to reset
+ Select Case UCase(Trim(gConfig.Tools(y).wszKey))
+ Case "F1": nKey = VK_F1
+ Case "F2": nKey = VK_F2
+ Case "F3": nKey = VK_F3
+ Case "F4": nKey = VK_F4
+ Case "F5": nKey = VK_F5
+ Case "F6": nKey = VK_F6
+ Case "F7": nKey = VK_F7
+ Case "F8": nKey = VK_F8
+ Case "F9": nKey = VK_F9
+ Case "F10": nKey = VK_F10
+ Case "F11": nKey = VK_F11
+ Case "F12": nKey = VK_F12
+ Case "0": nKey = VK_0
+ Case "1": nKey = VK_1
+ Case "2": nKey = VK_2
+ Case "3": nKey = VK_3
+ Case "4": nKey = VK_4
+ Case "5": nKey = VK_5
+ Case "6": nKey = VK_6
+ Case "7": nKey = VK_7
+ Case "8": nKey = VK_8
+ Case "9": nKey = VK_9
+ Case "A": nKey = VK_A
+ Case "B": nKey = VK_B
+ Case "C": nKey = VK_C
+ Case "D": nKey = VK_D
+ Case "E": nKey = VK_E
+ Case "F": nKey = VK_F
+ Case "G": nKey = VK_G
+ Case "H": nKey = VK_H
+ Case "I": nKey = VK_I
+ Case "J": nKey = VK_J
+ Case "K": nKey = VK_K
+ Case "L": nKey = VK_L
+ Case "M": nKey = VK_M
+ Case "N": nKey = VK_N
+ Case "O": nKey = VK_O
+ Case "P": nKey = VK_P
+ Case "Q": nKey = VK_Q
+ Case "R": nKey = VK_R
+ Case "S": nKey = VK_S
+ Case "T": nKey = VK_T
+ Case "U": nKey = VK_U
+ Case "V": nKey = VK_V
+ Case "W": nKey = VK_W
+ Case "X": nKey = VK_X
+ Case "Y": nKey = VK_Y
+ Case "Z": nKey = VK_Z
+ End Select
+
+ If nKey > 0 Then
+ NumKeys = NumKeys + 1
+ ReDim Preserve a(1 To NumKeys) As ACCEL
+ a(NumKeys).fVirt = fVirt
+ a(NumKeys).key = nKey
+ a(NumKeys).cmd = IDM_USERTOOLSBASE + y
+ End If
+
+ Next
+
+ If NumKeys Then
+ ghAccelUserTools = CreateAcceleratorTable(CAST(LPACCEL, @a(1)), NumKeys)
+ End If
+
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Load all of the Tools descriptions into the listbox
+' ========================================================================================
+function frmUserTools_LoadListBox( byval hParent as hwnd ) as Long
+ dim hList1 as hwnd = GetDlgItem(hParent, IDC_FRMUSERTOOLS_LSTTOOLS)
+
+ ListBox_ResetContent(hList1)
+ for i as long = lbound(gConfig.ToolsTemp) to ubound(gConfig.ToolsTemp)
+ ListBox_AddString(hList1, gConfig.ToolsTemp(i).wszDescription.sptr)
+ NEXT
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Swap two entries in the Tools Listbox
+' ========================================================================================
+function frmUserTools_SwapListBoxItems( _
+ byval Item1 as long, _
+ byval Item2 as long _
+ ) as Long
+ dim as hwnd hList1 = GetDlgItem( HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_LSTTOOLS)
+
+ ' Swap the array values
+ swap gConfig.ToolsTemp(Item1), gConfig.ToolsTemp(Item2)
+
+ ListBox_ReplaceString(hList1, Item1, gConfig.ToolsTemp(Item1).wszDescription)
+ ListBox_ReplaceString(hList1, Item2, gConfig.ToolsTemp(Item2).wszDescription)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Set the UserTools textboxes and options depending on what listbox entry is selected
+' ========================================================================================
+function frmUserTools_SetTextboxes() as long
+ dim as long nCurSel = ListBox_GetCurSel(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_LSTTOOLS))
+ dim as Boolean fEnabled = iif( nCurSel < 0, false, true)
+
+ AfxSetWindowText(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTTOOLNAME), iif(fEnabled, gConfig.ToolsTemp(nCurSel).wszDescription, wstr("")))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTTOOLNAME), fEnabled)
+ AfxSetWindowText(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTCOMMAND), iif(fEnabled, gConfig.ToolsTemp(nCurSel).wszCommand, wstr("")))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTCOMMAND), fEnabled)
+ AfxSetWindowText(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTPARAMETERS), iif(fEnabled, gConfig.ToolsTemp(nCurSel).wszParameters, wstr("")))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTPARAMETERS), fEnabled)
+ AfxSetWindowText(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTKEY), iif(fEnabled, gConfig.ToolsTemp(nCurSel).wszKey, wstr("")))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTKEY), fEnabled)
+ AfxSetWindowText(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTWORKINGFOLDER), iif(fEnabled, gConfig.ToolsTemp(nCurSel).wszWorkingFolder, wstr("")))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_TXTWORKINGFOLDER), fEnabled)
+ Button_SetCheck(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKCTRL), iif(fEnabled, gConfig.ToolsTemp(nCurSel).IsCtrl, 0))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKCTRL), fEnabled)
+ Button_SetCheck(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKALT), iif(fEnabled, gConfig.ToolsTemp(nCurSel).IsAlt, 0))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKALT), fEnabled)
+ Button_SetCheck(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKSHIFT), iif(fEnabled, gConfig.ToolsTemp(nCurSel).IsShift, 0))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKSHIFT), fEnabled)
+ Button_SetCheck(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKPROMPT), iif(fEnabled, gConfig.ToolsTemp(nCurSel).IsPromptRun, 0))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKPROMPT), fEnabled)
+ Button_SetCheck(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKMINIMIZED), iif(fEnabled, gConfig.ToolsTemp(nCurSel).IsMinimized, 0))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKMINIMIZED), fEnabled)
+ Button_SetCheck(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKWAIT), iif(fEnabled, gConfig.ToolsTemp(nCurSel).IsWaitFinish, 0))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKWAIT), fEnabled)
+ Button_SetCheck(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKDISPLAYMENU), iif(fEnabled, gConfig.ToolsTemp(nCurSel).IsDisplayMenu, 0))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_CHKDISPLAYMENU), fEnabled)
+ ComboBox_SetCurSel(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_COMBOACTION), iif(fEnabled, gConfig.ToolsTemp(nCurSel).Action, 0))
+ EnableWindow(GetDlgItem(HWND_FRMUSERTOOLS, IDC_FRMUSERTOOLS_COMBOACTION), fEnabled)
+
+ function = 0
+end function
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmUserTools
+' ========================================================================================
+function frmUserTools_OnCreate( _
+ byval HWnd As HWnd, _
+ byval lpCreateStructPtr As LPCREATESTRUCT _
+ ) as boolean
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmUserTools
+' ========================================================================================
+function frmUserTools_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim as hwnd hList1 = GetDlgItem( HWND, IDC_FRMUSERTOOLS_LSTTOOLS)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+
+ Select Case id
+ case IDC_FRMUSERTOOLS_LSTTOOLS
+ if codeNotify = LBN_SELCHANGE THEN
+ frmUserTools_SetTextboxes()
+ END IF
+
+ case IDC_FRMUSERTOOLS_TXTTOOLNAME
+ if codeNotify = EN_CHANGE THEN
+ ' Update the temp array and the Listbox
+ if nCurSel > -1 THEN
+ gConfig.ToolsTemp(nCurSel).wszDescription = AfxGetWindowText(hwndCtl)
+ ListBox_ReplaceString(hList1, nCurSel, gConfig.ToolsTemp(nCurSel).wszDescription)
+ END IF
+ end if
+
+ CASE IDC_FRMUSERTOOLS_TXTCOMMAND
+ if codeNotify = EN_CHANGE THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).wszCommand = AfxGetWindowText(hwndCtl)
+ end if
+
+ case IDC_FRMUSERTOOLS_CMDBROWSEEXE
+ if codeNotify = BN_CLICKED THEN
+ Dim pwszName As WString Ptr = AfxIFileOpenDialogW(HWnd, IDC_FRMUSERTOOLS_CMDBROWSEEXE)
+ If pwszName Then
+ AfxSetWindowText( GetDlgItem(HWnd, IDC_FRMUSERTOOLS_TXTCOMMAND), pwszName )
+ CoTaskMemFree pwszName
+ End If
+ end if
+
+ CASE IDC_FRMUSERTOOLS_TXTPARAMETERS
+ if codeNotify = EN_CHANGE THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).wszParameters = AfxGetWindowText(hwndCtl)
+ end if
+
+ CASE IDC_FRMUSERTOOLS_TXTKEY
+ if codeNotify = EN_CHANGE THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).wszKey = AfxGetWindowText(hwndCtl)
+ end if
+
+ CASE IDC_FRMUSERTOOLS_TXTWORKINGFOLDER
+ if codeNotify = EN_CHANGE THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).wszWorkingFolder = AfxGetWindowText(hwndCtl)
+ end if
+
+ case IDC_FRMUSERTOOLS_CMDBROWSEFOLDER
+ if codeNotify = BN_CLICKED THEN
+ dim as CWSTR cwsFolder = AfxBrowseForFolder(HWND, L(293,"Working Folder:"), curdir)
+ if len(cwsFolder) THEN
+ AfxSetWindowText( GetDlgItem(HWnd, IDC_FRMUSERTOOLS_TXTWORKINGFOLDER), cwsFolder)
+ END IF
+ end if
+
+ case IDC_FRMUSERTOOLS_CHKCTRL
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).IsCtrl = Button_GetCheck(hwndCtl)
+ end if
+
+ case IDC_FRMUSERTOOLS_CHKALT
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).IsAlt = Button_GetCheck(hwndCtl)
+ end if
+
+ case IDC_FRMUSERTOOLS_CHKSHIFT
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).IsShift = Button_GetCheck(hwndCtl)
+ end if
+
+ case IDC_FRMUSERTOOLS_CHKPROMPT
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).IsPromptRun = Button_GetCheck(hwndCtl)
+ end if
+
+ case IDC_FRMUSERTOOLS_CHKMINIMIZED
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).IsMinimized = Button_GetCheck(hwndCtl)
+ end if
+
+ case IDC_FRMUSERTOOLS_CHKWAIT
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).IsWaitFinish = Button_GetCheck(hwndCtl)
+ end if
+
+ case IDC_FRMUSERTOOLS_CHKDISPLAYMENU
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN gConfig.ToolsTemp(nCurSel).IsDisplayMenu = Button_GetCheck(hwndCtl)
+ end if
+
+ case IDC_FRMUSERTOOLS_COMBOACTION
+ if codeNotify = CBN_SELCHANGE THEN
+ if nCurSel > -1 then gConfig.ToolsTemp(nCurSel).Action = ComboBox_GetCurSel(hwndCtl)
+ END IF
+
+ case IDC_FRMUSERTOOLS_CMDUP
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > 0 THEN
+ frmUserTools_SwapListboxItems(nCurSel, nCurSel-1)
+ END IF
+ end if
+
+ case IDC_FRMUSERTOOLS_CMDDOWN
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel < ListBox_GetCount(hList1)-1 THEN
+ frmUserTools_SwapListboxItems(nCurSel, nCurSel+1)
+ END IF
+ end if
+
+ case IDC_FRMUSERTOOLS_CMDINSERT
+ if codeNotify = BN_CLICKED THEN
+ if ubound(gConfig.ToolsTemp) = -1 THEN
+ redim gConfig.ToolsTemp(0)
+ nCurSel = 0
+ Else
+ redim preserve gConfig.ToolsTemp(ubound(gConfig.ToolsTemp)+1)
+ if nCurSel = -1 THEN nCurSel = 0
+ ' insert the item above current entry in the internal array
+ for i as long = ubound(gConfig.ToolsTemp) to nCurSel + 1 step -1
+ gConfig.ToolsTemp(i) = gConfig.ToolsTemp(i-1)
+ NEXT
+ END IF
+ gConfig.ToolsTemp(nCurSel).wszDescription = ""
+ gConfig.ToolsTemp(nCurSel).wszCommand = ""
+ gConfig.ToolsTemp(nCurSel).wszParameters = ""
+ gConfig.ToolsTemp(nCurSel).wszKey = ""
+ gConfig.ToolsTemp(nCurSel).wszWorkingFolder = ""
+ gConfig.ToolsTemp(nCurSel).IsCtrl = 0
+ gConfig.ToolsTemp(nCurSel).IsAlt = 0
+ gConfig.ToolsTemp(nCurSel).IsShift = 0
+ gConfig.ToolsTemp(nCurSel).IsPromptRun = 0
+ gConfig.ToolsTemp(nCurSel).IsMinimized = 0
+ gConfig.ToolsTemp(nCurSel).IsWaitFinish = 0
+ gConfig.ToolsTemp(nCurSel).IsDisplayMenu = 0
+ ' reload the listbox
+ frmUserTools_LoadListBox(HWND)
+ nCurSel = Min(nCurSel, ubound(gConfig.ToolsTemp))
+ ListBox_SetCurSel(hList1, nCurSel)
+ frmUserTools_SetTextboxes()
+ SetFocus GetDlgItem(HWND, IDC_FRMUSERTOOLS_TXTTOOLNAME)
+ end if
+
+ case IDC_FRMUSERTOOLS_CMDDELETE
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN
+ if MessageBox( HWND, L(300, "Are you sure you want to delete this user tool?"), L(276,"Confirm"), _
+ MB_YESNOCANCEL Or MB_ICONINFORMATION Or MB_DEFBUTTON1 ) = IDYES then
+ if ubound(gConfig.ToolsTemp) = 0 THEN
+ erase gConfig.ToolsTemp
+ nCurSel = -1
+ else
+ ' remove the item from the internal array
+ for i as long = nCurSel to ubound(gConfig.ToolsTemp) - 1
+ gConfig.ToolsTemp(i) = gConfig.ToolsTemp(i+1)
+ NEXT
+ redim preserve gConfig.ToolsTemp(ubound(gConfig.ToolsTemp)-1)
+ END IF
+ ' reload the listbox
+ frmUserTools_LoadListBox(HWND)
+ nCurSel = Min(nCurSel, ubound(gConfig.ToolsTemp))
+ ListBox_SetCurSel(hList1, nCurSel)
+ frmUserTools_SetTextboxes()
+ SetFocus hList1
+ end if
+ END IF
+ end if
+
+ Case IDC_FRMUSERTOOLS_CMDOK
+ If codeNotify = BN_CLICKED Then
+ ' Copy the temporary items to the main array
+ redim gConfig.Tools(ubound(gConfig.ToolsTemp))
+ for i as long = lbound(gConfig.ToolsTemp) to ubound(gConfig.ToolsTemp)
+ gConfig.Tools(i) = gConfig.ToolsTemp(i)
+ next
+ erase gConfig.ToolsTemp
+ frmUserTools_CreateAcceleratorTable
+ gConfig.SaveConfigFile
+ updateUserToolsMenuItems()
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ end if
+
+ Case IDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmUserTools
+' ========================================================================================
+private Function frmUserTools_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow( HWnd )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmUserTools
+' ========================================================================================
+private Function frmUserTools_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmUserTools Window procedure
+' ========================================================================================
+private Function frmUserTools_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmUserTools_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmUserTools_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmUserTools_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmUserTools_OnCommand)
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmUserTools_Show
+' ========================================================================================
+public Function frmUserTools_Show( ByVal hWndParent As HWnd ) as LRESULT
+
+ DIM hBitmap AS HBITMAP
+ dim hCtrl as HWnd
+ dim wszImage as wstring * 100
+
+ ' Create the main window and child controls
+ Dim pWindow as CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ Dim As HWnd hForm = _
+ pWindow->Create(hWndParent, L(289,"User Tools"), _
+ @frmUserTools_WndProc, 0, 0, 683, 465, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->SetClientSize(677, 436)
+ pWindow->Center
+
+ pWindow->AddControl("LISTBOX", , IDC_FRMUSERTOOLS_LSTTOOLS, "", 9, 10, 218, 362, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or LBS_NOINTEGRALHEIGHT, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("BUTTON", , IDC_FRMUSERTOOLS_CMDINSERT, L(281, "Insert"), 8, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMUSERTOOLS_CMDDELETE, L(282, "Delete"), 87, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ hCtrl = _
+ pWindow->AddControl("BUTTON", , IDC_FRMUSERTOOLS_CMDUP, wszTriangleUp, 166, 388, 28, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghMenuBar.hFontSymbolLargeBold, false )
+
+ hCtrl = _
+ pWindow->AddControl("BUTTON", , IDC_FRMUSERTOOLS_CMDDOWN, wszTriangleDown, 199, 388, 28, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ AfxSetWindowFont( hCtrl, ghMenuBar.hFontSymbolLargeBold, false )
+
+ pWindow->AddControl("LABEL", , IDC_FRMUSERTOOLS_LABEL1, L(290,"Tool Name") & ":", 230, 25, 95, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMUSERTOOLS_TXTTOOLNAME, "", 334, 22, 305, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("LABEL", , IDC_FRMUSERTOOLS_LABEL2, L(291,"Command") & ":", 230, 50, 95, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMUSERTOOLS_TXTCOMMAND, "", 334, 47, 267, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("BUTTON", , IDC_FRMUSERTOOLS_CMDBROWSEEXE, "...", 610, 46, 30, 23, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", , IDC_FRMUSERTOOLS_LABEL3, L(292,"Parameters") & ":", 230, 75, 95, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMUSERTOOLS_TXTPARAMETERS, "", 334, 72, 305, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("LABEL", , IDC_FRMUSERTOOLS_LABEL4, " Project Name Main Source File Current Word Exe/DLL Name", 334, 101, 302, 36, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", , IDC_FRMUSERTOOLS_LABEL5, L(293,"Working Folder") & ":", 230, 177, 95, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMUSERTOOLS_TXTWORKINGFOLDER, "", 334, 174, 267, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("BUTTON", , IDC_FRMUSERTOOLS_CMDBROWSEFOLDER, "...", 610, 173, 30, 23, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", , IDC_FRMUSERTOOLS_LABEL6, L(294,"Accelerator") & ":", 230, 205, 95, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMUSERTOOLS_CHKCTRL, "Ctrl", 335, 202, 48, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMUSERTOOLS_CHKALT, "Alt", 391, 202, 42, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMUSERTOOLS_CHKSHIFT, "Shift", 441, 202, 48, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", , IDC_FRMUSERTOOLS_LABEL7, "Key", 559, 204, 38, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMUSERTOOLS_TXTKEY, "", 498, 201, 52, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMUSERTOOLS_CHKPROMPT, L(295,"Prompt for confirmation when Tool is invoked"), 334, 259, 347, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMUSERTOOLS_CHKMINIMIZED, L(296,"Run minimized"), 334, 281, 214, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMUSERTOOLS_CHKWAIT, L(297,"Wait for Tool to complete before continuing"), 334, 303, 344, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMUSERTOOLS_CHKDISPLAYMENU, L(299,"Display this item in the editor menu"), 334, 325, 344, 19, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMUSERTOOLS_COMBOACTION, "", 334, 228, 308, 22, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("LABEL", , IDC_FRMUSERTOOLS_LABEL8, L(298,"Action:"), 230, 232, 95, 18, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_RIGHT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("LABEL", , IDC_FRMUSERTOOLS_LABEL9, "", 238, 370, 425, 2, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY Or SS_SUNKEN, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMUSERTOOLS_CMDOK, L(0,"OK"), 509, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDCANCEL, L(1,"Cancel"), 591, 388, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ HWND_FRMUSERTOOLS = hForm
+
+ ' Copy all of the Tools to the ToolsTemp array because we will work with
+ ' temporary copies until the user hits OK.
+ redim gConfig.ToolsTemp(ubound(gConfig.Tools))
+ for i as long = lbound(gConfig.Tools) to ubound(gConfig.Tools)
+ gConfig.ToolsTemp(i) = gConfig.Tools(i)
+ NEXT
+ frmUserTools_LoadListBox(hForm)
+
+ ' Load the Actions combobox
+ dim hCombo as hwnd = GetDlgItem(hForm, IDC_FRMUSERTOOLS_COMBOACTION)
+ ComboBox_AddString( hCombo, @L(303,"Invoke only when selected by user") )
+ ComboBox_AddString( hCombo, @L(302,"Invoke during pre-compile") )
+ ComboBox_AddString( hCombo, @L(301,"Invoke during post-compile") )
+ ComboBox_AddString( hCombo, @L(402,"Invoke immediately after WinFBE starts") )
+
+ dim hList as hwnd = GetDlgItem(hForm, IDC_FRMUSERTOOLS_LSTTOOLS)
+ ListBox_SetCurSel(hList, 0)
+ frmUserTools_SetTextboxes()
+ SetFocus GetDlgItem(hForm, IDC_FRMUSERTOOLS_LSTTOOLS)
+
+ ' Process Windows messages
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the frmUserTools CWindow class manually allocated memory
+ Delete pWindow
+
+ function = 0
+end function
+
diff --git a/src/frmVDTabChild.bi b/src/frmVDTabChild.bi
index f12f83bd..9f0d9409 100644
--- a/src/frmVDTabChild.bi
+++ b/src/frmVDTabChild.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmVDTabChild.bi.bak b/src/frmVDTabChild.bi.bak
new file mode 100644
index 00000000..f12f83bd
--- /dev/null
+++ b/src/frmVDTabChild.bi.bak
@@ -0,0 +1,52 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+
+#DEFINE IDC_FRMVDTABCHILD_LIST1 1000
+#DEFINE IDC_FRMVDTABCHILD_TXTDESCRIPTION 1001
+#DEFINE IDC_FRMVDTABCHILD_TXTIMAGE 1002
+#DEFINE IDC_FRMVDTABCHILD_CMDIMAGE 1003
+#DEFINE IDC_FRMVDTABCHILD_COMBOTABPAGES 1004
+#DEFINE IDC_FRMVDTABCHILD_CHKISDEFAULT 1005
+#DEFINE IDC_FRMVDTABCHILD_CMDADD 1006
+#DEFINE IDC_FRMVDTABCHILD_CMDINSERT 1007
+#DEFINE IDC_FRMVDTABCHILD_CMDDELETE 1008
+#DEFINE IDC_FRMVDTABCHILD_CMDUP 1009
+#DEFINE IDC_FRMVDTABCHILD_CMDDOWN 1010
+#DEFINE IDC_FRMVDTABCHILD_CMDOK 1011
+#DEFINE IDC_FRMVDTABCHILD_CMDCANCEL 1012
+#DEFINE IDC_FRMVDTABCHILD_LABEL1 1013
+#DEFINE IDC_FRMVDTABCHILD_LABEL2 1014
+#DEFINE IDC_FRMVDTABCHILD_LABEL3 1015
+
+type TabPage
+ wszText as CWSTR
+ wszImage as CWSTR
+ wszTabPage as CWSTR
+ IsActiveTab as long ' must be Long rather than boolean
+ wszReserved1 as CWSTR ' for future use
+ wszReserved2 as CWSTR
+ wszReserved3 as CWSTR
+ wszReserved4 as CWSTR
+end type
+
+dim shared gTabPages(any) as TabPage
+
+dim shared gTabRecordSep as CWSTR = "-[]-"
+dim shared gTabFieldSep as CWSTR = "-||-"
+
+declare function frmVDTabChild_LoadTabPagesArray( byref wszPropValue as wstring ) as Long
+declare Function frmVDTabChild_Show( ByVal hWndParent As HWnd, byref wszPropValue as wstring ) As LRESULT
+
diff --git a/src/frmVDTabChild.inc b/src/frmVDTabChild.inc
index f18abace..7b4e21d6 100644
--- a/src/frmVDTabChild.inc
+++ b/src/frmVDTabChild.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/frmVDTabChild.inc.bak b/src/frmVDTabChild.inc.bak
new file mode 100644
index 00000000..f18abace
--- /dev/null
+++ b/src/frmVDTabChild.inc.bak
@@ -0,0 +1,520 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "frmVDTabChild.bi"
+
+
+' ========================================================================================
+' Load all of the tab child pages into the global gTabPages array
+' ========================================================================================
+function frmVDTabChild_LoadTabPagesArray( byref wszPropValue as wstring ) as Long
+
+ if len(trim(wszPropValue)) then
+ dim as long NumRecs = AfxStrParseCount( wszPropValue, gTabRecordSep )
+ redim gTabPages( NumRecs - 1 )
+
+ for i as long = 0 to ubound(gTabPages)
+ dim as CWSTR wszRecord = AfxStrParse( wszPropValue, i+1, gTabRecordSep )
+ ' the record's fields are separated by gTabFieldSep
+ gTabPages(i).wszText = AfxStrParse( wszRecord, 1, gTabFieldSep )
+ gTabPages(i).wszImage = AfxStrParse( wszRecord, 2, gTabFieldSep )
+ gTabPages(i).wszTabPage = AfxStrParse( wszRecord, 3, gTabFieldSep )
+ gTabPages(i).IsActiveTab = val(AfxStrParse( wszRecord, 4, gTabFieldSep ))
+ gTabPages(i).wszReserved1 = AfxStrParse( wszRecord, 5, gTabFieldSep )
+ gTabPages(i).wszReserved2 = AfxStrParse( wszRecord, 6, gTabFieldSep )
+ gTabPages(i).wszReserved3 = AfxStrParse( wszRecord, 7, gTabFieldSep )
+ gTabPages(i).wszReserved4 = AfxStrParse( wszRecord, 8, gTabFieldSep )
+ next
+ end if
+
+ function = 0
+end function
+
+' ========================================================================================
+' Load all of the tab child pages into the listbox
+' ========================================================================================
+private function frmVDTabChild_LoadBuildListBox( byval hParent as hwnd ) as Long
+ dim hList1 as hwnd = GetDlgItem(hParent, IDC_FRMVDTABCHILD_LIST1)
+
+ ListBox_ResetContent(hList1)
+ for i as long = lbound(gTabPages) to ubound(gTabPages)
+ ListBox_AddString(hList1, gTabPages(i).wszText.sptr)
+ NEXT
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Swap two entries in the Listbox
+' ========================================================================================
+private function frmVDTabChild_SwapListBoxItems( byval Item1 as long, _
+ Byval Item2 as long _
+ ) as Long
+ dim as hwnd hList1 = GetDlgItem( HWND_frmVDTabChild, IDC_FRMVDTABCHILD_LIST1)
+
+ ' Swap the array values
+ swap gTabPages(Item1), gTabPages(Item2)
+
+ ListBox_ReplaceString(hList1, Item1, gTabPages(Item1).wszText)
+ ListBox_ReplaceString(hList1, Item2, gTabPages(Item2).wszText)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Set the tab children depending on what listbox entry is selected
+' ========================================================================================
+private function frmVDTabChild_SetTabChildTextboxes() as long
+ dim as hwnd hList1 = GetDlgItem( HWND_frmVDTabChild, IDC_FRMVDTABCHILD_LIST1)
+ dim as hwnd hText1 = GetDlgItem( HWND_frmVDTabChild, IDC_FRMVDTABCHILD_TXTDESCRIPTION)
+ dim as hwnd hText2 = GetDlgItem( HWND_frmVDTabChild, IDC_FRMVDTABCHILD_TXTIMAGE)
+ dim as hwnd hCombo = GetDlgItem( HWND_frmVDTabChild, IDC_FRMVDTABCHILD_COMBOTABPAGES)
+ dim as hwnd hCheck = GetDlgItem( HWND_frmVDTabChild, IDC_FRMVDTABCHILD_CHKISDEFAULT)
+
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+ if nCurSel < 0 THEN
+ AfxSetWindowText( hText1, "" )
+ AfxSetWindowText( hText2, "" )
+ ComboBox_SetCurSel( hCombo, 0 )
+ Button_SetCheck( hCheck, 0 )
+ EnableWindow(hText1, false)
+ EnableWindow(hText2, false)
+ EnableWindow(hCombo, false)
+ EnableWindow(hCheck, false)
+ else
+ AfxSetWindowText( hText1, gTabPages(nCurSel).wszText)
+ AfxSetWindowText( hText2, gTabPages(nCurSel).wszImage)
+ Button_SetCheck( hCheck, gTabPages(nCurSel).IsActiveTab)
+ EnableWindow(hText1, true)
+ EnableWindow(hText2, true)
+ EnableWindow(hCombo, true)
+ EnableWindow(hCheck, true)
+
+ ' Match the child form combobox
+ ComboBox_SetCurSel( hCombo, 0 )
+ dim as long nCount = ComboBox_GetCount(hCombo)
+ for i as long = 0 to nCount - 1
+ if ucase(gTabPages(nCurSel).wszTabPage) = ucase(AfxGetComboBoxText(hCombo, i)) then
+ ComboBox_SetCurSel(hCombo, i)
+ exit for
+ END IF
+ next
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_CREATE message for window/dialog: frmVDTabChild
+' ========================================================================================
+private Function frmVDTabChild_OnCreate( ByVal HWnd As HWnd, _
+ ByVal lpCreateStructPtr As LPCREATESTRUCT _
+ ) As BOOLEAN
+
+ ' This is a modal popup window so disable the parent window
+ DisableAllModeless()
+
+ ' Message cracker macro expects a True to be returned for a successful
+ ' OnCreate handler even though returning -1 from a standard WM_CREATE
+ ' call would stop creating the window. This is just one of those Windows
+ ' inconsistencies.
+ Return True
+End Function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmVDTabChild
+' ========================================================================================
+private Function frmVDTabChild_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim as hwnd hList1 = GetDlgItem( HWND, IDC_FRMVDTABCHILD_LIST1)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+
+ Select Case id
+ case IDC_FRMVDTABCHILD_LIST1
+ if codeNotify = LBN_SELCHANGE THEN
+ frmVDTabChild_SetTabChildTextboxes()
+ END IF
+
+ case IDC_FRMVDTABCHILD_TXTDESCRIPTION
+ if codeNotify = EN_CHANGE THEN
+ ' Update the temp array and the Listbox
+ if nCurSel > -1 THEN
+ gTabPages(nCurSel).wszText = AfxGetWindowText(hwndCtl)
+ ListBox_ReplaceString(hList1, nCurSel, gTabPages(nCurSel).wszText)
+ END IF
+ end if
+
+ CASE IDC_FRMVDTABCHILD_TXTIMAGE
+ if codeNotify = EN_CHANGE THEN
+ ' Update the temp array
+ if nCurSel > -1 THEN
+ gTabPages(nCurSel).wszImage = AfxGetWindowText(hwndCtl)
+ END IF
+ end if
+
+ case IDC_FRMVDTABCHILD_CMDIMAGE
+ If codeNotify = BN_CLICKED Then
+ if nCurSel > -1 then
+ dim pProp as clsProperty ptr = new clsProperty
+ pProp->wszPropValue = gTabPages(nCurSel).wszImage
+
+ ' Need to save the gTabPages array because the frmImageManager will
+ ' reset it during a pDoc Save.
+ dim temp(ubound(gTabPages)) as TabPage
+ for i as long = lbound(gTabPages) to ubound(gTabPages)
+ temp(i) = gTabPages(i)
+ next
+
+ frmImageManager_Show( HWND, pProp )
+
+ ' Need to reload the gTabPages array that would have been reset.
+ redim gTabPages(ubound(temp)) as TabPage
+ for i as long = lbound(temp) to ubound(temp)
+ gTabPages(i) = temp(i)
+ next
+
+ gTabPages(nCurSel).wszImage = pProp->wszPropValue
+
+ delete pProp
+ frmVDTabChild_SetTabChildTextboxes
+ end if
+ end if
+
+ case IDC_FRMVDTABCHILD_COMBOTABPAGES
+ if codeNotify = CBN_SELCHANGE THEN
+ if nCurSel > -1 then
+ dim as long nComboSel = ComboBox_GetCurSel(hwndCtl)
+ gTabPages(nCurSel).wszTabPage = AfxGetComboBoxText(hwndCtl, nComboSel)
+ end if
+ END IF
+
+ case IDC_FRMVDTABCHILD_CHKISDEFAULT
+ if codeNotify = BN_CLICKED THEN
+ ' Update the temp array
+ if nCurSel > -1 THEN
+ gTabPages(nCurSel).IsActiveTab = Button_GetCheck(hwndCtl)
+ ' Can only have 1 entry as the default so ensure all others are reset
+ if Button_GetCheck(hwndCtl) THEN
+ for i as long = lbound(gTabPages) to ubound(gTabPages)
+ if i <> nCurSel THEN gTabPages(i).IsActiveTab = 0
+ NEXT
+ END IF
+ END IF
+ end if
+
+ case IDC_FRMVDTABCHILD_CMDUP
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > 0 THEN
+ frmVDTabChild_SwapListboxItems(nCurSel, nCurSel-1)
+ END IF
+ end if
+
+ case IDC_FRMVDTABCHILD_CMDDOWN
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel < ListBox_GetCount(hList1)-1 THEN
+ frmVDTabChild_SwapListboxItems(nCurSel, nCurSel+1)
+ END IF
+ end if
+
+ case IDC_FRMVDTABCHILD_CMDINSERT, IDC_FRMVDTABCHILD_CMDADD
+ if codeNotify = BN_CLICKED THEN
+ static as long nNextTabNum
+ nNextTabNum = nNextTabNum + 1
+ if ubound(gTabPages) = -1 THEN
+ redim gTabPages(0)
+ nCurSel = 0
+ Else
+ redim preserve gTabPages(ubound(gTabPages)+1)
+ if nCurSel = -1 THEN nCurSel = 0
+ if id = IDC_FRMVDTABCHILD_CMDINSERT then
+ ' insert the item above current entry in the internal array
+ for i as long = ubound(gTabPages) to nCurSel + 1 step -1
+ gTabPages(i) = gTabPages(i-1)
+ NEXT
+ elseif id = IDC_FRMVDTABCHILD_CMDADD then
+ nCurSel = ubound(gTabPages)
+ end if
+ END IF
+ gTabPages(nCurSel).wszText = "Tab " & nNextTabNum
+ gTabPages(nCurSel).wszImage = ""
+ gTabPages(nCurSel).wszTabPage = ""
+ gTabPages(nCurSel).IsActiveTab = 0
+ gTabPages(nCurSel).wszReserved1 = ""
+ gTabPages(nCurSel).wszReserved2 = ""
+ gTabPages(nCurSel).wszReserved3 = ""
+ gTabPages(nCurSel).wszReserved4 = ""
+ ' reload the listbox
+ frmVDTabChild_LoadBuildListBox(HWND)
+ nCurSel = Min(nCurSel, ubound(gTabPages))
+ ListBox_SetCurSel(hList1, nCurSel)
+ frmVDTabChild_SetTabChildTextboxes()
+ dim as HWND hEdit = GetDlgItem( HWND_frmVDTabChild, IDC_FRMVDTABCHILD_TXTDESCRIPTION)
+ Edit_SetSel( hEdit, 0, -1 )
+ SetFocus( hEdit )
+ end if
+
+ case IDC_FRMVDTABCHILD_CMDDELETE
+ if codeNotify = BN_CLICKED THEN
+ if nCurSel > -1 THEN
+ if MessageBox( HWND, L(366, "Are you sure you want to delete?"), L(276,"Confirm"), _
+ MB_YESNOCANCEL Or MB_ICONINFORMATION Or MB_DEFBUTTON1 ) = IDYES then
+ if ubound(gTabPages) = 0 THEN
+ erase gTabPages
+ nCurSel = -1
+ else
+ ' remove the item from the internal array
+ for i as long = nCurSel to ubound(gTabPages) - 1
+ gTabPages(i) = gTabPages(i+1)
+ NEXT
+ redim preserve gTabPages(ubound(gTabPages)-1)
+ END IF
+ ' reload the listbox
+ frmVDTabChild_LoadBuildListBox(HWND)
+ nCurSel = Min(nCurSel, ubound(gTabPages))
+ ListBox_SetCurSel(hList1, nCurSel)
+ frmVDTabChild_SetTabChildTextboxes()
+ SetFocus hList1
+ end if
+ END IF
+ end if
+
+ Case IDC_FRMVDTABCHILD_CMDOK
+ If codeNotify = BN_CLICKED Then
+ ' Copy the TabPages back into the PropValue
+ dim pProp as clsProperty ptr = GetActivePropertyPtr()
+ if pProp then
+ pProp->wszPropValue = ""
+ for i as long = 0 to ubound(gTabPages)
+ pProp->wszPropValue = pProp->wszPropValue & _
+ gTabPages(i).wszText & gTabFieldSep & _
+ gTabPages(i).wszImage & gTabFieldSep & _
+ gTabPages(i).wszTabPage & gTabFieldSep & _
+ gTabPages(i).IsActiveTab & gTabFieldSep & _
+ gTabPages(i).wszReserved1 & gTabFieldSep & _
+ gTabPages(i).wszReserved2 & gTabFieldSep & _
+ gTabPages(i).wszReserved3 & gTabFieldSep & _
+ gTabPages(i).wszReserved4 & gTabRecordSep
+ next
+ pProp->wszPropValue = trim(pProp->wszPropValue, gTabRecordSep)
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc then
+ pDoc->UserModified = true
+ dim pCtrl as clsControl ptr = pDoc->Controls.GetActiveControl
+ if pCtrl THEN
+ ' Recreate the control
+ ReCreateToolboxControl( pDoc, pCtrl )
+ end if
+ end if
+ end if
+
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ end if
+
+ Case IDC_FRMVDTABCHILD_CMDCANCEL
+ If codeNotify = BN_CLICKED Then
+ SendMessage( HWnd, WM_CLOSE, 0, 0 )
+ Exit Function
+ End If
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmVDTabChild
+' ========================================================================================
+private Function frmVDTabChild_OnClose( byval HWnd As HWnd ) As LRESULT
+ ' Enables parent window keeping parent's zorder
+ EnableAllModeless()
+ DestroyWindow( HWnd )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmVDTabChild
+' ========================================================================================
+private Function frmVDTabChild_OnDestroy( byval HWnd As HWnd) As LRESULT
+ PostQuitMessage(0)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmVDTabChild Window procedure
+' ========================================================================================
+private Function frmVDTabChild_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_CREATE, frmVDTabChild_OnCreate)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmVDTabChild_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmVDTabChild_OnDestroy)
+ HANDLE_MSG (HWnd, WM_COMMAND, frmVDTabChild_OnCommand)
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmVDTabChild_Show
+' ========================================================================================
+public Function frmVDTabChild_Show( ByVal hWndParent As HWnd, _
+ byref wszPropValue as wstring _
+ ) As LRESULT
+
+ DIM hBitmap AS HBITMAP
+ dim hCtrl as HWnd
+ dim wszImage as wstring * 100
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ Dim As HWnd hForm = _
+ pWindow->Create(hWndParent, L(394,"TabControl Configuration"), _
+ @frmVDTabChild_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION Or WS_SYSMENU Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_DLGMODALFRAME Or WS_EX_CONTROLPARENT Or WS_EX_LEFT )
+ pWindow->SetClientSize(408, 360)
+ pWindow->Center(pWindow->hWindow, hWndParent)
+
+ pWindow->AddControl("LISTBOX", , IDC_FRMVDTABCHILD_LIST1, "", 21, 14, 365, 84, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or LBS_NOTIFY Or LBS_NOINTEGRALHEIGHT, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMVDTABCHILD_CMDUP, "", 21, 102, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWUP", "IMAGE_ARROWUP16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ hCtrl = _
+ pWindow->AddControl("BITMAPBUTTON", , IDC_FRMVDTABCHILD_CMDDOWN, "", 48, 102, 24, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWDOWN", "IMAGE_ARROWDOWN16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(hCtrl, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+ pWindow->AddControl("BUTTON", , IDC_FRMVDTABCHILD_CMDADD, L(380, "Add"), 77, 102, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_FLAT Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMVDTABCHILD_CMDINSERT, L(281, "Insert"), 152, 102, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_FLAT Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMVDTABCHILD_CMDDELETE, L(282, "Delete"), 227, 102, 70, 24, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_FLAT Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("LABEL", , IDC_FRMVDTABCHILD_LABEL1, L(150,"Text") & ":", 20, 145, 218, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMVDTABCHILD_TXTDESCRIPTION, "", 20, 165, 365, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+
+ pWindow->AddControl("LABEL", , IDC_FRMVDTABCHILD_LABEL2, L(246,"Image") & ":", 20, 195, 218, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("TEXTBOX", , IDC_FRMVDTABCHILD_TXTIMAGE, "", 20, 215, 218, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("BUTTON", , IDC_FRMVDTABCHILD_CMDIMAGE, "...", 250, 214, 30, 22, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ pWindow->AddControl("LABEL", , IDC_FRMVDTABCHILD_LABEL2, L(395,"TabPage") & ":", 20, 245, 218, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("COMBOBOX", , IDC_FRMVDTABCHILD_COMBOTABPAGES, "", 20, 265, 218, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_TABSTOP Or CBS_DROPDOWNLIST or CBS_SORT, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_LTRREADING Or WS_EX_RIGHTSCROLLBAR)
+ pWindow->AddControl("CHECKBOX", , IDC_FRMVDTABCHILD_CHKISDEFAULT, L(280,"Set as default"), 250, 265, 240, 20, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_NOTIFY Or BS_AUTOCHECKBOX Or BS_LEFT Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+
+ pWindow->AddControl("BUTTON", , IDC_FRMVDTABCHILD_CMDOK, L(0,"OK"), 231, 320, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ pWindow->AddControl("BUTTON", , IDC_FRMVDTABCHILD_CMDCANCEL, L(1,"Cancel"), 312, 320, 74, 28, _
+ WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or BS_TEXT Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ HWND_FRMVDTABCHILD = hForm
+
+
+ ' Load the list of forms that have the FormChild = True
+ dim as HWND hCombo = GetDlgItem(hForm, IDC_FRMVDTABCHILD_COMBOTABPAGES)
+ dim as CWSTR wszFormName = "(" & L(396,"No Child Form Selected") & ")"
+ ComboBox_AddString( hCombo, wszFormName.sptr )
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ dim pCtrl as clsControl ptr
+ do until pDoc = 0
+ pCtrl = GetFormCtrlPtr(pDoc)
+ if pCtrl then
+ if GetControlProperty(pCtrl, "CHILDFORM") = "True" then
+ wszFormName = GetControlProperty(pCtrl, "NAME")
+ ComboBox_AddString( hCombo, wszFormName.sptr )
+ end if
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+
+
+ ' Copy all of the custom property values to the gTabPages array. We will work with
+ ' temporary copies until the user hits OK.
+ dim as HWND hList = GetDlgItem(hForm, IDC_FRMVDTABCHILD_LIST1)
+ frmVDTabChild_LoadTabPagesArray(wszPropValue)
+ frmVDTabChild_LoadBuildListBox(hForm)
+
+ ListBox_SetCurSel( hList, 0 )
+ frmVDTabChild_SetTabChildTextboxes
+ SetFocus hList
+
+ ' Process Windows messages(modal)
+ Function = pWindow->DoEvents(SW_SHOW)
+
+ ' Delete the CWindow class manually allocated memory
+ Delete pWindow
+
+ ' Reset the gTabPages global array
+ erase gTabPages
+
+End Function
+
+
+
+
+
diff --git a/src/mod302Upgrade.bi b/src/mod302Upgrade.bi
index 60a5ef99..30e2f849 100644
--- a/src/mod302Upgrade.bi
+++ b/src/mod302Upgrade.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/mod302Upgrade.bi.bak b/src/mod302Upgrade.bi.bak
new file mode 100644
index 00000000..60a5ef99
--- /dev/null
+++ b/src/mod302Upgrade.bi.bak
@@ -0,0 +1,21 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+' WinFBE Version 3.0.2+ requires that older version form file formats get upgraded
+' to the new json format and also separated out from the source code file. There
+' will now be two files: (1) *.frm for the json form definitions, and (2) *.inc/bas
+' for the actual form code.
+
+declare function FormUpgrade302Format( byval pDoc as clsDocument ptr ) as boolean
+
diff --git a/src/mod302Upgrade.inc b/src/mod302Upgrade.inc
index a48dca3a..998a7572 100644
--- a/src/mod302Upgrade.inc
+++ b/src/mod302Upgrade.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/mod302Upgrade.inc.bak b/src/mod302Upgrade.inc.bak
new file mode 100644
index 00000000..a48dca3a
--- /dev/null
+++ b/src/mod302Upgrade.inc.bak
@@ -0,0 +1,59 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+' WinFBE Version 3.0.2+ requires that older version form file formats get upgraded
+' to the new json format and also separated out from the source code file. There
+' will now be two files: (1) *.frm for the json form definitions, and (2) *.inc/bas
+' for the actual form code.
+
+#include once "mod302Upgrade.bi"
+
+' ========================================================================================
+' Upgrade pre-version 3.02 form files to new format
+' ========================================================================================
+public function FormUpgrade302Format( byval pDoc as clsDocument ptr ) as boolean
+
+ if pDoc = 0 then exit function
+
+ ' WinFBE Version 3.0.2+ requires that older version form file formats get upgraded
+ ' to the new json format and also separated out from the source code file. There
+ ' will now be two files: (1) *.frm for the json form definitions, and (2) *.inc/bas
+ ' for the actual form code.
+ if (ConvertWinFBEversion(pDoc->wszFormVersion) >= ConvertWinFBEversion("3.0.2")) orelse _
+ (ConvertWinFBEversion(pDoc->wszFormVersion) = 0) then 'b/c upgraded form files do not have version loaded yet
+ ' We are already using new form file format so simply exit
+ return false
+ end if
+
+ gApp.PreventActivateApp = true
+
+ ' Commence conversion to the new json file format
+ dim as CWSTR wszCodeFilename = pDoc->DiskFilename
+ dim as CWSTR wszFormFilename = wszCodeFilename & ".design"
+
+ pDoc->DesignerFilename = wszFormFilename
+ if pDoc->SaveFormJSONdata() = false then return false
+
+ ' The new design Form file has now been created so we can remove all code in the
+ ' existing code file.
+ pDoc->wszFormMetaData = ""
+ pDoc->wszFormCodeGen = ""
+ pDoc->SaveFile
+
+ gApp.PreventActivateApp = false
+
+ return true ' new format was created
+end function
+
+
diff --git a/src/modAutoInsert.bi b/src/modAutoInsert.bi
index a1da6839..cac7a62c 100644
--- a/src/modAutoInsert.bi
+++ b/src/modAutoInsert.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modAutoInsert.bi.bak b/src/modAutoInsert.bi.bak
new file mode 100644
index 00000000..a1da6839
--- /dev/null
+++ b/src/modAutoInsert.bi.bak
@@ -0,0 +1,35 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+enum
+ BLOCK_STATEMENT_IF
+ BLOCK_STATEMENT_FOR
+ BLOCK_STATEMENT_SELECT
+ BLOCK_STATEMENT_WHILE
+ BLOCK_STATEMENT_DO
+ BLOCK_STATEMENT_FUNCTION
+ BLOCK_STATEMENT_SUB
+ BLOCK_STATEMENT_PROPERTY
+ BLOCK_STATEMENT_OPERATOR
+ BLOCK_STATEMENT_TYPE
+ BLOCK_STATEMENT_WITH
+ BLOCK_STATEMENT_ENUM
+ BLOCK_STATEMENT_UNION
+ BLOCK_STATEMENT_CONSTRUCTOR
+ BLOCK_STATEMENT_DESTRUCTOR
+end enum
+
+declare function AttemptAutoInsert() as Long
+
diff --git a/src/modAutoInsert.inc b/src/modAutoInsert.inc
index 2cc275ae..91f99b44 100644
--- a/src/modAutoInsert.inc
+++ b/src/modAutoInsert.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modAutoInsert.inc.bak b/src/modAutoInsert.inc.bak
new file mode 100644
index 00000000..2cc275ae
--- /dev/null
+++ b/src/modAutoInsert.inc.bak
@@ -0,0 +1,499 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+''
+'' Attempt to insert the second half of a syntax construct. for example,
+'' The END FUNCTION, LOOP, NEXT, ... This is activated when ENTER is pressed
+'' in the code editor and gConfig. AutoComplete is TRUE.
+''
+
+#include once "modAutoInsert.bi"
+#include once "frmFunctions.bi"
+
+
+' ========================================================================================
+' Determine if end of the block statement exists.
+' ========================================================================================
+private function CanCompleteBlockStatement( byval pDoc as clsDocument ptr, _
+ byval idBlockType as long, _
+ byval nStartLine as long _
+ ) as boolean
+
+ If gConfig.AutoComplete = false Then return false
+
+ '// January 15, 2023. Default to return True always thereby bypassing the logic
+ '// of this function. Rather than "smartly" trying to determine if a matching end
+ '// keyword exists, we will simply honor the user's wishes and insert the completion
+ '// keywords.
+ return true
+
+
+ dim as long NumLines, nLenMatch
+ dim as string sStartMatch, sEndMatch, sLine
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+
+ ' Add a unique terminating delimiter to the phrase in order to make it
+ ' easier to match lines later that only contain the matching end phrase
+ ' and no following space character (ie. they exist alone on the line).
+ ' The algorithm needs to search for a matching end phrase but if it first
+ ' finds a matching start phrase for the block type
+ select case idBlockType
+ case BLOCK_STATEMENT_IF: sStartMatch = "IF ": sEndMatch = "END IF|"
+ case BLOCK_STATEMENT_FOR: sStartMatch = "FOR ": sEndMatch = "NEXT|"
+ case BLOCK_STATEMENT_SELECT: sStartMatch = "SELECT ": sEndMatch = "END SELECT|"
+ case BLOCK_STATEMENT_WHILE: sStartMatch = "WHILE ": sEndMatch = "WEND|"
+ case BLOCK_STATEMENT_DO: sStartMatch = "DO ": sEndMatch = "LOOP|"
+ case BLOCK_STATEMENT_FUNCTION: sStartMatch = "": sEndMatch = "END FUNCTION|"
+ case BLOCK_STATEMENT_SUB: sStartMatch = "": sEndMatch = "END SUB|"
+ case BLOCK_STATEMENT_PROPERTY: sStartMatch = "": sEndMatch = "END PROPERTY|"
+ case BLOCK_STATEMENT_OPERATOR: sStartMatch = "": sEndMatch = "END OPERATOR|"
+ case BLOCK_STATEMENT_TYPE: sStartMatch = "TYPE ": sEndMatch = "END TYPE|"
+ case BLOCK_STATEMENT_WITH: sStartMatch = "WITH ": sEndMatch = "END WITH|"
+ case BLOCK_STATEMENT_ENUM: sStartMatch = "ENUM ": sEndMatch = "END ENUM|"
+ case BLOCK_STATEMENT_UNION: sStartMatch = "UNION ": sEndMatch = "END UNION|"
+ case BLOCK_STATEMENT_CONSTRUCTOR: sStartMatch = "": sEndMatch = "END CONSTRUCTOR|"
+ case BLOCK_STATEMENT_DESTRUCTOR: sStartMatch = "": sEndMatch = "END DESTRUCTOR|"
+ end select
+
+ NumLines = SciExec( hEdit, SCI_GETLINECOUNT, 0, 0)
+ nStartLine = nStartLine + 1
+
+ for i as long = nStartLine to NumLines - 1
+ ' Does this line start with the matching phrase we are looking for?
+ sLine = ucase( ltrim(pDoc->GetLine(i), any chr(32,9)) )
+
+ nLenMatch = len(sStartMatch)
+ if nLenMatch then
+ if sStartMatch = mid(sLine, 1, nLenMatch) then
+ return true ' a start block was found before a matching end was found.
+ END IF
+ end if
+
+ nLenMatch = len(sEndMatch)
+ if nLenMatch then
+ if sEndMatch = mid(sLine, 1, nLenMatch-1) & "|" then
+ return false ' a matching end to the block statement already exists
+ END IF
+ end if
+
+ ' Stop search if we find the start of another block statement structure and
+ ' allow the insert.
+ if (idBlockType <> BLOCK_STATEMENT_FUNCTION) and (idBlockType <> BLOCK_STATEMENT_SUB) then
+ if left(sLine, 3) = "IF " then return true
+ if left(sLine, 4) = "FOR " then return true
+ if left(sLine, 3) = "DO " then return true
+ if left(sLine, 7) = "SELECT " then return true
+ if left(sLine, 6) = "WHILE " then return true
+ end if
+ if left(sLine, 9) = "FUNCTION " then
+ if instr(10, sLine, "=") = 0 then return true
+ end if
+ if left(sLine, 4) = "SUB " then return true
+ if left(sLine, 17) = "PRIVATE FUNCTION " then return true
+ if left(sLine, 16) = "PUBLIC FUNCTION " then return true
+ if left(sLine, 12) = "PRIVATE SUB " then return true
+ if left(sLine, 11) = "PUBLIC SUB " then return true
+ if left(sLine, 9) = "PROPERTY " then return true
+ if left(sLine, 9) = "OPERATOR " then return true
+ if left(sLine, 6) = "UNION " then return true
+ if left(sLine, 5) = "ENUM " then return true
+ next
+
+ ' Default that we can allow the insert
+ function = true
+end function
+
+
+' ========================================================================================
+' Return the number of tabs that can fill a string of incoming size
+' ========================================================================================
+function NumTabsFromSpaces( byval numSpaces as long ) as long
+ if gConfig.TabIndentSpaces then return numSpaces
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 Then return 0
+ dim as long IndentSize = SciExec(pDoc->hWndActiveScintilla, SCI_GETINDENT, 0, 0)
+ if IndentSize = 0 then return 0
+ return (numSpaces / IndentSize)
+end function
+
+
+' ========================================================================================
+' Return a fill string with all spaces or TABs depending on the config setting
+' ========================================================================================
+function FillString( byval sSpaces as string ) as string
+ ' If convert tabs to spaces then nothing needs to done because
+ ' the incoming sSpaces is alreayd in the correct format.
+ if gConfig.TabIndentSpaces then return sSpaces
+ ' Try to convert the incoming sSpaces to TABs.
+ dim as long numTabs = NumTabsFromSpaces( len(sSpaces) )
+ return string(numTabs, chr(9))
+end function
+
+
+' ========================================================================================
+' Attempt to autocomplete a statement block
+' ========================================================================================
+public function AttemptAutoInsert() as Long
+ ' Attempts to Autocomplete a FOR/DO/SELECT, etc block. This function also deals
+ ' with AutoIndentation so need to handle both separately depending on the user
+ ' chosen settings.
+
+ Dim as HWND hEdit
+ Dim as long nLine, nCurLine, curPos, LineLen, nFoldLevel, nSpaces, IndentSize, i
+ Dim as string strFill, strTemp, strCurLine, strPrevLine, strPrevLineOrig, strRightText
+
+
+ Dim pDoc As clsDocument Ptr
+
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 Then exit function
+
+ hEdit = pDoc->hWndActiveScintilla
+
+ ' Current and previous lines
+ curPos = SciExec(hEdit, SCI_GETCURRENTPOS, 0, 0)
+ nLine = pDoc->GetCurrentLineNumber
+ strCurLine = pDoc->GetLine(nLine)
+ strPrevLine = pDoc->GetLine(nLine-1)
+ if len(strPrevLine) = 0 then exit function
+
+ ' Get the styling of the current line to determine if we are in a
+ ' multiline or single line comment block then abort the autoinsert.
+ select case SciExec(hEdit, SCI_GETSTYLEAT, curPos, 0)
+ case SCE_B_MULTILINECOMMENT
+ exit function
+ case SCE_B_COMMENT
+ ' Allow to continue for single line comments because we want the ENTER
+ ' key to position our cursor under the preceeding ' mark.
+ end select
+
+
+ ' Save a non-uppercased version of the strPrevLine for For/Next insert
+ strPrevLineOrig = strPrevLine
+
+ ' Get the tab width and indent size (these are actually both the same
+ ' size as set in the pDoc->ApplyProperties code).
+ 'TabSize = SciExec(hEdit, SCI_GETTABWIDTH, 0, 0) '<-- not needed
+ IndentSize = SciExec(hEdit, SCI_GETINDENT, 0, 0)
+
+ ' Calculate the number of spaces to fill on the left
+ For i = 1 To Len(strPrevLine)
+ If Mid(strPrevLine, i, 1) <> " " Then
+ If Mid(strPrevLine, i, 1) = Chr(9) Then
+ nSpaces = nSpaces + IndentSize
+ Else
+ Exit For
+ End If
+ Else
+ nSpaces = nSpaces + 1
+ End If
+ Next
+ strPrevLine = Trim(Ucase(strPrevLine), Any Chr(32, 9))
+
+ If gConfig.AutoIndentation = 0 Then
+ nSpaces = 0: IndentSize = 0
+ END IF
+
+
+ ''''''''''
+ ' IF/THEN
+ ' Before autoindenting an IF statement make sure that this
+ ' is in fact a multiline IF statement.
+ If (Left(strPrevLine, 3) = "IF " And Right(strPrevLine, 5) = " THEN") then
+ ' Remove the current line because we will add it again below
+ ' once we have wrapped it in an END IF. It will include any chunk of
+ ' text that was after the THEN in a single line IF/THEN
+ SciExec(hEdit, SCI_LINEDELETE, 0, 0)
+ strFill = FillString(Space(nSpaces + IndentSize)) & ltrim(strCurline, any chr(32,9)) & vbcrlf
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_IF, nLine) then
+ strFill = strFill & FillString(SPACE(nSpaces)) & "end if" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+
+ ''''''''''
+ ' ELSE / ELSEIF
+ ' Search backwards in the most recent IF/THEN line and use the
+ ' indentation of that line for the ELSE or ELSEIF statement.
+ If gConfig.AutoIndentation Then
+ If (left(strPrevLine, 4) = "ELSE") or (left(strPrevLine, 7) = "ELSEIF ") then
+ nCurLine = pDoc->GetCurrentLineNumber
+ for i = nCurLine to 0 step -1
+ strTemp = AfxStrReplace(pDoc->GetLine(i), chr(9), space(IndentSize))
+ if left(ltrim(ucase(strTemp)), 3) = "IF " then
+ ' Reposition the ELSE/ELSEIF line to line up with the IF line
+ nSpaces = instr(ucase(strTemp), "IF ") - 1
+ strPrevLine = FillString(space(nSpaces)) & Trim(pDoc->GetLine(nLine-1), Any Chr(32, 9)) ' need it to be original case
+ pDoc->SetLine(nLine-1, strPrevLine)
+ strFill = FillString(Space(nSpaces + IndentSize)) & strCurLine
+ pDoc->SetLine(nLine, strFill)
+ ' Add the current editing position
+ curPos = SciExec(hEdit, SCI_POSITIONFROMLINE, nLine, 0) + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+ next
+ end if
+ end if
+
+
+ '''''''''''''
+ ' SELECT CASE
+ If Left(strPrevLine, 12) = "SELECT CASE " then
+ SciExec(hEdit, SCI_LINEDELETE, 0, 0)
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_SELECT, nLine) then
+ strFill = strFill & "case " & strCurLine & vbcrlf & FillString(SPACE(nSpaces)) & "end select" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize) + 5
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ ''''''''''
+ ' CASE
+ ' Search backwards in the most recent CASE line and use the
+ ' indentation of that line for the CASE or CASE ELSE statement.
+ If gConfig.AutoIndentation Then
+ If left(strPrevLine, 5) = "CASE " then ' this will catch CASE ELSE as well
+ strPrevLine = AfxStrReplace( pDoc->GetLine(nLine-1), chr(9), space(IndentSize))
+ nSpaces = instr(ucase(strPrevLine), "CASE ") - 1
+ strPrevLine = Trim(strPrevLine) ' need it to be original case
+ nCurLine = pDoc->GetCurrentLineNumber - 2 ' skip the current CASE and look for previous
+ for i = nCurLine to 0 step -1
+ strTemp = AfxStrReplace( pDoc->GetLine(i), chr(9), space(IndentSize) )
+ dim as string strTempTrim = ltrim(ucase(strTemp))
+ if left(strTempTrim, 12) = "SELECT CASE " then
+ exit for ' no need to keep searching
+ elseif left(strTempTrim, 5) = "CASE " then
+ nSpaces = instr(ucase(strTemp), "CASE ") - 1
+ exit for
+ end if
+ next
+ ' Reposition the CASE line to line up with the previous CASE line
+ strPrevLine = FillString(space(nSpaces)) & strPrevLine
+ pDoc->SetLine(nLine-1, strPrevLine)
+ strFill = FillString(Space(nSpaces + IndentSize)) & strCurLine
+ pDoc->SetLine(nLine, strFill)
+ ' Add the current editing position
+ curPos = SciExec(hEdit, SCI_POSITIONFROMLINE, nLine, 0) + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+ end if
+
+
+ '''''''''''''
+ ' FOR/NEXT
+ If Left(strPrevLine, 4) = "FOR " then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ dim as CWSTR wszLoopVar
+ if gConfig.ForNextVariable then
+ ' Determine the loop variable and append it to the "next" statement
+ strPrevLine = ltrim(AfxStrShrink(strPrevLineOrig))
+ wszLoopVar = " " & AfxStrParseAny(strPrevLine, 2, " =")
+ end if
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_FOR, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "next" & wszLoopVar & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+
+ '''''''''''''
+ ' WHILE/WEND
+ If (Left(strPrevLine, 6) = "WHILE ") or (strPrevLine = "WHILE") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_WHILE, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "wend" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize )
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+
+ '''''''''''''
+ ' DO/LOOP
+ If (Left(strPrevLine, 3) = "DO ") or (strPrevLine = "DO") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_DO, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "loop" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ '''''''''''''
+ ' FUNCTION/END FUNCTION
+ If (Left(strPrevLine, 9) = "FUNCTION ") orelse _
+ (Left(strPrevLine, 17) = "PRIVATE FUNCTION ") orelse _
+ (Left(strPrevLine, 16) = "PUBLIC FUNCTION ") then
+ ' Determine if this is a FUNCTION = statement rather than a true function.
+ strTemp = strPrevLine
+ i = instr(strTemp, "(")
+ if i then strTemp = left(strTemp, i-1)
+ if instr(strTemp, "=") then exit function
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_FUNCTION, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end function" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ frmFunctions_ReparseFiles()
+ exit function
+ end if
+
+ '''''''''''''
+ ' SUB/END SUB
+ If (Left(strPrevLine, 4) = "SUB ") orelse _
+ (Left(strPrevLine, 12) = "PRIVATE SUB ") orelse _
+ (Left(strPrevLine, 11) = "PUBLIC SUB") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_SUB, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end sub" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ frmFunctions_ReparseFiles()
+ exit function
+ end if
+
+ '''''''''''''
+ ' PROPERTY/END PROPERTY
+ If (Left(strPrevLine, 9) = "PROPERTY ") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_PROPERTY, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end property" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ '''''''''''''
+ ' OPERATOR/END OPERATOR
+ If (Left(strPrevLine, 9) = "OPERATOR ") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_OPERATOR, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end operator" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ '''''''''''''
+ ' CONSTRUCTOR/END CONSTRUCTOR
+ If (Left(strPrevLine, 12) = "CONSTRUCTOR ") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_CONSTRUCTOR, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end constructor" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ '''''''''''''
+ ' DESTRUCTOR/END DESTRUCTOR
+ If (Left(strPrevLine, 11) = "DESTRUCTOR ") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_DESTRUCTOR, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end destructor" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ '''''''''''''
+ ' TYPE/END TYPE
+ If (Left(strPrevLine, 5) = "TYPE ") then
+ ' Determine if this is a TYPE = statement rather than a true TYPE structure
+ if instr(ucase(strPrevLine), " AS ") then exit function
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_TYPE, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end type" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ '''''''''''''
+ ' WITH/END WITH
+ If (Left(strPrevLine, 4) = "WITH") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_WITH, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end with" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ '''''''''''''
+ ' ENUM/END ENUM
+ If (Left(strPrevLine, 4) = "ENUM") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_ENUM, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end enum" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ '''''''''''''
+ ' UNION/END UNION
+ If (Left(strPrevLine, 6) = "UNION ") then
+ strFill = FillString(Space(nSpaces + IndentSize))
+ if CanCompleteBlockStatement(pDoc, BLOCK_STATEMENT_UNION, nLine) then
+ strFill = strFill & vbcrlf & FillString(SPACE(nSpaces)) & "end union" & vbcrlf
+ end if
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+ curPos = curPos + NumTabsFromSpaces(nSpaces + IndentSize)
+ SciExec(hEdit, SCI_SETSEL, curPos, curPos)
+ exit function
+ end if
+
+ '''''''''''''
+ ' Add the same spaces on the left that the line above
+ strFill = FillString(Space(nSpaces))
+ SciExec(hEdit, SCI_ADDTEXT, Len(strFill), Strptr(strFill))
+
+ function = 0
+end function
+
diff --git a/src/modCBColor.bi b/src/modCBColor.bi
index 9773dbfa..0a28ad10 100644
--- a/src/modCBColor.bi
+++ b/src/modCBColor.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modCBColor.bi.bak b/src/modCBColor.bi.bak
new file mode 100644
index 00000000..9773dbfa
--- /dev/null
+++ b/src/modCBColor.bi.bak
@@ -0,0 +1,24 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#define MODCBCOLOR_USERSELECTED 41
+
+declare Function CreateCBColorList( ByVal HWnd As HWnd, _
+ ByVal CtrlId As Long, _
+ ByVal nLeft As Long, _
+ ByVal nTop As Long, _
+ ByVal nWidth As Long, _
+ ByVal nHeight As Long _
+ ) As HWnd
diff --git a/src/modCBColor.inc b/src/modCBColor.inc
index df3d35fd..7bd01f2a 100644
--- a/src/modCBColor.inc
+++ b/src/modCBColor.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modCBColor.inc.bak b/src/modCBColor.inc.bak
new file mode 100644
index 00000000..df3d35fd
--- /dev/null
+++ b/src/modCBColor.inc.bak
@@ -0,0 +1,219 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+''
+'' Owner draw combo box for color selection
+'' Based on code by José Roca 2011 and Börje Hagsten, January 2001
+
+#include once "modCBColor.bi"
+
+
+' ========================================================================================
+' GetColorInfo
+' ========================================================================================
+private function modCBColor_GetColorInfo( ByVal nIndex As Long, _
+ ByVal wColorName As WString Ptr, _
+ ByRef nColorValue As COLORREF _
+ ) as long
+
+ Select Case nIndex
+ Case 0: *wColorName = "Black": nColorValue = BGR(000,000,000)
+ Case 1: *wColorName = "Light Black": nColorValue = BGR(030,030,030)
+ Case 2: *wColorName = "Charcoal Black": nColorValue = BGR(050,050,050)
+ Case 3: *wColorName = "Evening Black": nColorValue = BGR(090,090,090)
+ Case 4: *wColorName = "Gray": nColorValue = BGR(128,128,128)
+ Case 5: *wColorName = "Light Gray": nColorValue = BGR(204,204,204)
+ Case 6: *wColorName = "Pale Gray": nColorValue = BGR(237,236,235)
+ Case 7: *wColorName = "White": nColorValue = BGR(255,255,255)
+ Case 8: *wColorName = "Dark Green": nColorValue = BGR(051,102,000)
+ Case 9: *wColorName = "Green": nColorValue = BGR(000,128,000)
+ Case 10: *wColorName = "Moss Green": nColorValue = BGR(095,125,049)
+ Case 11: *wColorName = "Teal": nColorValue = BGR(000,128,128)
+ Case 12: *wColorName = "Signal Green": nColorValue = BGR(000,255,000)
+ Case 13: *wColorName = "Military Green": nColorValue = BGR(237,255,102)
+ Case 14: *wColorName = "Lime": nColorValue = BGR(237,255,127)
+ Case 15: *wColorName = "Mint": nColorValue = BGR(238,255,185)
+ Case 16: *wColorName = "Pale Green": nColorValue = BGR(244,255,223)
+ Case 17: *wColorName = "Brown": nColorValue = BGR(128,064,000)
+ Case 18: *wColorName = "Dark Red": nColorValue = BGR(153,000,000)
+ Case 19: *wColorName = "Red": nColorValue = BGR(196,000,000)
+ Case 20: *wColorName = "Signal Red": nColorValue = BGR(255,000,000)
+ Case 21: *wColorName = "Orange": nColorValue = BGR(255,102,000)
+ Case 22: *wColorName = "Orange Brown": nColorValue = BGR(195,137,080)
+ Case 23: *wColorName = "Light Orange": nColorValue = BGR(255,204,000)
+ Case 24: *wColorName = "Yellow": nColorValue = BGR(255,255,000)
+ Case 25: *wColorName = "Light Yellow": nColorValue = BGR(255,255,136)
+ Case 26: *wColorName = "Pale Yellow": nColorValue = BGR(255,255,223)
+ Case 27: *wColorName = "Deep Purple": nColorValue = BGR(128,000,128)
+ Case 28: *wColorName = "Dark Purple": nColorValue = BGR(173,000,173)
+ Case 29: *wColorName = "Magenta": nColorValue = BGR(128,000,128)
+ Case 30: *wColorName = "Purple": nColorValue = BGR(210,000,210)
+ Case 31: *wColorName = "Pink": nColorValue = BGR(255,000,178)
+ Case 32: *wColorName = "Light Purple": nColorValue = BGR(165,134,181)
+ Case 33: *wColorName = "Pale Purple": nColorValue = BGR(250,235,255)
+ Case 34: *wColorName = "Dark Blue": nColorValue = BGR(000,000,128)
+ Case 35: *wColorName = "Blue": nColorValue = BGR(000,000,255)
+ Case 36: *wColorName = "Lavender": nColorValue = BGR(101,158,254)
+ Case 37: *wColorName = "Light Blue": nColorValue = BGR(038,079,120)
+ Case 38: *wColorName = "Powder Blue": nColorValue = BGR(148,202,240)
+ Case 39: *wColorName = "Bright Cyan": nColorValue = BGR(000,255,255)
+ Case 40: *wColorName = "Pale Blue": nColorValue = BGR(230,245,255)
+ Case 41: *wColorName = L(341, "User selected") & "...": nColorValue = BGR(255,255,255)
+
+ End Select
+
+ function = 0
+End function
+
+
+' ========================================================================================
+' Subclassed Combobox procedure
+' ========================================================================================
+private Function modCBColor_CBProc( ByVal HWnd As HWnd, _
+ ByVal wMsg As UInt, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Dim As LONG_PTR OldWndProc = GetWindowLongPtr( HWnd, GWLP_USERDATA )
+
+ Select Case wMsg
+
+ case MSG_USER_SETCOLORCUSTOM
+ SendMessage(hwnd, CB_SETITEMDATA, MODCBCOLOR_USERSELECTED, Cast(LPARAM, wParam))
+
+
+ Case WM_DESTROY
+ ' Unsubclass the combo box
+ If OldWndProc Then SetWindowLongPtr( HWnd, GWLP_WNDPROC, Cast(LONG_PTR, OldWndProc) )
+ Exit Function
+
+ Case WM_DRAWITEM
+ Dim hBrush As HBRUSH
+ Dim lpdis As DRAWITEMSTRUCT Ptr
+ Dim rc As Rect
+ Dim wColorName As WString * 80
+ Dim nColorValue As COLORREF
+
+ lpdis = Cast(DRAWITEMSTRUCT Ptr, lParam)
+ If lpdis->itemID = &HFFFFFFFF Then Exit Function
+
+ modCBColor_GetColorInfo lpdis->itemID, @wColorName, nColorValue
+ ' Actually, get the colorvalue from the item of the row
+ ' being drawn because the "user selected" value can change.
+ nColorValue = lpdis->itemData
+
+ Select Case lpdis->itemAction
+ Case ODA_DRAWENTIRE, ODA_SELECT
+ Dim pWindow As CWindow Ptr = AfxCWindowOwnerPtr(HWnd)
+ ' Clear background
+ FillRect( lpdis->hDC, @lpdis->rcItem, GetSysColorBrush(COLOR_WINDOW))
+ ' Set the font
+ SelectFont( lpdis->hDC, pWindow->Font)
+ ' Set text background
+ SetBkColor( lpdis->hDC, GetSysColor(COLOR_WINDOW))
+ ' Set text color
+ SetTextColor( lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT))
+ rc = lpdis->rcItem
+ rc.Left = pWindow->ScaleX(28)
+ DrawText( lpdis->hDC, @wColorName, Len(wColorName), @rc, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER)
+ ' Selected item
+ If (lpdis->itemState And ODS_SELECTED) Then ' // If selected
+ If (lpdis->itemState And &H1000) = 0 Then ' // If not ODS_COMBOBOXEDIT (= &H1000)
+ rc.Left = pWindow->ScaleX(26)
+ rc.Right = lpdis->rcItem.Right
+ rc.Top = lpdis->rcItem.Top
+ rc.Bottom = lpdis->rcItem.Bottom
+ ' Invert area around text only
+ InvertRect( lpdis->hDC, @rc)
+ End If
+ 'and draw a focus rectangle around all
+ DrawFocusRect( lpdis->hDC, @lpdis->rcItem)
+ End If
+
+ ' color rectangle (using RoundRect for nicer looks..
+ If (lpdis->itemState And &H1000) Then ' // If ODS_COMBOBOXEDIT (= &H1000)
+ ' Set coordinates
+ rc.Left = pWindow->ScaleX(4)
+ rc.Right = pWindow->ScaleX(24)
+ Else
+ ' A tiny bit to the left in list
+ rc.Left = pWindow->ScaleX(3)
+ rc.Right = pWindow->ScaleX(23)
+ End If
+ rc.Top = lpdis->rcItem.Top + pWindow->ScaleY(2)
+ rc.Bottom = lpdis->rcItem.Bottom - pWindow->ScaleY(2)
+ ' Create brush with proper color
+ hBrush = CreateSolidBrush(nColorValue)
+ ' Select brush into device context
+ hBrush = SelectObject( Cast(HDC, lpdis->hDC), hBrush)
+ ' Draw
+ RoundRect( lpdis->hDC, rc.Left, rc.Top, rc.Right, rc.Bottom, pWindow->ScaleX(3), pWindow->ScaleY(3))
+ ' Select old brush and delete the new one
+ DeleteObject SelectObject(lpdis->hDC, hBrush)
+
+ End Select
+ Exit Function
+
+ End Select
+
+ ' Pass on for processing to OldWndProc
+ If OldWndProc Then
+ Function = CallWindowProc( Cast(WNDPROC, OldWndProc), HWnd, wMsg, wParam, lParam)
+ End If
+
+End Function
+
+
+' ========================================================================================
+' CreateCBColorList
+' ========================================================================================
+public Function CreateCBColorList( ByVal HWnd As HWnd, _
+ ByVal CtrlId As Long, _
+ ByVal nLeft As Long, _
+ ByVal nTop As Long, _
+ ByVal nWidth As Long, _
+ ByVal nHeight As Long _
+ ) As HWnd
+
+ Dim i As Long
+ Dim hCombo As HWnd
+ Dim idx As Long
+ Dim wColorName As WString * 80
+ Dim nColorValue As COLORREF
+ Dim OldWndProc As LONG_PTR
+ Dim hInst As HINSTANCE = Cast(HINSTANCE, GetWindowLongPtr(HWnd, GWLP_HINSTANCE))
+
+ hCombo = CreateWindowEx( WS_EX_CLIENTEDGE, "COMBOBOX", ByVal 0, WS_VISIBLE Or _
+ WS_CHILD Or WS_VISIBLE Or CBS_OWNERDRAWFIXED Or CBS_HASSTRINGS Or _
+ CBS_DROPDOWNLIST Or WS_TABSTOP Or CBS_DISABLENOSCROLL Or WS_VSCROLL, _
+ nLeft, nTop, nWidth, nHeight, _
+ HWnd, Cast(HMENU, Cast(LONG_PTR, CtrlId)), hInst, Cast(LPVOID, 0))
+ If hCombo = 0 Then Exit Function
+
+ ' Subclass the combo and initialize some control specific data
+ OldWndProc = SetWindowLongPtr( hCombo, GWLP_WNDPROC, Cast(LONG_PTR, @modCBColor_CBProc) )
+ SetWindowLongPtr( hCombo, GWLP_USERDATA, OldWndProc )
+
+ ' Add items to the combo box
+ For i = 0 To MODCBCOLOR_USERSELECTED
+ modCBColor_GetColorInfo i, @wColorName, nColorValue
+ idx = SendMessage(hCombo, CB_ADDSTRING, 0, Cast(LPARAM, @wColorName))
+ SendMessage(hCombo, CB_SETITEMDATA, idx, Cast(LPARAM, nColorValue))
+ Next
+
+ Function = hCombo
+
+End Function
+
+
diff --git a/src/modCodetips.bi b/src/modCodetips.bi
index 9be36d8d..bb25dd4a 100644
--- a/src/modCodetips.bi
+++ b/src/modCodetips.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modCodetips.bi.bak b/src/modCodetips.bi.bak
new file mode 100644
index 00000000..9be36d8d
--- /dev/null
+++ b/src/modCodetips.bi.bak
@@ -0,0 +1,25 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+' The type of autocomplete popup that is active. This is necessary
+' because the autocomplete popup list is rebuilt every time a new
+' character is entered.
+enum
+ AUTOCOMPLETE_NONE = 0
+ AUTOCOMPLETE_DIM_AS
+ AUTOCOMPLETE_TYPE
+end enum
+
+declare function DereferenceLine( byval pDoc as clsDocument ptr, byval sTrigger as String, byval nPosition as long ) as DB2_DATA ptr
diff --git a/src/modCodetips.inc b/src/modCodetips.inc
index dd1af6eb..94029438 100644
--- a/src/modCodetips.inc
+++ b/src/modCodetips.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modCodetips.inc.bak b/src/modCodetips.inc.bak
new file mode 100644
index 00000000..dd1af6eb
--- /dev/null
+++ b/src/modCodetips.inc.bak
@@ -0,0 +1,622 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modCodetips.bi"
+#include once "clsDocument.bi"
+
+
+' ========================================================================================
+' Format the codetip prior to showing it
+' ========================================================================================
+function FormatCodetip( byval strCodeTip as string ) as STRING
+ dim as long p
+
+ ' remove multiple duplicate spaces
+ strCodeTip = AfxStrReplace(strCodeTip, " ", " ")
+
+ ' If this is only a small CodeTip then don't bother trying
+ ' to format it into multiple lines.
+ if len(strCodeTip) < 75 THEN return strCodeTip
+
+ IF INSTR(strCodeTip, "( ") THEN
+ strCodeTip = AfxStrReplace(strCodeTip, "( ", "( ")
+ ELSEIF INSTR(strCodeTip, "(") THEN
+ strCodeTip = AfxStrReplace(strCodeTip, "(", "( ")
+ END IF
+ p = INSTR(strCodeTip, "(")
+ IF p THEN
+ IF MID(strCodeTip, p + 1, 1) <> ")" AND MID(strCodeTip, p + 1, 2) <> " )" THEN
+ strCodeTip = AfxStrReplace(strCodeTip, "(", "( _" & vblf)
+ IF INSTR(strCodeTip, " )") THEN
+ strCodeTip = AfxStrReplace(strCodeTip, ")", "_" & vblf & ")")
+ ELSEIF INSTR(strCodeTip, ")") THEN
+ strCodeTip = AfxStrReplace(strCodeTip, ")", " _" & vblf & ")")
+ END IF
+ END IF
+ END IF
+ strCodeTip = AfxStrReplace(strCodeTip, ", ", ",")
+ strCodeTip = AfxStrReplace(strCodeTip, " ,", ",")
+ strCodeTip = AfxStrReplace(strCodeTip, ",", ", _" & vblf & " ")
+
+ FUNCTION = strCodeTip
+end function
+
+
+' ========================================================================================
+' Change everything between quotes to # symbols
+' ========================================================================================
+function MaskStringCharacters( byval st as string) as string
+ ' Iterate the line and change everything between quotes to # symbols. This
+ ' ensures that we correctly deal with strings that have embedded single
+ ' quote characters.
+ dim as long i
+ dim as Boolean bInString = false
+ for i = 0 to len(st) - 1
+ if st[i] = 34 THEN bInString = not(bInString)
+ if bInString THEN
+ if st[i] <> 34 THEN st[i] = 35 ' # symbol
+ END IF
+ NEXT
+ function = st
+end function
+
+
+' ========================================================================================
+' Removes a single line comment.
+' ========================================================================================
+function RemoveComments( byval st as string) as string
+ function = AfxStrExtract( 1, st, "'")
+end function
+
+' ========================================================================================
+' Determine what variable relates to the "With" statement
+' ========================================================================================
+function DetermineWithVariable( byval pDoc as clsDocument ptr) as string
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ dim as long nCurLine = pDoc->GetCurrentLineNumber - 1
+ dim as string sLine, sWithVariable
+
+ for i as long = nCurLine to 0 step -1
+ sLine = ltrim(pDoc->GetLine(i))
+ ' Remove double spaces and replace TABs with single space
+ sLine = AfxStrShrink(sLine, chr(32,9))
+ if left(ucase(sLine), 5) = "WITH " then
+ sWithVariable = AfxStrParse(sLine, 2, " ")
+ exit for
+ end if
+ next
+
+ function = sWithVariable
+end function
+
+
+
+' ========================================================================================
+' Take the current line and determine what variable is being referenced.
+' Dereferences expressions like: g.MyFunction, g.ot.rc, g->MyFunction
+' Used for determining what popup autocomplete list or codetip to display.
+' ========================================================================================
+function DereferenceLine( _
+ byval pDoc as clsDocument ptr, _
+ byval sTrigger as String, _
+ byval nPosition as long _
+ ) as DB2_DATA ptr
+
+ if pDoc = 0 then exit function
+
+ dim pData as DB2_DATA ptr
+ dim pDataTYPE as DB2_DATA ptr
+ dim pLastData as DB2_DATA ptr
+
+ dim as string sCurrentFunction, sTypeName
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ dim as long curPos = nPosition
+ dim as long nCol = SciExec(hEdit, SCI_GETCOLUMN, curPos, 0)
+ dim as string sLine = trim(left(pDoc->GetLine(pDoc->GetCurrentLineNumber), nCol+1), any chr(32,9))
+
+ ' Comment out any comment line so the popup isn't activated when in a comment.
+ sLine = MaskStringCharacters(sLine)
+ sLine = RemoveComments(sLine)
+
+ ' Test to ensure that the incoming sTrigger character still exists after
+ ' the commenting of the line. If it does then we know that the line
+ ' is good and we can proceed to dereference elements on the line.
+ ' The identifer that triggers an autocomplete list for a TYPE variable
+ ' is either a dot "." or a pointer dereference "->"
+ if right(sLine, len(sTrigger)) <> sTrigger then exit function
+ sLine = rtrim(sLine, sTrigger)
+
+
+ ' Proceed to parse the line. Find the beginning of the line in order to
+ ' isolate the expression to dereference. The expression might contain an
+ ' array reference so that would have to be removed, however the "(" can
+ ' also signify the start position of the expression. For example:
+ ' st = myFunction(myvar(3).myvalue)
+ ' Simply reverse searching for the "(" would fail because the array "()"
+ ' also needs to be taken into account. Therefore, search in reverse and
+ ' take note of when the ")" is encountered in order to then match it with
+ ' an "(".
+ ' Need to alo handle situations where there are multiple () array references
+ ' in the expression. For example: ListView1.Item(10).rc(5)
+ dim as long nStart, nEnd
+ do
+ do
+ nEnd = InStrRev(sLine, ")", -1)
+ if nEnd = 0 then exit do
+ nStart = InStrRev(sLine, "(", nEnd)
+ if nStart = 0 then exit do
+ ' Remove any array parenthesis.
+ sLine = left(sLine, nStart-1) & mid(sLine, nEnd+1)
+ LOOP
+ if (nStart = 0) or (nEnd = 0) then exit do
+ loop
+
+ ' All of the array parenthesis should now be removed so now we can simply
+ ' search for the start of the line.
+ dim as long i = InStrRev(sLine, any " (*[&@", -1)
+ if i then sLine = mid(sLine, i+1)
+
+ ' Need to check if this line is part of a WITH / END WITH block.
+ if (len(sLine) = 0) or (left(sLine, 1) = ".") then
+ sLine = DetermineWithVariable(pDoc) & sLine
+ END IF
+
+ ' Make it easier to parse by converting line to uppercase
+ sLine = ucase(sLine)
+
+ ' Convert all "->" pointer references to "." dots to make parsing easier
+ sLine = AfxStrReplace(sLine, "->", ".")
+
+ ' Determine what sub/function (if any) that we are in. This function will
+ ' retrieve the current standalone function, or the fully qualified name of
+ ' a class/type function.
+ ' eg. clsType.MyFunctionName ' inside a class/type function
+ ' eg. MyFunctionName ' standalone function
+ pDoc->GetCurrentFunctionName( sCurrentFunction, 0 )
+
+ dim as long numParts = AfxStrParseCount(sLine, ".")
+ dim parts(1 to numParts) as string
+ for i as long = 1 to numParts
+ parts(i) = AfxStrParse(sLine, i, ".")
+ next
+
+ dim as string sParent = sCurrentFunction
+ dim as string sSearch
+ dim as string sLookFor
+ dim as long curPart = 1
+
+ do until curPart > numParts
+ sLookFor = parts(curPart)
+
+ if pLastData then
+ sParent = pLastData->VariableType
+ end if
+
+ '' ATTEMPT TO MATCH LOCAL VARIABLE WITHIN CURRENT FUNCTION
+ pData = gdb2.dbFindVariable( sParent, sLookFor )
+ if pData then
+ pLastData = pData
+ else
+ '' ATTEMPT TO MATCH GLOBAL VARIABLE
+ pData = gdb2.dbFindVariable( "", sLookfor )
+ if pData then
+ pLastData = pData
+ end if
+ end if
+
+ '' ATTEMPT TO MATCH FUNCTION NAME
+ if pData = 0 then
+ if len(sParent) then
+ sSearch = sParent & "." & sLookFor
+ pData = gdb2.dbFindFunctionTYPE( sParent, sSearch )
+ if pData = 0 then
+ ' Determine if there is a TYPE Extends that needs to be checked
+ pData = gdb2.dbFindTYPE( sParent )
+ if pData then
+ sParent = pData->TypeExtends
+ sSearch = sParent & "." & sLookFor
+ pData = gdb2.dbFindFunctionTYPE( sParent, sSearch )
+ end if
+ end if
+ end if
+ if pData then
+ pLastData = pData
+ end if
+ end if
+
+ if pData = 0 then
+ pData = gdb2.dbFindFunction( sLookFor )
+ if pData then
+ pLastData = pData
+ end if
+ end if
+
+ ' If we did not get anymore unresolved matches then return
+ ' the most recent match.
+ if pData = 0 then exit do
+
+ curPart = curPart + 1
+ loop
+
+ return pLastData
+
+end function
+
+
+' ========================================================================================
+' Show codetips
+' ========================================================================================
+function ShowCodetip( _
+ byval pDoc as clsDocument ptr, _
+ byval bCommaTrigger as Boolean = false _
+ ) as boolean
+
+ if gConfig.CodeTips = false then exit function
+
+ dim pData as DB2_DATA ptr
+ dim as string codeTip
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ dim as long curPos = SciExec(hEdit, SCI_GETCURRENTPOS, 0, 0)
+
+ if bCommaTrigger then
+ ' It is possible that a codetip had been displayed but the user moved off of the
+ ' current line and thereby closed the codetip. If user goes back to the line and
+ ' presses a comma to enter another parameter for function, then we should do a
+ ' test to see if we can redisplay the codetip popup again.
+ ' Need to also handle situations where there are multiple () array references
+ ' in the expression. For example: ListView1.Item(10).rc(5)
+ dim as long nCol = SciExec(hEdit, SCI_GETCOLUMN, curPos, 0)
+ dim as string sLine = rtrim(left(pDoc->GetLine(pDoc->GetCurrentLineNumber), nCol+1))
+ dim as boolean bInClosed
+ for i as long = len(sLine) -1 to 0 step -1
+ if sLine[i] = asc(")") then
+ bInClosed = true: continue for
+ end if
+ if sLine[i] = asc("(") then
+ if bInClosed = true then
+ bInClosed = false
+ else
+ exit for
+ end if
+ end if
+ curPos = curPos - 1
+ next
+ end if
+
+ pData = DereferenceLine(pDoc, "(", curPos-1)
+ if pData then codeTip = pData->CallTip
+
+ if len(codeTip) then
+ codeTip = FormatCodetip(codeTip)
+ SciExec( hEdit, SCI_CALLTIPSHOW, curPos, strptr(codeTip))
+ return true
+ else
+ pDoc->AutoCompleteType = AUTOCOMPLETE_NONE
+ END IF
+
+ return false
+end function
+
+
+' ========================================================================================
+' Display the actual Autocomplete popup list window
+' ========================================================================================
+function ShowAutoCompletePopup( _
+ byval hEdit as hwnd, _
+ byref sList as string _
+ ) as Long
+ if len(sList) = 0 THEN exit function
+ dim as string sFillups = "(=."
+
+ SciExec(hEdit, SCI_AUTOCSETFILLUPS, 0, strptr(sFillups)) ' characters that also select and close the popup
+ SciExec(hEdit, SCI_AUTOCSETSEPARATOR, 124, 0) ' Pipe symbol as separator
+ SciExec(hEdit, SCI_AUTOCSETORDER, 1, 0) ' List must be sorted alphabetically
+ SciExec(hEdit, SCI_AUTOCSETIGNORECASE, 1, 0)
+ SciExec(hEdit, SCI_AUTOCSETMAXHEIGHT, 9, 0)
+ SciExec(hEdit, SCI_AUTOCSHOW, 0, strptr(sList))
+ SciExec(hEdit, SCI_AUTOCSETOPTIONS, SC_AUTOCOMPLETE_FIXED_SIZE, 0)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Don't add duplicates in the Autocomplete list
+' ========================================================================================
+function ExistsInAutocompleteList( _
+ byref sList as string, _
+ byref sMatch as string _
+ ) as boolean
+ if rtrim(sMatch) = "" then return true
+ dim as string sLookFor = "|" & ucase(sMatch) & "|"
+ if instr( "|" & ucase(sList) & "|", sLookFor ) THEN return true
+ return false
+end function
+
+
+' ========================================================================================
+' Show Autocomplete list
+' ========================================================================================
+function ShowAutocompleteList( byval Notification as long = 0) as BOOLEAN
+
+ IF gConfig.AutoComplete = false THEN exit function
+
+ dim as long curPos, nCol, nLenMatchWord, ub, iNextType
+ dim as string sWord, sList, st, sDot, sLookFor, sElement, sProp
+ dim as Boolean bIsTHIS, bTypesOnly, bTypesNotPreloaded
+
+ dim pDoc as clsDocument ptr
+ dim pData as DB2_DATA ptr
+
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 Then exit function
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+
+ ' Retrieve the position
+ curPos = SciExec(hEdit, SCI_GETCURRENTPOS, 0, 0)
+ nCol = SciExec(hEdit, SCI_GETCOLUMN, curPos, 0)
+
+ dim as string sLine = left( pDoc->GetLine(pDoc->GetCurrentLineNumber), nCol )
+ dim as string sLine_ucase
+
+ ' Get the current entered word. We get the text between the "." or ">" and the current
+ ' editing position. We do this rather than pDoc->GetWord because text may already
+ ' exist after the current editing position.
+ pDoc->sMatchWord = ""
+ for i as long = len(sLine) to 1 step -1
+ dim as string ch = mid(sLine, i, 1)
+ select case ch
+ case ".", ">", " "
+ exit for
+ case else
+ pDoc->sMatchWord = ucase(ch) & pDoc->sMatchWord
+ end select
+ next
+ nLenMatchWord = len(pDoc->sMatchWord )
+
+ ' If an autocomplete is active but now there is no match word then
+ ' a space or tab must have been pressed so autocomplete cancel and now exit.
+ if SciExec(hEdit, SCI_AUTOCACTIVE, 0, 0) then
+ if nLenMatchWord = 0 then
+ SciExec( hEdit, SCI_AUTOCCANCEL, 0, 0)
+ exit function
+ end if
+ end if
+
+
+ ' Get the styling of the current line to determine if we are in a
+ ' multiline or single line comment block then abort the autoinsert.
+ select case SciExec(hEdit, SCI_GETSTYLEAT, curPos, 0)
+ case SCE_B_MULTILINECOMMENT, SCE_B_COMMENT
+ exit function
+ end select
+
+ ' If no active autocomplete then create the list based on the current underlying match word.
+ ' also continue to display the popup if we have simply backspaced while a popup is open.
+ dim as boolean bShowPopup = false
+ if (notification = SCN_AUTOCCHARDELETED) then
+ bShowPopup = true
+ else
+ if (SciExec(hEdit, SCI_AUTOCACTIVE, 0, 0) = 0) andalso _
+ (pDoc->AutoCompleteType = AUTOCOMPLETE_NONE) then
+ bShowPopup = true
+ end if
+ end if
+
+ if bShowPopup = true then
+ ' Comment out any comment line so the popup isn't activated when in a comment.
+ sLine = MaskStringCharacters(sLine)
+ sLine = RemoveComments(sLine)
+ if (notification <> SCN_AUTOCCHARDELETED) then
+ pDoc->sMatchWord = ""
+ nLenMatchWord = 0
+ end if
+ sLine_ucase = ucase(sLine)
+
+ if right(sLine_ucase, 4) = " AS " then
+ ' okay
+ bTypesOnly = false
+ bTypesNotPreloaded = false ' all types
+ pDoc->AutoCompleteType = AUTOCOMPLETE_DIM_AS
+
+ elseif right(sLine_ucase, 1) = "." then
+ sDot = "." ' okay
+ pDoc->AutoCompleteType = AUTOCOMPLETE_TYPE
+
+ elseif right(sLine_ucase, 2) = "->" then
+ sDot = "->"
+ pDoc->AutoCompleteType = AUTOCOMPLETE_TYPE
+
+ elseif right(sLine_ucase, 1) = "(" then
+ ShowCodetip(pDoc)
+ exit function
+
+ elseif right(sLine_ucase, 1) = "," then
+ ShowCodetip(pDoc, true)
+ exit function
+
+ elseif right(sLine_ucase, 5) = " NEW " then
+ ' okay
+ bTypesOnly = false
+ bTypesNotPreloaded = false ' all types
+ pDoc->AutoCompleteType = AUTOCOMPLETE_DIM_AS
+
+ elseif right(sLine_ucase, 12) = "CONSTRUCTOR " then
+ ' okay
+ bTypesOnly = true
+ bTypesNotPreloaded = true ' only TYPES that are in our source.
+ pDoc->AutoCompleteType = AUTOCOMPLETE_DIM_AS
+
+ elseif right(sLine_ucase, 11) = "DESTRUCTOR " then
+ ' okay
+ bTypesOnly = true
+ bTypesNotPreloaded = true
+ pDoc->AutoCompleteType = AUTOCOMPLETE_DIM_AS
+
+ elseif right(sLine_ucase, 9) = " EXTENDS " then
+ ' okay
+ bTypesOnly = true
+ bTypesNotPreloaded = false ' all types
+ pDoc->AutoCompleteType = AUTOCOMPLETE_DIM_AS
+ end if
+
+ ' Check if it is a "FOR i AS LONG" type of statement
+ if instr(sLine, "FOR ") then
+ SciExec( hEdit, SCI_AUTOCCANCEL, 0, 0)
+ exit function
+ end if
+
+ if pDoc->AutoCompleteType <> AUTOCOMPLETE_NONE then
+ ' If the file is dirty then reparse it before attempting the autocomplete
+ If cbool(SciExec(pDoc->hWindow(0), SCI_GETMODIFY, 0, 0 )) = true orelse _
+ (pDoc->UserModified = true) then
+ pDoc->ParseDocument()
+ End If
+ end if
+ end if
+
+ sList = "|"
+
+ select case pDoc->AutoCompleteType
+
+ case AUTOCOMPLETE_DIM_AS
+ ' Create the space separated data type list
+ ' Add all of the TYPE definitions that were found
+ gdb2.dbRewind()
+ do
+ pData = gdb2.dbGetNext()
+ if pData = 0 THEN exit do
+
+ if bTypesOnly = false then
+ if pData->id = DB2_STANDARDDATATYPE then
+ st = pData->VariableType
+ if nLenMatchWord then
+ if left(ucase(st), nLenMatchWord) = pDoc->sMatchWord then
+ if instr(sList, st & "|") = 0 then
+ sList = sList & st & "|"
+ end if
+ end if
+ else
+ if len(st) then
+ if instr(sList, st & "|") = 0 then
+ sList = sList & st & "|"
+ end if
+ end if
+ end if
+ end if
+ end if
+
+ if pData->id = DB2_TYPE THEN
+ if bTypesOnly then
+ if bTypesNotPreloaded then
+ ' Only look at TYPES that are loaded into the editor. These would
+ ' be entries that have a Filename attached to them. Preloaded TYPES
+ ' from WinAPI or Afx do not have Filenames.
+ if len(pData->fileName) = 0 then continue do
+ end if
+ end if
+
+ ' nLenMatchWord will allow partial matches to be added to the popup
+ ' based on what the user has currently typed.
+ st = rtrim(pData->VariableType)
+
+ if nLenMatchWord then
+ if left(ucase(st), nLenMatchWord) = pDoc->sMatchWord then
+ if ExistsInAutocompleteList(sList, st) = false then
+ sList = sList & st & "|"
+ end if
+ end if
+ elseif len(st) then
+ if ExistsInAutocompleteList(sList, st) = false then
+ sList = sList & st & "|"
+ end if
+ end if
+ end if
+ loop
+
+
+ case AUTOCOMPLETE_TYPE
+ ' Attempt to popup a list of TYPE elements related the pData variableType (TYPE)
+ pData = DereferenceLine( pDoc, sDot, curPos - 1)
+ if pData = 0 then return false
+ sLookFor = pData->VariableType ' This is the TYPE structure
+ if len(sLookFor) = 0 then return false
+
+ sLookFor = ucase(sLookFor)
+
+ do
+ gdb2.dbRewind()
+ do
+ pData = gdb2.dbGetnext()
+ if pData = 0 then exit do
+ if pData->deleted = true then continue do
+
+ dim as boolean bAddToList = false
+
+ if (pData->id = DB2_VARIABLE) andalso _
+ (ucase(pData->ParentName) = sLookFor) then
+ st = pData->ElementName
+ bAddToList = true
+ elseif (pData->id = DB2_FUNCTION) andalso _
+ (ucase(pData->ParentName) = sLookFor) then
+ st = AfxStrParse(pData->ElementName, 2, ".")
+ bAddToList = true
+ end if
+
+ if bAddToList then
+ if nLenMatchWord then
+ if left(ucase(st), nLenMatchWord) = pDoc->sMatchWord then
+ if ExistsInAutocompleteList(sList, st) = false then
+ sList = sList & st & "|"
+ end if
+ end if
+ else
+ If ExistsInAutocompleteList(sList, st) = false then
+ sList = sList & st & "|"
+ end if
+ end if
+ end if
+ loop
+
+ dim pDataTYPE as DB2_DATA ptr
+ pDataTYPE = gdb2.dbFindTYPE( sLookFor )
+ if pDataTYPE then
+ sLookFor = ucase(pDataType->TypeExtends)
+ else
+ exit do
+ end if
+ if len(sLookFor) = 0 then exit do
+ loop
+
+ end select
+
+ sList = trim(sList, any "| ")
+ if len(sList) THEN
+ ' Save the code editor starting position
+ pDoc->AutoCStartPos = SciExec(hEdit, SCI_GETCURRENTPOS, 0, 0)
+ ShowAutoCompletePopup(hEdit, sList)
+ return true
+ else
+ if (notification <> SCN_AUTOCCHARDELETED) then
+ SciExec( hEdit, SCI_AUTOCCANCEL, 0, 0)
+ end if
+ end if
+
+ function = true
+
+end function
+
+
+
diff --git a/src/modCompile.bi b/src/modCompile.bi
index ba335681..0cc3314c 100644
--- a/src/modCompile.bi
+++ b/src/modCompile.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modCompile.bi.bak b/src/modCompile.bi.bak
new file mode 100644
index 00000000..ba335681
--- /dev/null
+++ b/src/modCompile.bi.bak
@@ -0,0 +1,52 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+''
+'' COMPILE_TYPE
+'' Handle information related to the currnet compile process
+''
+Type COMPILE_TYPE
+ MainFilename As WString * MAX_PATH ' main source file (full path and file.ext)
+ MainName As WString * MAX_PATH ' main source file (Name only, no extension)
+ MainFolder As WString * MAX_PATH ' main source folder
+ ResourceFile As WString * MAX_PATH ' full path and file.ext to resource file (if applicable)
+ TempResourceFile As WString * MAX_PATH ' full path and file.ext to temporary resource file (if applicable)
+ OutputFilename As WString * MAX_PATH ' resulting exe/dll/lib name
+ CompilerPath As WString * MAX_PATH ' full path and file.ext to fbc.exe
+ ObjFolder As WString * MAX_PATH ' *.o for all modules (set depending on 32/64 bit) (full path)
+ ObjFolderShort As WString * MAX_PATH ' ".\.wfbe\"
+ ObjID As WString * MAX_PATH ' "32" or "64" appended to object name
+ CompileFlags As WString * 2048
+ wszFullCommandLine as CWSTR ' Command line sent to the FB compiler
+ wszFullLogFile as CWSTR ' Full log file returned from the FB compiler
+ wszOutputMsg as CWSTR ' Additional info during compile process (time/filesize)
+ RunAfterCompile As BOOLEAN
+ SystemTime AS SYSTEMTIME ' System time when compile finished
+ StartTime As Double
+ EndTime As Double
+ CompileID as long ' Type of compile (wID). Needed in case frmOutput listview later clicked on.
+ bInvalidImagePath as Boolean ' One or more images have invalid path will result in failed resource compile
+
+ ' The following are used to diagnose an error thrown in WinFBE_VD_MAIN.bas. We will
+ ' need to subtract the nMainStartLine from the error line number and then load pDocMain
+ ' into the editor and position.
+ pDocMain as clsDocument ptr
+ pDocMainOffset as long ' Line in file where the pDocMain code is output
+End Type
+
+declare Function code_Compile( ByVal wID As Long ) As BOOLEAN
+
+
+
diff --git a/src/modCompile.inc b/src/modCompile.inc
index 4702d1f0..dbb84acb 100644
--- a/src/modCompile.inc
+++ b/src/modCompile.inc
@@ -1,5 +1,5 @@
'' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-'' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
''
'' This program is free software: you can redistribute it and/or modify
'' it under the terms of the GNU General Public License as published by
diff --git a/src/modCompile.inc.bak b/src/modCompile.inc.bak
new file mode 100644
index 00000000..4702d1f0
--- /dev/null
+++ b/src/modCompile.inc.bak
@@ -0,0 +1,650 @@
+'' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+'' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+''
+'' This program is free software: you can redistribute it and/or modify
+'' it under the terms of the GNU General Public License as published by
+'' the Free Software Foundation, either version 3 of the License, or
+'' (at your option) any later version.
+''
+'' This program is distributed in the hope that it will be useful,
+'' but WITHOUT any WARRANTY; without even the implied warranty of
+'' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+'' GNU General Public License for more details.
+
+''
+''
+'' modCompile.inc
+''
+'' Code here handles the entire compiling process. It prepares the necessary
+'' command line data to pass to the applicable 32 or 64 version of the FBC
+'' compiler. Compile time errors are parsed through analyis of the log file
+'' and presented to the user via the Compiler Results listview and the Compiler
+'' Lof File text box.
+''
+''
+
+#include once "modCompile.bi"
+#include once "modCompileErrors.bi"
+#include once "modGenerateCode.bi"
+#include once "frmUserTools.bi"
+#include once "frmOutput.bi"
+
+Dim Shared gCompile As COMPILE_TYPE
+
+''
+'' Main module that handles the entire compile process
+''
+function code_Compile( ByVal wID As Long ) As BOOLEAN
+
+ Dim pDoc As clsDocument Ptr
+
+ Dim wszTemp As WString * MAX_PATH
+ Dim wszFileExe As WString * MAX_PATH
+ dim wszCompile as CWSTR
+ dim wszCommand as CWSTR
+ dim wszParams as CWSTR
+ dim sConsoleText as string
+
+ Dim As CWSTR wExeCmd, wDQ, wsLogSt, wst
+
+ Dim As BOOLEAN fCompile32, fCompile64
+
+ dim as long idxBuild, f, i, n, nCount
+
+ wDQ = wchr(34) ' unicode double quotes
+
+ gCompile.wszFullCommandLine = ""
+ gCompile.wszFullLogFile = ""
+ gCompile.wszOutputMsg = ""
+ gCompile.bInvalidImagePath = false
+
+
+ ' Indicate in the StatusBar that we have started to compile
+ SetCompileStatusBarMessage( L(449, "Generating compiler files") & "...", 0 )
+
+
+ ' Can only continue to compile if the primary source code file
+ ' is not dirty and needs to be saved.
+ if wID <> IDM_QUICKRUN THEN
+ If gConfig.CompileAutosave Then
+ ' If there any "New" files that have not been edited yet causing them to show
+ ' as dirty then we will mark them now so that the FileSaveAll command will
+ ' ask to save it (otherwise a compile error will show).
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ if pDoc->IsNewFlag then pDoc->UserModified = true
+ pDoc = pDoc->pDocNext
+ loop
+ If OnCommand_FileSaveAll(HWND_FRMMAIN) Then
+ SetCompileStatusBarMessage( "", 0 )
+ Return True ' user cancelled save
+ end if
+ ' Reload the main form files combobox in case names have changed
+ ' pDoc->SaveFile do this (OnCommand_FileSaveAll calls pDoc->SaveFile)
+ End If
+ END IF
+
+ ' Get the array index for the current selected build (project or document)
+ idxBuild = frmBuildConfig_getActiveBuildIndex()
+ if idxBuild = -1 then idxBuild = 0
+
+ ' Perform some pre-compile checks to see if we should continue.
+ gConfig.FBWINCompiler32 = ProcessFromCurdriveApp(gConfig.FBWINCompiler32)
+ gConfig.FBWINCompiler64 = ProcessFromCurdriveApp(gConfig.FBWINCompiler64)
+ if gConfig.Builds(idxBuild).Is32bit then
+ fCompile32 = True: fCompile64 = False
+ gCompile.CompilerPath = gConfig.FBWINcompiler32
+ end if
+ if gConfig.Builds(idxBuild).Is64bit then
+ gCompile.CompilerPath = gConfig.FBWINcompiler64
+ fCompile32 = False: fCompile64 = True
+ End if
+
+ ' Convert relative path to absolute path if needed.
+ if AfxPathIsRelative(gCompile.CompilerPath) then
+ gCompile.CompilerPath = AfxPathCombine(AfxGetExePathName, gCompile.CompilerPath)
+ END IF
+
+
+ ' Check to see if the compiler exists
+ If AfxFileExists(gCompile.CompilerPath) = 0 Then
+ wszTemp = L(202,"Invalid defined compiler path.")
+ wszTemp = wszTemp & vbcrlf & "Path: " & gCompile.CompilerPath
+ SetCompileStatusBarMessage( "", 0 )
+ MessageBox( HWND_FRMMAIN, wszTemp, L(201,"Error"), _
+ MB_OK Or MB_ICONINFORMATION Or MB_DEFBUTTON1 )
+ Function = False: Exit Function
+ End If
+
+
+ ' Set some compile flags depending on the type of compile requested.
+ gCompile.CompileID = wID
+ Select Case wID
+ Case IDM_BUILDEXECUTE: gCompile.RunAfterCompile = True
+ Case IDM_QUICKRUN: gCompile.RunAfterCompile = True
+ Case IDM_COMPILE: gCompile.RunAfterCompile = False
+ End Select
+
+
+ Dim pDocMain As clsDocument Ptr
+ If gApp.IsProjectActive Then
+ pDocMain = gApp.GetMainDocumentPtr()
+ If pDocMain = 0 Then
+ SetCompileStatusBarMessage( "", 0 )
+ MessageBox( HWND_FRMMAIN, L(208,"No Main file specified for the project."), L(201,"Error"), _
+ MB_OK Or MB_ICONINFORMATION Or MB_DEFBUTTON1 )
+ Function = False: Exit Function
+ End If
+ Else
+ pDocMain = gTTabCtl.GetActiveDocumentPtr()
+ End If
+ If pDocMain = 0 Then
+ SetCompileStatusBarMessage( "", 0 )
+ return 0
+ end if
+
+
+ ' Do a check to ensure that only one call to Application.Run exists, otherwise
+ ' present a warning message before continuing.
+ dim as CWSTR wszWarning = L(401,"Multiple calls to Application.Run exist. Check the source code of these files:") & ":"
+ dim as long TotalAppRunCount = 0
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ if pDoc->AppRunCount > 0 then
+ wszWarning = wszWarning & vbcrlf & "- " & AfxStrPathname( "NAMEX", pDoc->DiskFilename )
+ TotalAppRunCount = TotalAppRunCount + pDoc->AppRunCount
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+ if TotalAppRunCount > 1 then
+ SetCompileStatusBarMessage( "", 0 )
+ MessageBox( HWND_FRMMAIN, wszWarning, L(109,"Warning"), _
+ MB_OK Or MB_ICONWARNING Or MB_DEFBUTTON1 )
+ Function = False: Exit Function
+ end if
+
+
+ ' If this is a QuickRun then we need to copy the current source code to a temporary bas file
+ ' and compile that bas file instead. The resulting bas file will be deleted after the compiling
+ ' has completed and exe will be deleted when the exe is terminated.
+ dim as CWSTR wszTempMainFilename
+ if wID = IDM_QUICKRUN then
+ if pDocMain->IsNewFlag then
+ gCompile.MainFolder = AfxGetExePathName
+ else
+ gCompile.MainFolder = AfxStrPathname("PATH", pDocMain->DiskFilename)
+ end if
+ wszTempMainFilename = GetTemporaryFilename(gCompile.MainFolder, "bas")
+ gCompile.MainFilename = wszTempMainFilename
+ gCompile.MainName = AfxStrPathname("NAME", gCompile.MainFilename)
+
+ dim as CWSTR wszText = pDocMain->GetText()
+
+ ' Regenerate any visual designer code for Forms.
+ ' The codegen is stored in each pDoc's wszFormCodeGen
+ dim as long initialCtrlID = 10000
+
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ if pDoc->IsDesigner then
+ pDoc->initialCtrlID = initialCtrlID
+ pDoc->bRegenerateCode = true
+ GenerateFormCode( pDoc )
+ initialCtrlID = initialCtrlID + 10000
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+
+ dim pTextStream as CTextStream
+ if pTextStream.OpenUnicode(gCompile.MainFilename, IOMODE_FORWRITING, true) = S_OK then
+ pTextStream.Write( wszText )
+ end if
+ pTextStream.Close
+
+ else
+ gCompile.MainFilename = pDocMain->DiskFilename
+ gCompile.MainName = AfxStrPathname("NAME", pDocMain->DiskFilename)
+ gCompile.MainFolder = AfxStrPathname("PATH", pDocMain->DiskFilename)
+ end if
+
+ gCompile.ResourceFile = "" ' default that there is no resource
+ gCompile.CompileFlags = gConfig.Builds(idxBuild).wszOptions
+
+ ' If the path to the WinFBX (Afx) library is valid then add that path
+ ' as a -i switch to the compiler. This option is no longer presented in the
+ ' Environment Options dialog but Jose Roca still uses it to assist in
+ ' more easily being able to maintain his library code.
+ if AfxIsFolder(gConfig.WinFBXPath) THEN
+ gCompile.CompileFlags = gCompile.CompileFlags + " -i " + chr(34) + gConfig.WinFBXPath + chr(34)
+ end if
+
+ If gApp.IsProjectActive Then
+ Dim pDocResource As clsDocument Ptr = gApp.GetResourceDocumentPtr()
+ if pDocResource then gCompile.ResourceFile = pDocResource->DiskFilename
+
+ gCompile.ObjFolder = gCompile.MainFolder & ".wfbe\"
+ gCompile.ObjFolderShort = ".\.wfbe\"
+
+ If fCompile32 Then
+ gCompile.ObjID = "32.o"
+ gCompile.CompileFlags = gCompile.CompileFlags + " " + gApp.ProjectOther32
+ End If
+ If fCompile64 Then
+ gCompile.ObjID = "64.o"
+ gCompile.CompileFlags = gCompile.CompileFlags + " " + gApp.ProjectOther64
+ End If
+
+ ' Make sure the folders exist
+ SHCreateDirectory( 0, gCompile.ObjFolder )
+
+ Else
+ ' No active project
+ gCompile.CompileFlags = gCompile.CompileFlags + " " + gConfig.CompilerSwitches
+ End If
+
+
+ ' Search main source code for any user embedded compile directives. These will override
+ ' anything that was set at the default or project level.
+ redim directives(any) as COMPILE_DIRECTIVES
+ pDocMain->CompileDirectives(directives())
+
+ for i as long = lbound(directives) to ubound(directives)
+ select case directives(i).DirectiveFlag
+ case IDM_CONSOLE
+ n = instr(gCompile.CompileFlags, " -S GUI ")
+ if n THEN gCompile.CompileFlags = AfxStrDelete(gCompile.CompileFlags, n, 8)
+ gCompile.CompileFlags = gCompile.CompileFlags + " -s console "
+ case IDM_GUI
+ n = instr(gCompile.CompileFlags, " -S CONSOLE ")
+ if n THEN gCompile.CompileFlags = AfxStrDelete(gCompile.CompileFlags, n, 12)
+ gCompile.CompileFlags = gCompile.CompileFlags + " -s gui "
+ case IDM_RESOURCE
+ gCompile.ResourceFile = directives(i).DirectiveText
+ END select
+ next
+
+
+ ' Need to determine the output filename in order to search for any existing
+ ' running process.
+ gCompile.OutputFilename = gCompile.MainFolder & gCompile.MainName & ".exe"
+ If Instr(" " & Ucase(gCompile.CompileFlags), " -DLL") Then
+ gCompile.OutputFilename = gCompile.MainFolder & gCompile.MainName & ".dll"
+ End If
+ If Instr(" " & Ucase(gCompile.CompileFlags), " -DYLIB") Then
+ gCompile.OutputFilename = gCompile.MainFolder & gCompile.MainName & ".dll"
+ End If
+ If Instr(" " & Ucase(gCompile.CompileFlags), " -LIB") Then
+ gCompile.OutputFilename = gCompile.MainFolder & "lib" & gCompile.MainName & ".a"
+ End If
+
+
+ ' Need to test if the resulting application to be compiled is actually running
+ ' in memory. This would cause the compile to fail.
+ If IsProcessRunning(@gCompile.OutputFilename) Then
+ SetCompileStatusBarMessage( "", 0 )
+ MessageBox( HWND_FRMMAIN, L(200,"Program running") & "...", L(201,"Error"), _
+ MB_OK Or MB_ICONINFORMATION Or MB_DEFBUTTON1 )
+ Function = False: Exit Function
+ End If
+
+
+ gApp.IsCompiling = true
+
+ dim as HCURSOR hCurSave = GetCursor()
+ SetCursor( LoadCursor(0, IDC_WAIT) )
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc THEN SciExec( pDoc->hWindow(0), SCI_SETCURSOR, SC_CURSORWAIT, 0 )
+
+
+ ' Regenerate any visual designer code for Forms.
+ ' The codegen is stored in each pDoc's wszFormCodeGen
+ dim as long initialCtrlID = 10000
+
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ if pDoc->IsDesigner then
+ pDoc->initialCtrlID = initialCtrlID
+ pDoc->bRegenerateCode = true
+ GenerateFormCode( pDoc )
+ initialCtrlID = initialCtrlID + 10000
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+
+ ' Do another Save All because a call to GenerateFormCode may have created
+ ' Event code that previously did not exist.
+ if wID <> IDM_QUICKRUN then
+ OnCommand_FileSaveAll(HWND_FRMMAIN)
+ end if
+
+ ' Run any precompile tools
+ for y as long = LBound(gConfig.Tools) To UBound(gConfig.Tools)
+ if gConfig.Tools(y).Action = USERTOOL_ACTION_PRECOMPILE then
+ frmUserTools_ExecuteUserTool(y)
+ end if
+ next
+
+ ' Change to the output code directory
+ ChDir gCompile.MainFolder
+
+ gCompile.StartTime = Timer
+
+
+ ' If this is a project then we need to compile all of the modules first
+ ' in order to create the necessary *.o object files
+ If gApp.IsProjectActive Then
+ dim as long nFileCount ' used to calculate when to fire an AfxDoEvents
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ If pDoc->ProjectFileType = FILETYPE_MODULE Then
+ ' Get the base name of the file for constructing the object filename
+ wszTemp = AfxStrPathname("NAME", pDoc->DiskFilename)
+ wszTemp = gCompile.ObjFolderShort & wszTemp & gCompile.ObjID
+
+ ' Compare the source code file datetime to the object. If the source code
+ ' date time is greater then we need to recompile it, otherwise we will simply
+ ' link to the existing object file.
+ Dim As FILETIME ft1 = AfxGetFileLastWriteTime(pDoc->DiskFilename) ' source file
+ Dim As FILETIME ft2 = AfxGetFileLastWriteTime(wszTemp) ' object file
+
+ If (AfxFileTimeToVariantTime(ft1) > AfxFileTimeToVariantTime(ft2)) or _
+ (wID = IDM_REBUILDALL) Then
+
+ nFileCount = nFileCount + 1
+ if (nFileCount mod 5) = 0 then AfxDoEvents
+
+ wst = L(203, "Compiling") + "... " + AfxStrPathname("NAMEX", pDoc->DiskFilename)
+ SetCompileStatusBarMessage( wst, 0 )
+
+ wszCommand = gCompile.CompilerPath
+ wszParams = " -c -b " + _
+ wDQ + pDoc->DiskFilename + wDQ + _
+ " -v -o " + wDQ + wszTemp + wDQ
+ RedirConsoleToFile( wszCommand, wszParams, sConsoleText )
+ gCompile.wszFullCommandLine = wszCommand & " " & wszParams
+ gCompile.wszFullLogFile = sConsoleText
+
+ ' Need to check to see if any errors occurred while compiling this
+ ' object file. If yes, then stop processing object files and display
+ ' the error.
+ if ParseLogForError(sConsoleText, false, wID, fCompile64, true) then ' error detected
+ gApp.IsCompiling = false
+ SetCursor( hCurSave )
+ ResetScintillaCursors()
+ return true
+ end if
+ sConsoleText = ""
+ End If
+
+ End If
+ pDoc = pDoc->pDocNext
+ loop
+ End If
+
+
+ ' If this is a visual designer project then output specific equates that dictate
+ ' which controls get compiled into the file source.
+ dim as CWSTR wszVDEquates, wszCtrlEquate
+ dim as boolean bIsVisual = false
+
+ ' In 2.0.8 and lower, the following two defines were put into the user code
+ ' when a new main.bas file was created by New Project. From 2.0.9+ we move that
+ ' code to the WinFBE_VD_MAIN.bas file and comment it out from the Main file.
+ dim as CWSTR wszUnicodeEquate = "#Define UNICODE" & vbcrlf
+ dim as CWSTR wszDefineWin32Equate = "#Define _WIN32_WINNT &h0602" & vbcrlf
+
+ wszVDEquates = wszUnicodeEquate & _
+ wszDefineWin32Equate & _
+ "#Include Once " & chr(34) & "windows.bi" & chr(34) & vbcrlf & _
+ "#Include Once " & chr(34) & "Afx\CLayout.inc" & chr(34) & vbcrlf & _
+ "#Include Once " & chr(34) & "Afx\CWindow.inc" & chr(34) & vbcrlf
+
+ pDoc = iIf( gApp.IsProjectActive, gApp.pDocList, pDocMain )
+ do until pDoc = 0
+ if pDoc->IsDesigner then
+ bIsVisual = true
+ ' Search all of the controls and set the appropriate equate
+ dim pCtrl as clsControl ptr
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ wszCtrlEquate = "#define CODEGEN_" & ucase(GetToolBoxName( pCtrl->ControlType ))
+ if instr(wszVDEquates, wszCtrlEquate) = 0 then
+ wszVDEquates = wszVDEquates & wszCtrlEquate & vbcrlf
+ ' If adding a RichEdit control reference then we also need to add
+ ' TextBox reference because a RichEdit extends a TextBox.
+ if pCtrl->ControlType = CTRL_RICHEDIT then
+ wszCtrlEquate = "#define CODEGEN_TEXTBOX"
+ if instr(wszVDEquates, wszCtrlEquate) = 0 then
+ wszVDEquates = wszVDEquates & wszCtrlEquate & vbcrlf
+ end if
+ end if
+ end if
+ NEXT
+
+ if pDoc->MainMenuExists then
+ wszCtrlEquate = "#define CODEGEN_MAINMENU"
+ if instr(wszVDEquates, wszCtrlEquate) = 0 then
+ wszVDEquates = wszVDEquates & wszCtrlEquate & vbcrlf
+ end if
+ end if
+ if pDoc->ToolBarExists then
+ wszCtrlEquate = "#define CODEGEN_TOOLBAR"
+ if instr(wszVDEquates, wszCtrlEquate) = 0 then
+ wszVDEquates = wszVDEquates & wszCtrlEquate & vbcrlf
+ end if
+ end if
+ if pDoc->StatusBarExists then
+ wszCtrlEquate = "#define CODEGEN_STATUSBAR"
+ if instr(wszVDEquates, wszCtrlEquate) = 0 then
+ wszVDEquates = wszVDEquates & wszCtrlEquate & vbcrlf
+ end if
+ end if
+ end if
+
+ If gApp.IsProjectActive = false Then exit do
+ pDoc = pDoc->pDocNext
+ loop
+
+
+ wszVDEquates = wszVDEquates & _
+ "#Include once " & chr(34) & "WinFormsX\WinFormsX.bi" & chr(34) & vbcrlf & _
+ "Using Afx" & vbcrlf
+
+ dim wszVDMain as CWSTR
+ if bIsVisual then
+ wszVDMain = gCompile.MainFolder & "WINFBE_VD_MAIN.bas"
+ dim pStream as CTextStream
+ if pStream.Create(wszVDMain, true, true) = S_OK then
+ ' Get all of the text from the MAIN pDoc file
+ if pDocMain->hWindow(0) = 0 then
+ dim as CWSTR wszFileType = pDocMain->ProjectFileType
+ pDocMain->CreateCodeWindow( HWND_FRMMAIN, false, false, pDocMain->DiskFilename )
+ pDocMain->ProjectFileType = wszFileType
+ end if
+
+ dim as CWSTR wszMainFileText
+ wszMainFileText.Utf8 = pDocMain->GetText ' Convert from utf8
+
+ ' In 2.0.8 and lower, the following two defines were put into the user code
+ ' when a new main.bas file was created by New Project. From 2.0.9+ we move that
+ ' code to the WinFBE_VD_MAIN.bas file and comment it out from the Main file.
+ wszMainFileText = AfxStrReplace( wszMainFileText, wszUnicodeEquate, "'" & wszUnicodeEquate )
+ wszMainFileText = AfxStrReplace( wszMainFileText, wszDefineWin32Equate, "'" & wszDefineWin32Equate )
+
+ dim as CWSTR wszAllTYPEs, wszAllEvents
+
+ ' Output all of the visual designer generated code for each Form in the project
+ pDoc = iIf( gApp.IsProjectActive, gApp.pDocList, pDocMain )
+ do until pDoc = 0
+ if pDoc->IsDesigner then
+ wszAllTYPEs = wszAllTYPEs & pDoc->wszFormCodeGen
+ if pDoc <> pDocMain then
+ wszAllEvents = wszAllEvents & _
+ "#include once " & chr(34) & pDoc->DiskFilename & chr(34) & vbcrlf
+ end if
+ end if
+ If gApp.IsProjectActive = false Then exit do
+ pDoc = pDoc->pDocNext
+ loop
+
+ dim as CWSTR wszText = _
+ wszVDEquates & vbcrlf & _
+ wszAllTYPEs & vbcrlf ' this also includes Declares for the Events
+
+ ' Save the pDocMain in case WinFBE_VD_MAIN.bas throws an error and we have
+ ' to load the original main file into the editor and reposition to the error line.
+ gCompile.pDocMain = pDocMain
+ ' Determine the number of vbcrlf's to this point because we need to store the line offset
+ ' to where the Main code is to written.
+ gCompile.pDocMainOffset = AfxStrTally( wszText, vbcrlf )
+
+ ' Continue to build the output string and then write it disk.
+ wszText = wszText & _
+ wszMainFileText & vbcrlf & _ '<-- ensure vbcrlf because Main file may not have crlf on last line
+ wszAllEvents
+
+
+ pStream.WriteLine wszText
+ pStream.Close
+ gCompile.MainFilename = wszVDMain
+ end if
+ end if
+
+
+ ' Compile the Main file. If this is a project then we also need to link
+ ' in all of the *.o object files.
+ ' Per fxm post https://www.freebasic.net/forum/viewtopic.php?f=8&p=266126#p266126
+ ' and https://www.freebasic.net/forum/viewtopic.php?f=3&t=28723&p=274431#p274431
+ ' Do not specify file extension with -m parameter.
+ ' So the main module file must be called twice in the command line:
+ ' - after compile option '-m', but without specified extension,
+ ' - and also like any module to compile, but there with its specified extension.
+ 'dim as CWSTR wszMfile = wDQ + AfxStrPathName("PATH", gCompile.MainFilename) + AfxStrPathName("NAME", gCompile.MainFilename) + wDQ
+ 'dim as CWSTR wszMfile = AfxStrPathName("NAME", gCompile.MainFilename)
+ 'wszParams = "-m " + wszMfile + " " + wDQ + gCompile.MainFilename + wDQ
+ wszParams = "-m " + wDQ + gCompile.MainFilename + wDQ
+
+
+ ' Determine if we need to generate a temporary Resource file to hold any
+ ' necessary for visual designer forms/projects where image references need to be outputted.
+ if CreateTempResourceFile() then
+ wszParams = wszParams + " " + wDQ + gCompile.TempResourceFile + wDQ
+ else
+ if len(gCompile.ResourceFile) then
+ wszParams = wszParams + " " + wDQ + gCompile.ResourceFile + wDQ
+ end if
+ end if
+
+ ' Present a warning that the compile will fail if one or more of the Images in the
+ ' resource file have an invalid path.
+ if gCompile.bInvalidImagePath then
+ gApp.IsCompiling = false
+ SetCursor( hCurSave )
+ ResetScintillaCursors()
+ SetCompileStatusBarMessage( "", 0 )
+ dim as CWSTR wszWarning = L(404,"Image Manager contains invalid image paths. Resource file creation will fail.")
+ MessageBox( HWND_FRMMAIN, wszWarning, L(109,"Warning"), _
+ MB_OK Or MB_ICONWARNING Or MB_DEFBUTTON1 )
+ Function = False: Exit Function
+ end if
+
+
+ ' Ensure verbose compiler message output
+ wszParams = wszParams + " -v " + gCompile.CompileFlags
+
+ f = instr(wszParams, " -x ")
+ if f = 0 then
+ wszParams = wszParams + " -x " + wDQ + gCompile.OutputFilename + wDQ
+ else
+ ' The ParseLogForError() function below will identify the correct
+ ' filename for gCompile.OutputFilename based on the man file being linked.
+ end if
+
+ If gApp.IsProjectActive Then
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ If pDoc->ProjectFileType = FILETYPE_MODULE Then
+ ' Get the base name of the file for constructing the object filename
+ wszTemp = AfxStrPathname("NAME", pDoc->DiskFilename)
+ wszParams = wszParams + " " + gCompile.ObjFolderShort + wszTemp + gCompile.ObjID
+ End If
+ pDoc = pDoc->pDocNext
+ loop
+ End If
+
+ ' Attempt to delete any existing output file so it will not exist
+ ' should the compile fail.
+ if AfxFileExists( gCompile.OutputFilename ) then
+ AfxDeleteFile( gCompile.OutputFilename )
+ end if
+
+ wst = L(203, "Compiling") + "... " + AfxStrPathname("NAMEX", gCompile.MainFilename)
+ SetCompileStatusBarMessage( wst, 0 )
+ SetCursor( LoadCursor(0, IDC_WAIT) )
+
+
+ sConsoleText = ""
+ wszCommand = gCompile.CompilerPath
+ RedirConsoleToFile( wszCommand, wszParams, sConsoleText )
+ gCompile.wszFullCommandLine = wszCommand & " " & wszParams
+ gCompile.wszFullLogFile = sConsoleText
+
+
+ ' Attempt to fix the random problem whereby the spinning mouse wait cursor is not reset
+ ' to an arrow. It seems to happen in random cases whereby an error is thrown and a new
+ ' document is loaded to position to the error line. Very hard to reproduce. We will manually
+ ' reset all Scintilla cursors here for all open documents. Maybe this will help.
+ SetCursor( hCurSave )
+ ResetScintillaCursors()
+
+ gCompile.EndTime = Timer
+ gCompile.SystemTime = AfxSystemSystemTime
+
+ ' If this was a QuickRun then delete the temporary code file that was created.
+ ' Both the temporary disk file and (if applicable) the VD MAIN CODEGEN file.
+ if wID = IDM_QUICKRUN THEN
+ AfxDeleteFile( gCompile.MainFilename )
+ AfxDeleteFile( wszTempMainFilename )
+ end if
+
+ ' Add any temp resource file to the list of temp files to later be deleted.
+ gApp.AddQuickRunEXE(gCompile.TempResourceFile)
+
+ if ParseLogForError(sConsoleText, true, wID, fCompile64, false) = true then
+ ' Error was found. Editor has now been set to the error position. Nothing
+ ' more we can do now but exit out.
+ ' Make sure gApp.IsCompiling = false before returning
+ else
+
+ ' Run any postcompile tools
+ for y as long = LBound(gConfig.Tools) To UBound(gConfig.Tools)
+ if gConfig.Tools(y).Action = USERTOOL_ACTION_POSTCOMPILE then
+ frmUserTools_ExecuteUserTool(y)
+ end if
+ NEXT
+
+ If gCompile.RunAfterCompile Then
+ ' If gCompile.OutputFilename is a relative filename then convert it to full filename.
+ gCompile.OutputFilename = AfxStrReplace( gCompile.OutputFilename, "/", "\" )
+ if AfxPathIsRelative( gCompile.OutputFilename ) then
+ gCompile.OutputFilename = AfxPathCombine( gCompile.MainFolder, gCompile.OutputFilename )
+ end if
+
+ RunEXE( _
+ gCompile.OutputFilename, _
+ iif( gApp.IsProjectActive, gApp.ProjectCommandLine, gApp.wszCommandLine ) _
+ )
+ End If
+
+ end if
+
+ gApp.IsCompiling = false
+
+' if AfxFileExists( wszVDMain ) then
+' AfxDeleteFile( wszVDMain )
+' end if
+
+ Function = True ' successful
+End Function
+
+
diff --git a/src/modCompileErrors.bi b/src/modCompileErrors.bi
index d9790ce0..d8b30fbd 100644
--- a/src/modCompileErrors.bi
+++ b/src/modCompileErrors.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modCompileErrors.bi.bak b/src/modCompileErrors.bi.bak
new file mode 100644
index 00000000..d9790ce0
--- /dev/null
+++ b/src/modCompileErrors.bi.bak
@@ -0,0 +1,30 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+declare Function SetDocumentErrorPosition( ByVal hLV As HWnd, Byval wID as long ) As Long
+declare function SetLogFileTextbox() as long
+declare function ParseLogForError( _
+ byref wsLogSt as CWSTR, _
+ byval bAllowSuccessMessage as Boolean, _
+ Byval wID as long, _
+ byval fCompile64 as Boolean, _
+ byval fCompilingObjFiles as Boolean _
+ ) as Boolean
+declare function ResetScintillaCursors() as Long
+declare Function RunEXE( ByRef wszFileExe As CWSTR, ByRef wszParam As CWSTR ) As Long
+declare function SetCompileStatusBarMessage(byref wszText as wstring, byval hIconCompile as long) as LRESULT
+declare function RedirConsoleToFile(byref wszExe AS wstring, byref wszCmdLine AS wstring, byref sConsoleText AS string ) as long
+declare function CreateTempResourceFile() as boolean
+
diff --git a/src/modCompileErrors.inc b/src/modCompileErrors.inc
index ab198081..18481b3d 100644
--- a/src/modCompileErrors.inc
+++ b/src/modCompileErrors.inc
@@ -1,5 +1,5 @@
'' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-'' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
''
'' This program is free software: you can redistribute it and/or modify
'' it under the terms of the GNU General Public License as published by
diff --git a/src/modCompileErrors.inc.bak b/src/modCompileErrors.inc.bak
new file mode 100644
index 00000000..ab198081
--- /dev/null
+++ b/src/modCompileErrors.inc.bak
@@ -0,0 +1,704 @@
+'' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+'' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+''
+'' This program is free software: you can redistribute it and/or modify
+'' it under the terms of the GNU General Public License as published by
+'' the Free Software Foundation, either version 3 of the License, or
+'' (at your option) any later version.
+''
+'' This program is distributed in the hope that it will be useful,
+'' but WITHOUT any WARRANTY; without even the implied warranty of
+'' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+'' GNU General Public License for more details.
+
+''
+''
+'' modCompileErrors.inc
+''
+
+#include once "modCompile.bi"
+#include once "modCompileErrors.bi"
+
+''
+'' Set the statusbar text and icon for a good/bad compile
+''
+function SetCompileStatusBarMessage( _
+ byref wszText as wstring, _
+ byval hIconCompile as long _
+ ) as LRESULT
+ gApp.wszPanelText = wszText
+ gApp.hIconPanel = hIconCompile
+ frmMain_SetStatusbar
+ function = 0
+end function
+
+
+''
+'' Create Resource file (if necessary) for the compile and return
+'' the full disk filename of the resource file.
+''
+function CreateTempResourceFile() as boolean
+ dim as CWSTR wszResourceFile = gCompile.ResourceFile
+
+ ' Collect all of the IMAGE_NAME used by controls/properties in the file/project
+ ' and generate a string to output to the resource file.
+ dim pDoc as clsDocument ptr
+ dim as CWSTR wszInternalText, wszExistingText, wszImage
+
+ pDoc = gApp.pDocList
+ do until pDoc = 0
+ for i as long = lbound(pDoc->AllImages) to ubound(pDoc->AllImages)
+ ' IMAGE_ARROWLEFT RCDATA "IMAGES\\LEFTARROW.PNG"
+ wszImage = pDoc->AllImages(i).wszImageName & wspace(6) & _
+ pDoc->AllImages(i).wszFormat & wspace(2) & _
+ wchr(34) & pDoc->AllImages(i).wszFileName & wchr(34) & _
+ vbcrlf
+
+ ' Only add this Image if code has not already been generated for it, otherwise
+ ' there will be a resource compile error.
+ if instr(wszInternalText, wszImage) = 0 then
+ wszInternalText = wszInternalText & wszImage
+ end if
+
+ ' Check to ensure that the path to the image is valid otherwise the
+ ' resource compiler will fail.
+ if AfxFileExists( pDoc->AllImages(i).wszFileName ) = false then
+ gCompile.bInvalidImagePath = true
+ end if
+ next
+ pDoc = pDoc->pDocNext
+ loop
+
+ ' If resource items were found then we need to generate the new resource file
+ ' and return its name. The new file will be a temporary file that will need to
+ ' added to the App.AddQuickRunEXE list. That list is checked in the main WinFBE
+ ' message loop and deletes not only QuickRun EXEs but any other WinFBE generated
+ ' temporary file that we want to get rid of.
+ if len(wszInternalText) then
+
+ ' Need to copy a default manifest file to the compiling folder as well because
+ ' the newly generated resource file will depend on it.
+ dim as CWSTR wszManifestTemplate = AfxGetExePathName + "Settings\WinFBE_manifest.xml"
+ dim as CWSTR wszManifest = gCompile.MainFolder + "manifest.xml"
+ if AfxFileExists(wszManifestTemplate) then
+ if AfxFileExists(wszManifest) = false then
+ AfxCopyFile( wszManifestTemplate, wszManifest, true )
+ end if
+ end if
+
+ ' If a resource file already exists then use whatever text is in the file as
+ ' the basis for the newly generated resource file.
+ if AfxFileExists(gCompile.ResourceFile) then
+ ' Load the entire file into a string
+ DIM dwCount AS DWORD, dwFileSize AS DWORD, dwHighSize AS DWORD, dwBytesRead AS DWORD
+ DIM hFile AS HANDLE = CreateFileW(@gCompile.ResourceFile, GENERIC_READ, FILE_SHARE_READ, NULL, _
+ OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, NULL)
+ IF hFile = INVALID_HANDLE_VALUE THEN return false
+ dwFileSize = GetFileSize(hFile, @dwHighSize)
+ dim as string txtBuffer = String(dwFileSize, 0)
+ ReadFile(hFile, strptr(txtBuffer), dwFileSize, @dwBytesRead, NULL)
+ CloseHandle(hFile)
+
+ ' Check for BOM signatures
+ if left(txtBuffer, 3) = chr(&HEF, &HBB, &HBF) THEN
+ ' UTF8 BOM encoded (convert from utf8)
+ wszExistingText.Utf8 = mid(txtBuffer, 4) ' bypass the BOM
+ elseif left(txtBuffer, 2) = chr(&HFF, &HFE) THEN
+ ' UTF16 BOM (little endian) encoded
+ wszExistingText = mid(txtBuffer, 3) ' bypass the BOM
+ else
+ wszExistingText = wstr(txtBuffer) ' ansi -> unicode
+ END IF
+
+ end if
+
+ ' Ensure that the reference to the manifest file exists
+ dim as CWSTR wszLookFor = "1 24 " & wchr(34) & ".\manifest.xml" & wchr(34)
+ if instr(wszExistingText, wszLookFor ) = 0 then
+ wszInternalText = wszLookFor & vbcrlf & wszInternalText
+ end if
+
+ ' Append the internally generated resource text to the new resource file.
+ gCompile.TempResourceFile = GetTemporaryFilename(gCompile.MainFolder, "rc")
+ dim pStream AS CTextStream '(utf16)
+ if pStream.Create(gCompile.TempResourceFile, true, true) = S_OK then
+ pStream.WriteLine wszExistingText
+ pStream.WriteLine ""
+ pStream.WriteLine wszInternalText
+ pStream.WriteLine ""
+ pStream.Close
+ end if
+
+ return true
+ end if
+
+ return false
+end function
+
+
+''
+'' Reset all Scintilla editing cursors
+''
+function ResetScintillaCursors() as Long
+ Dim As Long nCount = gTTabCtl.GetItemCount
+
+ For i as long = 0 To nCount - 1
+ if gTTabCtl.IsSafeIndex(i) = false then continue for
+ dim as clsDocument ptr pDoc = gTTabCtl.tabs(i).pDoc
+ if pDoc THEN
+ SciExec( pDoc->hWindow(0), SCI_SETCURSOR, SC_CURSORNORMAL, 0 )
+ SciExec( pDoc->hWindow(1), SCI_SETCURSOR, SC_CURSORNORMAL, 0 )
+ end if
+ next
+ function = 0
+end function
+
+
+'' July 2017, attempted to capture STDERR output from a running FB compiled
+'' program in order to capture runtime errors. This code works okay on Windows 10
+'' but does not PRINT on Windows 7. Also, dkl posted in FB forum that FB prints
+'' to STDOUT rather than STDERR. This is too bad.
+''
+''
+function RedirConsoleToFile( _
+ byref wszExe AS wstring, _
+ byref wszCmdLine AS wstring, _
+ byref sConsoleText AS string _
+ ) as long
+
+ ' From the MinGW "Getting Started" guide:
+ ' MinGW may have problems with paths containing spaces, and if not, usually
+ ' other programs used with MinGW will experience problems with such paths.
+ ' Thus, we strongly recommend that you do not install MinGW in any location
+ ' with spaces in the path name reference; i.e. you should avoid installing
+ ' into any subdirectory of "Program Files" or "My Documents", or the like.
+ if instr(wszExe, " ") then
+ AfxMsg( "Compile failed (CreateChildProcess)." & vbcrlf & _
+ "Please install WinFBE into a folder without spaces." )
+ exit function
+ end if
+
+ ' Create the child process and read from its standard output
+ dim ProcessInfo AS PROCESS_INFORMATION
+ dim StartupInf AS STARTUPINFO
+
+ ' Continue on with the newer CreateProcess compile approach.
+ dim SecurityAttribute AS SECURITY_ATTRIBUTES
+ dim hChildStdOutRead AS PHANDLE
+ dim hChildStdOutWrite AS PHANDLE
+ dim dwReadBytes AS long
+ dim sBuffer AS STRING * 4096
+
+ ' Set the bInheritHandle flag so pipe handles are inherited.
+ SecurityAttribute.nLength = SIZEOF(SECURITY_ATTRIBUTES)
+ SecurityAttribute.bInheritHandle = TRUE
+ SecurityAttribute.lpSecurityDescriptor = NULL
+
+ ' Create a pipe for the child process's STDOUT.
+ IF CreatePipe( @hChildStdOutRead, @hChildStdOutWrite, @SecurityAttribute, BYVAL 0 ) = FALSE THEN
+ '? "error creating pipe"
+ ELSE
+ StartupInf.cb = SIZEOF(STARTUPINFO)
+ GetStartupInfo(@StartupInf )
+ StartupInf.hStdError = hChildStdOutWrite
+ StartupInf.hStdOutput = hChildStdOutWrite
+ StartupInf.dwFlags = STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW
+ StartupInf.wShowWindow = SW_HIDE
+
+ ' This call to CreateProcessW will succeed in all cases except for the one
+ ' where there are spaces in wszFullExe because once I wrap the string in double
+ ' quotes then the call to CreateProcessW fails.
+
+ dim errCode as long
+ errCode = CreateProcessW( _
+ wszExe, _ ' Create the child process.
+ wszCmdLine, _ ' Command line
+ BYVAL 0, _ ' Process security attributes
+ BYVAL 0, _ ' Primary thread security attributes
+ TRUE, _ ' Handles are inherited
+ byval 0, _ ' Creation flags
+ BYVAL 0, _ ' Use parent's environment
+ BYVAL 0, _ ' Use parent's current directory
+ @StartupInf, _ ' STARTUPINFO pointer
+ @ProcessInfo)
+
+ if errCode <> 0 then
+
+ CloseHandle( hChildStdOutWrite ) ' To avoid ReadFile hanging at the end.
+ DO
+ IF ReadFile( hChildStdOutRead, BYVAL VARPTR(sBuffer), 4096, @dwReadBytes, BYVAL 0 ) = FALSE THEN
+ '? "ERROR ReadFile', "GetLastError: "; GetLastError
+ EXIT DO
+ end if
+ sConsoleText = sConsoleText & LEFT(sBuffer, dwReadBytes)
+ '(at this stage we could SAVE the buffer that we've read from the child to a file, but
+ ' thats an extra ReadFile+WriteFile compared to the direct-to-hFile method)
+ LOOP
+
+ else
+ '? "CreateChildProcess failed"
+ if instr( wszExe, " " ) then
+ AfxMsg( "CreateChildProcess failed. Install WinFBE into folder without spaces." )
+ end if
+ if hChildStdOutRead then CloseHandle( hChildStdOutRead )
+ if hChildStdOutWrite then CloseHandle( hChildStdOutWrite )
+ exit function
+ END IF
+
+ END IF
+
+ ' Close handles to the child process and its primary thread.
+ ' Some applications might keep these handles to monitor the status
+ ' of the child process, for example.
+ if ProcessInfo.hProcess then CloseHandle( ProcessInfo.hProcess )
+ if ProcessInfo.hThread then CloseHandle( ProcessInfo.hThread )
+ if hChildStdOutRead then CloseHandle( hChildStdOutRead )
+
+ function = 0
+END function
+
+
+''
+''
+function RunEXE( _
+ ByRef wszFileExe As CWSTR, _
+ ByRef wszParam As CWSTR _
+ ) As Long
+
+ dim as CWSTR wszPath = AfxStrPathname("PATH", wszFileExe)
+ dim as CWSTR wszBatchFile = AfxGetExePathName + AfxStrPathname("NAME", wszFileExe) + ".bat"
+ dim as CWSTR wszQuickRunExe = wszFileExe
+
+ ' If option is specified to launch command window prior to running the
+ ' compiled program then we do so by executing a shell to a batch file.
+ ' This allows being able to see any runtime errors that might be thrown.
+ ' Otherwise, simple shell to the program.
+ if gConfig.RunViaCommandWindow THEN
+ dim pStream as CTextStream
+ if pStream.Create(wszBatchFile) = S_OK then
+ pStream.WriteLine "@echo off"
+ pStream.WriteLine Left(wszPath, 2) ' ensure on correct drive
+ pStream.WriteLine "cd " & chr(34) & wszPath & chr(34) ' change to correct folder
+ pStream.WriteLine chr(34) & wszFileExe & chr(34) & " " & wszParam
+ pStream.WriteLine "pause"
+ pStream.WriteLine "del " & chr(34) & wszBatchFile & chr(34) & " >> nul"
+ end if
+ pStream.Close
+ wszFileExe = wszBatchFile
+ wszParam = ""
+ END IF
+
+
+ Dim ShExecInfo As SHELLEXECUTEINFOW
+
+ ' Run the EXE
+ With ShExecInfo
+ .cbSize = Len(SHELLEXECUTEINFOW)
+ .fMask = SEE_MASK_NOCLOSEPROCESS
+ .HWnd = 0
+ .lpVerb = Null
+ .lpFile = wszFileExe
+ .lpParameters = wszParam
+ .lpDirectory = 0
+ .nShow = SW_SHOW
+ .hInstApp = 0
+ End With
+ ShellExecuteEx(@ShExecInfo)
+
+ ' If this was a QuickRun then add the filename to the global tracking array
+ ' that checks if the file exists and then deletes it.
+ if gCompile.CompileID = IDM_QUICKRUN THEN
+ ' Give time for the application to start to run (especially if being run via
+ ' the RunViaCommandWindow batch file, otherwise the exe will be deleted even
+ ' before it gets a chance to execute.
+ sleep 500
+ gApp.AddQuickRunEXE(wszQuickRunExe)
+ END IF
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Set the cursor to the error position based on the selected line in frmCompileResults
+' or the TODO listview.
+' ========================================================================================
+function SetDocumentErrorPosition( _
+ ByVal hLV As HWnd, _
+ Byval wID as long _
+ ) As Long
+
+ Dim wszErrorLine As WString * MAX_PATH
+ Dim wszErrorFile As WString * MAX_PATH
+
+ Dim As Long nCurSel = ListView_GetSelection(hLV)
+ If nCurSel < 0 Then Return 0
+
+ Dim pDoc As clsDocument Ptr
+
+ ' Get the line number and filename of the selected item
+ FF_ListView_GetItemText(hLV, nCurSel, 1, @wszErrorLine, MAX_PATH)
+ FF_ListView_GetItemText(hLV, nCurSel, 2, @wszErrorFile, MAX_PATH)
+ dim as long nLineNum = Val(wszErrorLine) - 1 ' because visually the editor is one based line numbers
+
+ ' If we are doing a QuickRun then it must be on the currently loaded
+ ' and active file in the editor, therefore simply use that pDoc.
+ if wID = IDM_QUICKRUN THEN
+ pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then wszErrorFile = pDoc->DiskFilename
+ END IF
+
+ pDoc = OpenSelectedDocument( wszErrorFile, "", nLineNum )
+
+ function = 0
+End Function
+
+
+''
+''
+function SetLogFileTextbox() as long
+
+ ' Construct the text that will be displayed:
+ ' - FBC version, exe name, file size, compile time
+ ' - raw log file output
+ ' - compile command line used
+ dim as CWSTR wszText
+
+ if len(gCompile.wszOutputMsg) then
+ gCompile.wszOutputMsg = gCompile.wszOutputMsg + vbcrlf
+ end if
+ wszText = _
+ gCompile.wszOutputMsg + _
+ L(178,"Command Line") + ": " + vbcrlf + _
+ gCompile.wszFullCommandLine + vbcrlf + vbcrlf + _
+ gCompile.wszFullLogFile
+
+ AfxSetWindowText( GetDlgItem( HWND_FRMOUTPUT, IDC_FRMOUTPUT_TXTLOGFILE), wszText )
+
+ ' Reset the type parameters so subsequent compiles will not append
+ function = 0
+end function
+
+
+''
+''
+function ParseLogForError( _
+ byref wsLogSt as CWSTR, _
+ byval bAllowSuccessMessage as Boolean, _
+ Byval wID as long, _
+ byval fCompile64 as Boolean, _
+ byval fCompilingObjFiles as Boolean _
+ ) as Boolean
+
+ ' Returns TRUE if error has been detected. This signals to the calling code
+ ' that we can break out of performing any further compiles (eg. modules).
+ Dim wszTemp As WString * MAX_PATH
+
+ Dim As Long Parenthesis_Start, Parenthesis_End, Error_Start
+ Dim As Long i, NumLines, NextLine, r, nCount, nListViewLine
+ Dim As Long NumWarnings, NumErrors, NumDirectives, IsError, IsWarning
+ Dim As Long nFirstErrorLine = -1
+ Dim As HWnd hLV
+ Dim As CWSTR wDQ, wst1, wst2, wst3, wst, wst_ucase, wszOutputMsg
+ dim as Boolean fGoodCompile
+
+ wDQ = wchr(34) ' unicode double quotes
+
+ hLV = GetDlgItem(HWND_FRMOUTPUT, IDC_FRMOUTPUT_LVRESULTS)
+ ListView_DeleteAllItems( hLV )
+
+ ' On some Windows systems with tight security policies, the CreateChildProcess used
+ ' by the sub RedirConsoleToFile will fail. This seems to happen mostly when trying
+ ' to compile using the FB 64 bit compiler on a 32-bit version of Windows. For this
+ ' reason we will do a manual check here rather than relying on detecting the error
+ ' through the log file string.
+ if fCompile64 then ' trying to compile a 64-bit program
+ if AfxWindowsBitness() <> 64 then ' Windows is not 64 bit
+ wsLogSt = "This version of the FreeBASIC compiler is not compatible with the version " & _
+ "of Windows you're running. Check your computer's system information to see " & _
+ "whether you need a x86 (32-bit) or x64 (64-bit) version of the program, and " & _
+ "then contact the software publisher."
+ gCompile.wszFullLogFile = wsLogSt
+ end if
+ end if
+
+ dim as Boolean bReadingCompileOutput = false
+
+ ' Parse the log string.
+ NumLines = AfxStrParseCount( wsLogSt, vbCrLf)
+
+ For NextLine = 1 To NumLines
+
+ wst = Trim(AfxStrParse(wsLogSt, NextLine, vbCrLf))
+ wst_ucase = Ucase(wst)
+
+ ' Deal with the situation where we might be trying to compile a 64-bit application
+ ' from a 32-bit operating system.
+ If Left(wst_ucase, 16) = "THIS VERSION OF " Then
+ fGoodCompile = false
+ FF_ListView_InsertItem( hLV, NumWarnings, 0, "" )
+ FF_ListView_InsertItem( hLV, NumWarnings, 1, "0" )
+ FF_ListView_InsertItem( hLV, NumWarnings, 2, "" )
+ FF_ListView_InsertItem( hLV, NumWarnings, 3, "compiling FAILED: Windows not 64-bit (refer to log file)" )
+ wszOutputMsg = wsLogSt: exit For
+ exit for
+ End If
+
+ ' Save the FB version and copyright information.
+ If Left(wst_ucase, 19) = "FREEBASIC COMPILER " Then
+ fGoodCompile = True
+ wszOutputMsg = wszOutputMsg & wst & vbCrLf: Continue For
+ End If
+ If Left(wst_ucase, 13) = "COPYRIGHT (C)" Then
+ fGoodCompile = True
+ wszOutputMsg = wszOutputMsg & wst & vbCrLf: Continue For
+ End If
+
+ ' Check to see if an error occurred in compiling a resource script.
+ ' If there was a bad source name passed to the compiler (for
+ ' example, missing .rc file), then the output at the end of the
+ ' log file is like the following:
+ '
+ ' Error!
+ ' Could Not Open source file (p.RC)
+ ' OBJ file Not made
+ ' compiling resource FAILED: Error Code 1
+ '
+ ' Very sorry, but GoRC had a problem.
+
+ ' Check to see if linking failed
+ If (Left(wst_ucase, 6) = "ERROR!") or _
+ (left(wst_ucase, 34) = "VERY SORRY, BUT GORC HAD A PROBLEM") Then
+ FF_ListView_InsertItem( hLV, nListViewLine, 0, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 1, "0" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 2, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 3, "compiling resource FAILED: Error Code 1 (refer to log file)" )
+ NumErrors = NumErrors + 1
+ elseIf (Left(wst_ucase, 5) = "ERROR") Then
+ FF_ListView_InsertItem( hLV, nListViewLine, 0, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 1, "0" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 2, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 3, "compiling FAILED: Error Code 1 (refer to log file)" )
+ NumErrors = NumErrors + 1
+ elseIf (Left(wst_ucase, 19) = "COMPILING C FAILED:") Then
+ FF_ListView_InsertItem( hLV, nListViewLine, 0, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 1, "0" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 2, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 3, "compiling C FAILED: Error Code 1 (refer to log file)" )
+ NumErrors = NumErrors + 1
+ end if
+
+ If Instr(wst_ucase, "LINKING FAILED:") Then
+ FF_ListView_InsertItem( hLV, nListViewLine, 0, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 1, "0" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 2, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 3, wst & " (refer to log file)" )
+ NumErrors = NumErrors + 1
+ End If
+
+
+ ' Check for the "linking: " line because that line identifies the actual output filename being created
+ If Left(wst_ucase, 9) = "LINKING: " Then
+ ' -o "WinFBE.exe"
+ i = Instr(wst, " -o ")
+ If i Then
+ wszTemp = Mid(wst, i+4)
+ i = Instr(wszTemp, wDQ & " ")
+ If i Then gCompile.OutputFilename = AfxStrRemove(Left(wszTemp, i), wDQ)
+ End If
+ End If
+
+ ' Determine if we are reading any lines in the log file that appear after the "compiling: " line
+ ' but before the "assembling: ". Anything there is data output by #print preprocessor statements.
+ If Left(wst_ucase, 11) = "COMPILING: " Then
+ bReadingCompileOutput = true
+ continue for
+ elseIf Left(wst_ucase, 13) = "COMPILING C: " Then
+ bReadingCompileOutput = true
+ continue for
+ elseIf Left(wst_ucase, 12) = "ASSEMBLING: " Then
+ bReadingCompileOutput = false
+ elseIf Left(wst_ucase, 14) = "COMPILING RC: " Then
+ bReadingCompileOutput = false
+ elseIf Left(wst_ucase, 9) = "LINKING: " Then
+ bReadingCompileOutput = false
+ end if
+
+ if bReadingCompileOutput then
+
+ if len(wst) = 0 then continue for
+
+ ' Check for any compiler warnings
+ Error_Start = 0
+ IsWarning = Instr(wst_ucase, ") WARNING ")
+ If IsWarning Then Error_Start = IsWarning
+ IsError = Instr(wst_ucase, ") ERROR ")
+ If IsError Then Error_Start = IsError
+
+ If (Error_Start > 0) Then
+ 'sample warning message
+ 'c:\freebasic\test.bas(1394) warning 1(1): Passing scalar as pointer, at parameter 2 (hwndOldFocus) of ONSETFOCUS()
+ 'sample error message
+ 'c:\freebasic\test.bas(17) error 41: Variable not declared, kjljjada in 'kjljjada Error'
+
+ ' Determine the line number. Error_Start variable holds the position of the closing
+ ' parenthesis of the line number. We simply need to reverse search from there for the
+ ' opening parenthesis.
+ ' 2018-08-29: Code updated to handle case of embedded parenthesis in file name
+ Parenthesis_End = Error_Start
+ Parenthesis_Start = InStrRev(wst, "(", Parenthesis_End)
+
+ If (Parenthesis_Start < Parenthesis_End) Andalso _
+ (Parenthesis_End <= Error_Start) then
+
+ wst1 = left(wst, Parenthesis_Start-1) ' filename
+ wst2 = Mid( wst, Parenthesis_Start + 1, Parenthesis_End - Parenthesis_Start - 1) ' line#
+ wst3 = Mid( wst, Error_Start + 1) ' error message
+
+
+ ' If the filename is "WinFBE_VD_MAIN.bas" then we need to load the corresponding
+ ' pDocMain instead and adjust for the error line offset.
+ if ucase(AfxStrPathname( "NAMEX", wst1 )) = "WINFBE_VD_MAIN.BAS" then
+ wst1 = gCompile.pDocMain->DiskFilename
+ wst2 = str( val(wst2) - gCompile.pDocMainOffset)
+ end if
+
+ FF_ListView_InsertItem( hLV, nListViewLine, 0, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 1, wst2 ) ' line#
+ FF_ListView_InsertItem( hLV, nListViewLine, 2, wst1 ) ' filename
+ FF_ListView_InsertItem( hLV, nListViewLine, 3, wst3 ) ' error message
+
+ If IsWarning Then
+ NumWarnings = NumWarnings + 1
+ ElseIf IsError Then
+ If nFirstErrorLine = -1 Then
+ nFirstErrorLine = NumWarnings + NumErrors
+ End If
+ NumErrors = NumErrors + 1
+ End If
+ End If
+
+ else
+
+ FF_ListView_InsertItem( hLV, nListViewLine, 0, "" )
+ FF_ListView_InsertItem( hLV, nListViewLine, 1, "" ) ' line#
+ FF_ListView_InsertItem( hLV, nListViewLine, 2, "" ) ' filename
+ FF_ListView_InsertItem( hLV, nListViewLine, 3, wst ) ' message
+ NumDirectives = NumDirectives + 1
+ end if
+
+ end if
+
+ nListViewLine = NumWarnings + NumErrors + NumDirectives
+ Next
+
+ ' If there were no errors but the fGoodCompile flag was not set to True then the log file
+ ' did not contain the required FB copyright notice. Something must have went wrong, like trying
+ ' to call the 64 bit compiler using a 32 bit operating system. Show the message to the user via
+ ' the Output window (log file).
+ If fGoodCompile = False Then NumErrors = NumErrors + 1
+
+
+ dim as CWSTR wszCompileMsg
+
+ ' If the EXE output file was never created then throw an error
+ if fCompilingObjFiles = false then
+ If (NumWarnings = 0) andalso (NumErrors = 0) then
+ if FileLen(gCompile.OutputFilename) = 0 then
+ NumErrors = NumErrors + 1
+ end if
+ end if
+ end if
+
+ ' In all cases where warnings and/or errors exist, we will show the Compiler Results listview
+ If (NumWarnings > 0) orelse (NumErrors > 0) orelse (NumDirectives > 0) then
+
+ wszCompileMsg = L(193, "Errors") & " " & NumErrors & " " & _
+ L(192, "Warnings") & " " & NumWarnings & _
+ " [" & _
+ AfxLocalDateStr( "yyyy-MM-dd" ) & " " & _
+ AfxLocalTimeStr( "hh:mm:ss" ) & "]"
+ gCompile.wszOutputMsg = L(229,"Failed Compile") & " (" & wszCompileMsg & ")" & vbcrlf
+ SetCompileStatusBarMessage( wszCompileMsg, ghIconBad )
+ MessageBeep(MB_ICONWARNING)
+
+ ' Position the Compiler Log to the first error/warning
+ ListView_SelectItem( hLV, 0 )
+
+ ' If fGoodCompile is False then something unusual occurred so better show the log file by default
+ If fGoodCompile = False Then
+ frmOutput_PositionWindows
+ End If
+
+ ' If the Search Results, TODO, Notes tab is active then reposition to
+ ' the first tab for error listview
+ select case gOutputTabsCurSel
+ case 2, 3, 4
+ gOutputTabsCurSel = 0
+ frmOutput_PositionWindows
+ end select
+
+ ShowWindow( HWND_FRMOUTPUT, SW_SHOW)
+ frmMain_PositionWindows
+ ' Set to error line position only after all windows have been shown and resized
+ SetDocumentErrorPosition(hLV, wID)
+ end if
+
+ ' If there were no errors or warnings then close any previously open compiler results listviews
+ If (NumWarnings = 0) andalso (NumErrors = 0) andalso (NumDirectives = 0) then
+ if IsWindowVisible(HWND_FRMOUTPUT) THEN
+ if gOutputTabsCurSel = 0 THEN
+ ShowWindow( HWND_FRMOUTPUT, SW_HIDE )
+ frmMain_PositionWindows
+ END IF
+ END IF
+ end if
+
+ If NumErrors = 0 Then
+ ' 2018-08-29: Show popup compile message in cases where no errors but warnings may exist.
+ ' Hide the Output window is already open but there is no longer any warnings
+ ' or errors to show in the listview. Only close if the listview is active. Do not
+ ' close if the user is looking at the logfile textbox.
+ if bAllowSuccessMessage then ' we are not compiling modules
+ dim as long nFileSize = AfxGetFileSize(gCompile.OutputFilename)
+ wszCompileMsg = L(193, "Errors") & " " & NumErrors & " " & _
+ L(192, "Warnings") & " " & NumWarnings & _
+ " [ " & AfxStrPathname("NAMEX", gCompile.OutputFilename) & " " & _
+ rtrim(AfxStrFormatKBSize(nFileSize)) & " (" & _
+ nFileSize & " " & L(199,"bytes") & ") ]"
+ SetCompileStatusBarMessage( wszCompileMsg, ghIconGood )
+ ' 2018-12-13: No longer offer the option to show the popup successful dialog.
+ ' Simply sound a success
+ if gConfig.DisableCompileBeep = false then
+ MessageBeep(MB_OK)
+ end if
+
+ gCompile.wszOutputMsg = _ ' this gets output to the Output window
+ L(228,"Successful Compile") & " (" & _
+ L(193,"Errors") & " " & NumErrors & " " & _
+ L(192,"Warnings") & " " & NumWarnings & ")" & vbcrlf & vbcrlf & _
+ L(194,"Primary Source:") & " " & gCompile.MainFilename & vbCrLf & _
+ L(195,"Target Compilation:") & " " & gCompile.OutputFilename & " (" & _
+ rtrim(AfxStrFormatKBSize(nFileSize)) & ", " & nFileSize & " " & L(199,"bytes") & ")" & vbcrlf & _
+ L(196,"Compile Time:") & " " & Format(gCompile.EndTime-gCompile.StartTime, "###0.0") & _
+ " " & L(198,"seconds") & " (" & _
+ AfxSystemTimeToDateStr( gCompile.SystemTime, "yyyy-MM-dd" ) & " " & _
+ AfxSystemTimeToTimeStr( gCompile.SystemTime, "hh:mm:ss" ) & ")" & vbcrlf
+ end if
+ End if
+
+ ' Update the log file text box in the frmOutput window
+ SetLogFileTextbox
+
+ ' If Errors have occurred then return TRUE. We will allow processing
+ ' to continue if only Warnings occurred.
+ ' There were errors then do not allow running the EXE (warnings are okay)
+ If NumErrors > 0 Then
+ gCompile.RunAfterCompile = False
+ return true
+ end if
+
+ function = false
+end function
+
+
diff --git a/src/modDeclares.bi b/src/modDeclares.bi
index a45ad9e0..1e4868cc 100644
--- a/src/modDeclares.bi
+++ b/src/modDeclares.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modDeclares.bi.bak b/src/modDeclares.bi.bak
new file mode 100644
index 00000000..a45ad9e0
--- /dev/null
+++ b/src/modDeclares.bi.bak
@@ -0,0 +1,359 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+declare function isWineActive() as boolean
+
+#define IDC_MENUBAR_FILE 1000
+#define IDC_MENUBAR_EDIT 1001
+#define IDC_MENUBAR_SEARCH 1002
+#define IDC_MENUBAR_VIEW 1003
+#define IDC_MENUBAR_PROJECT 1004
+#define IDC_MENUBAR_COMPILE 1005
+#define IDC_MENUBAR_DESIGNER 1006
+#define IDC_MENUBAR_HELP 1007
+
+'' Menu message identifiers
+Enum
+ '' USER MESSAGES
+ MSG_USER_SETFOCUS = WM_USER + 1 ' 1024 + 1
+ MSG_USER_SHOWCOLORCOMBOBOXES
+ MSG_USER_SETCOLORCUSTOM
+ MSG_USER_GETCOLORCUSTOM
+ MSG_USER_PROCESS_COMMANDLINE
+ MSG_USER_PROCESS_UPDATECHECK
+ MSG_USER_SHOWAUTOCOMPLETE
+ MSG_USER_APPENDEQUALSSIGN
+ MSG_USER_GENERATECODE
+ MSG_USER_PROCESS_STARTUPUSERTOOLS
+ MSG_USER_TOPTABS_CHANGING
+ MSG_USER_TOPTABS_CHANGED
+ MSG_USER_LOAD_EXPLORERFILES
+ MSG_USER_LOAD_FUNCTIONLISTFILES
+ MSG_USER_LOAD_BOOKMARKSFILES
+ MSG_USER_LOAD_FUNCTIONSFILES
+ MSG_USER_SHOW_KEYBOARDEDIT
+ MSG_USER_UPGRADE302FORM
+
+ '' FILE
+ IDM_FILE_START
+ IDM_FILE, IDM_FILENEW, IDM_FILEOPEN, IDM_FILEOPENTEMPLATES
+ IDM_FILEOPEN_EXPLORERLISTBOX
+ IDM_FILECLOSE, IDM_FILECLOSE_EXPLORERLISTBOX
+ IDM_FILECLOSEALL, IDM_FILECLOSEALLOTHERS, IDM_CLOSEALLFORWARD, IDM_CLOSEALLBACKWARD
+ IDM_FILESAVE, IDM_FILESAVEAS, IDM_FILESAVEALL
+ IDM_FILESAVE_EXPLORERLISTBOX
+ IDM_FILESAVEAS_EXPLORERLISTBOX
+ IDM_AUTOSAVE, IDM_LOADSESSION, IDM_SAVESESSION
+ IDM_MRU, IDM_MRUFILES, IDM_OPENINCLUDE, IDM_KEYBOARDSHORTCUTS
+ IDM_OPTIONS, IDM_OPTIONSDIALOG, IDM_BUILDCONFIG, IDM_USERSNIPPETS, IDM_CATEGORIES
+ IDM_USERTOOLS, IDM_USERTOOLSDIALOG
+ IDM_EXIT
+ IDM_FILE_END
+
+ '' EDIT
+ IDM_EDIT_START
+ IDM_UNDO, IDM_REDO
+ IDM_CUT, IDM_COPY, IDM_PASTE, IDM_INSERTFILE
+ IDM_FILEENCODING, IDM_ANSI, IDM_UTF8BOM, IDM_UTF16BOM
+ IDM_DELETELINE, IDM_DELETE,
+ IDM_FIND, IDM_FINDNEXT, IDM_FINDPREV
+ IDM_REPLACENEXT, IDM_REPLACEPREV, IDM_REPLACEALL
+ IDM_FINDNEXTACCEL, IDM_FINDPREVACCEL
+ IDM_FINDINFILES, IDM_REPLACE
+ IDM_INDENTBLOCK, IDM_UNINDENTBLOCK, IDM_COMMENTBLOCK, IDM_UNCOMMENTBLOCK
+ IDM_DUPLICATELINE, IDM_MOVELINEUP, IDM_MOVELINEDOWN, IDM_NEWLINEBELOWCURRENT
+ IDM_TOUPPERCASE, IDM_TOLOWERCASE, IDM_TOMIXEDCASE
+ IDM_LINEENDINGS, IDM_EOLTOCRLF, IDM_EOLTOCR, IDM_EOLTOLF
+ IDM_SELECTLINE, IDM_TABSTOSPACES
+ IDM_SPACES, IDM_SELECTALL
+ IDM_EDIT_END
+
+ '' SEARCH
+ IDM_SEARCH_START
+ IDM_SEARCH
+ IDM_DEFINITION, IDM_LASTPOSITION
+ IDM_GOTONEXTTAB, IDM_GOTOPREVTAB, IDM_CLOSETAB, IDM_GOTONEXTFUNCTION, IDM_GOTOPREVFUNCTION
+ IDM_GOTOHEADERFILE, IDM_GOTOSOURCEFILE, IDM_GOTOMAINFILE, IDM_GOTORESOURCEFILE
+ IDM_BOOKMARKTOGGLE, IDM_BOOKMARKNEXT, IDM_BOOKMARKPREV, IDM_BOOKMARKCLEARALL
+ IDM_BOOKMARKCLEARALLDOCS, IDM_CLEARALLBOOKMARKNODE, IDM_REMOVEBOOKMARKNODE
+ IDM_GOTONEXTCOMPILEERROR, IDM_GOTOPREVCOMPILEERROR
+ IDM_SETFOCUSEDITOR, IDM_GOTO
+ IDM_SEARCH_END
+
+ '' VIEW
+ IDM_VIEW_START
+ IDM_VIEW, IDM_VIEWEXPLORER, IDM_VIEWOUTPUT, IDM_FUNCTIONLIST, IDM_BOOKMARKSLIST
+ IDM_ZOOMIN, IDM_ZOOMOUT, IDM_FOLDTOGGLE, IDM_FOLDBELOW, IDM_FOLDALL, IDM_UNFOLDALL
+ IDM_VIEWTODO, IDM_VIEWNOTES, IDM_RESTOREMAIN
+ IDM_VIEW_END
+
+ '' PROJECT
+ IDM_PROJECT_START
+ IDM_PROJECTNEW, IDM_PROJECTMANAGER, IDM_PROJECTOPEN, IDM_MRUPROJECT, IDM_MRUPROJECTFILES
+ IDM_PROJECTCLOSE, IDM_PROJECTSAVE, IDM_PROJECTSAVEAS, IDM_PROJECTFILESADD, IDM_PROJECTOPTIONS
+ IDM_PROJECTFILETYPE, IDM_REMOVEFILEFROMPROJECT, IDM_REMOVEFILEFROMPROJECT_EXPLORERLISTBOX
+ IDM_PROJECT_END
+
+ '' COMPILE
+ IDM_COMPILE_START
+ IDM_BUILDEXECUTE, IDM_COMPILE, IDM_REBUILDALL, IDM_RUNEXE, IDM_QUICKRUN, IDM_COMMANDLINE
+ IDM_COMPILE_END
+
+ '' DESIGNER
+ IDM_DESIGNER_START
+ IDM_NEWFORM, IDM_VIEWTOOLBOX, IDM_TOGGLEVIEWCODE, IDM_MENUEDITOR
+ IDM_TOOLBAREDITOR, IDM_STATUSBAREDITOR, IDM_IMAGEMANAGER
+ IDM_ALIGN, IDM_ALIGNLEFTS, IDM_ALIGNCENTERS, IDM_ALIGNRIGHTS
+ IDM_ALIGNTOPS, IDM_ALIGNMIDDLES, IDM_ALIGNBOTTOMS
+ IDM_MAKESAME, IDM_HORIZEQUAL, IDM_HORIZINCREASE, IDM_HORIZDECREASE, IDM_HORIZREMOVE
+ IDM_HORIZSPACING, IDM_VERTSPACING, IDM_VERTEQUAL, IDM_VERTINCREASE, IDM_VERTDECREASE, IDM_VERTREMOVE
+ IDM_SAMEWIDTHS, IDM_SAMEHEIGHTS, IDM_SAMEBOTH
+ IDM_CENTER, IDM_CENTERHORIZ, IDM_CENTERVERT, IDM_CENTERBOTH
+ IDM_SNAPLINES, IDM_LOCKCONTROLS
+ IDM_DESIGNER_END
+
+ '' HELP
+ IDM_HELP_START
+ IDM_HELP, IDM_HELPWINFBE, IDM_HELPWINFBX
+ IDM_HELPSHORTCUTS, IDM_CHECKFORUPDATES, IDM_ABOUT
+ IDM_HELP_END
+
+ '' OTHER
+ IDM_SETFILEMAIN
+ IDM_SETFILERESOURCE
+ IDM_SETFILEHEADER
+ IDM_SETFILEMODULE
+ IDM_SETFILENORMAL
+ IDM_SETFILEMAIN_EXPLORERTREEVIEW
+ IDM_SETFILERESOURCE_EXPLORERTREEVIEW
+ IDM_SETFILEHEADER_EXPLORERTREEVIEW
+ IDM_SETFILEMODULE_EXPLORERTREEVIEW
+ IDM_SETFILENORMAL_EXPLORERTREEVIEW
+ IDM_EXPLORER_EXPANDALL
+ IDM_EXPLORER_COLLAPSEALL
+ IDM_FUNCTIONS_EXPANDALL
+ IDM_FUNCTIONS_COLLAPSEALL
+ IDM_BOOKMARKS_EXPANDALL
+ IDM_BOOKMARKS_COLLAPSEALL
+ IDM_FUNCTIONS_VIEWASTREE
+ IDM_FUNCTIONS_VIEWASLIST
+ IDM_SETCATEGORY
+ IDM_CLOSEPANEL
+
+ IDM_MRUCLEAR, IDM_MRUPROJECTCLEAR
+ IDM_CONSOLE, IDM_GUI, IDM_RESOURCE ' used for compiler directives in code
+ IDM_ADDIMAGE, IDM_REMOVEIMAGE, IDM_FORMATIMAGE, IDM_ATTACHIMAGE, IDM_DETACHIMAGE
+ IDM_32BIT, IDM_64BIT ' mainly used for identifying compiler associated with a project
+End Enum
+
+#define IDM_USERTOOLSLIST 4000
+#define IDM_USERTOOLSBASE 4001
+#define IDM_MRUBASE 5000 ' Windows id of MRU items 1 to 10 (located under File menu)
+#define IDM_MRUPROJECTBASE 6000 ' Windows id of MRUPROJECT items 1 to 10 (located under Project menu)
+
+
+' Global window handles
+Dim Shared As HWnd HWND_FRMMAIN, HWND_FRMRECENT, HWND_FRMOUTPUT, HWND_FRMMAIN_STATUSBAR
+dim shared as HWnd HWND_FRMMAIN_MENUBAR, HWND_FRMMAIN_DESIGNTABS
+Dim Shared As HWnd HWND_FRMOPTIONS, HWND_FRMOPTIONSGENERAL, HWND_FRMOPTIONSEDITOR, HWND_FRMOPTIONSEDITOR2
+Dim Shared As HWnd HWND_FRMOPTIONSCOLORS, HWND_FRMOPTIONSCOMPILER, HWND_FRMOPTIONSLOCAL
+dim shared as HWnd HWND_FRMOPTIONSKEYWORDS, HWND_FRMOPTIONSKEYWORDSWINAPI, HWND_FRMCATEGORIES
+Dim Shared As HWnd HWND_FRMFINDREPLACE, HWND_FRMFINDINFILES, HWND_FRMFINDREPLACE_SHADOW, HWND_FRMVDTOOLBOX, HWND_FRMVDCOLORS
+dim shared as hwnd HWND_FRMBUILDCONFIG, HWND_FRMMENUEDITOR, HWND_FRMUSERTOOLS, HWND_FRMVDANCHORS
+Dim Shared As HWnd HWND_PROPLIST_EDIT, HWND_PROPLIST_COMBO, HWND_PROPLIST_COMBOLIST, HWND_FRMHELPVIEWER
+dim shared as hwnd HWND_FRMIMAGES, HWND_FRMSNIPPETS, HWND_FRMSTATUSBAREDITOR, HWND_FRMTOOLBAREDITOR
+dim shared as hwnd HWND_FRMVDTABCHILD, HWND_FRMKEYBOARD, HWND_FRMKEYBOARD_LISTVIEW, HWND_FRMKEYBOARDEDIT
+
+dim shared as HWnd HWND_FRMMAIN_TOPTABS, HWND_FRMMAIN_TOPTABS_SHADOW
+dim shared as HWnd HWND_FRMEXPLORER, HWND_FRMEXPLORER_LISTBOX
+dim shared as HWnd HWND_FRMFUNCTIONS, HWND_FRMFUNCTIONS_LISTBOX
+dim shared as hwnd HWND_FRMBOOKMARKS, HWND_FRMBOOKMARKS_LISTBOX
+dim shared as hwnd HWND_FRMPANEL, HWND_FRMPANEL_VSCROLLBAR
+dim shared as hwnd HWND_FRMEDITOR_HSCROLLBAR(1)
+dim shared as hwnd HWND_FRMEDITOR_VSCROLLBAR(1)
+
+dim shared as HICON ghIconTick, ghIconNoTick
+dim shared as long ghIconGood, ghIconBad
+dim shared as HCURSOR ghCursorSizeNS
+dim shared as HCURSOR ghCursorSizeWE
+
+' Create a dynamic array that will hold all localization words/phrases while
+' a language is being edited in frmOptionsLocal. Also create a global array
+' that holds the english phrases. When a localization is loaded, any missing
+' translations are replaced with the english version.
+ReDim Shared gLangEnglish(Any) As WString * MAX_PATH
+ReDim Shared gLocalPhrases(Any) As WString * MAX_PATH
+common shared gLocalPhrasesEdit as boolean ' a localization language is being edited.
+
+' Create a dynamic array that will hold all localization words/phrases. This
+' array is resized and loaded using the LoadLocalizationFile function.
+ReDim Shared LL(Any) As WString * MAX_PATH
+
+' Define a macro that allows the user to specify the LL array subscript and
+' also a descriptive label (that is ignored), and return the LL array value.
+#Define L(e,s) LL(e)
+
+#Define SetFocusScintilla PostMessage( HWND_FRMMAIN, MSG_USER_SETFOCUS, 0, 0 )
+#Define SciExec(h, m, w, l) SendMessage(h, m, w, CAST(LPARAM, l))
+
+
+''
+'' Save information related to Find/Replace and Find in Files operations
+''
+Type FINDREPLACE_TYPE
+ foundCount as long
+ txtFind As CWSTR
+ txtReplace As CWSTR
+ txtFindCombo(10) As CWSTR
+ txtFilesCombo(10) As CWSTR
+ txtFolderCombo(10) As CWSTR
+ txtLastFind As CWSTR
+ txtFiles As CWSTR ' *.*, *.bas, etc (FindInFolder)
+ txtFolder As CWSTR ' start search from this folder (FindInFolder)
+ nSearchSubFolders As Long ' search sub folders as well (FindInFolder)
+ nWholeWord As long ' find/replace whole word search
+ nMatchCase As long ' match case when searching
+ nSelection As long ' search only selected text
+ nPreserve As long ' search only selected text
+ nSearchCurrentDoc as Long
+ nSearchAllOpenDocs as Long
+ nSearchProject as Long
+ wszResults as CWSTR
+ bExpanded as Boolean
+ rcExpand as RECT
+ rcMatchCase as RECT
+ rcWholeWord as RECT
+ rcResults as RECT
+ rcUpArrow as RECT
+ rcDownArrow as RECT
+ rcSelection as RECT
+ rcPreserve as RECT
+ rcReplace as RECT
+ rcReplaceAll as RECT
+ rcClose as RECT
+End Type
+dim Shared gFind As FINDREPLACE_TYPE
+dim Shared gFindInFiles As FINDREPLACE_TYPE
+
+
+' Tools/controls that can be drawn on a Form.
+type TOOLBOX_TYPE
+ nToolType as long
+ wszToolBoxName as CWSTR ' eg. OptionButton
+ wszControlName as CWSTR ' eg. Option
+ wszImage as CWSTR
+ wszCursor as CWSTR
+ wszClassName as CWSTR ' eg. RADIOBUTTON
+END TYPE
+dim shared gToolBox(any) as TOOLBOX_TYPE
+
+
+' Main frmMain app background
+dim shared ghBrushMainBackground as HBRUSH
+
+' shared variables that control the state of what menubar button is active.
+dim shared as HWND ghWndActiveMenuBarButton
+dim shared as long gMenuLastCurSel = -1
+dim shared as boolean gPrevent_WM_NCACTIVATE = false
+const MENUITEM_HEIGHT = 24
+const EXPLORERITEM_HEIGHT = 22
+const FUNCTIONLISTITEM_HEIGHT = 22
+const MENUBAR_HEIGHT = 30
+const TOPTABS_HEIGHT = 36
+const STATUSBAR_HEIGHT = 22
+const DESIGNTABS_HEIGHT = 24
+const SCROLLBAR_WIDTH_PANEL = 10
+const SCROLLBAR_WIDTH_EDITOR = 12
+const SCROLLBAR_HEIGHT = 10
+const SCROLLBAR_MINTHUMBSIZE = 30
+const SPLITSIZE = 4
+
+
+' array that holds the names of all fonts on the target system
+dim shared gFontNames( any ) as CWSTR
+
+' type and array to hold values related to the statusbar panels
+TYPE STATUSBAR_PANEL_TYPE
+ wszText as CWSTR
+ rc as RECT ' client coordinates
+ nID as long ' id to invoke if clicked on
+ isHot as boolean
+end type
+dim shared gSBPanels(6) as STATUSBAR_PANEL_TYPE
+dim shared grcGripper as RECT
+
+type TOPMENU_TYPE
+ nParentID as long
+ nID as long
+ nChildID as long
+ isDisabled as boolean
+ isSeparator as boolean
+ isChecked as boolean
+end type
+redim shared gTopMenu(any) as TOPMENU_TYPE
+
+dim shared as wstring * 10 _
+ wszChevronLeft, wszChevronRight, wszChevronUp, wszChevronDown, _
+ wszDocumentIcon, wszUpArrow, wszDownArrow, wszSelection, wszCheckmark, _
+ wszClose, wszDirty, wszCompileResultIcon, wszMatchCase, wszWholeWord, _
+ wszPreserveCase, wszReplace, wszReplaceAll, wszMoreActions, _
+ wszTriangleDown, wszTriangleUp, wszSplitEditor
+
+' Symbol characters display in top menus, frmExplorer, and tab control
+if isWineActive() then
+ ' Noto Sans Symbols2
+ wszCheckmark = !"\u2713" ' narrow checkmark
+ wszClose = !"\u2715" ' light X
+ wszChevronLeft = !"\u23F4" ' triangle left
+ wszChevronRight = !"\u23F5" ' triangle right
+ wszChevronDown = !"\u23F7" ' triangle down
+ wszChevronUp = !"\u23F6" ' triangle up
+ wszTriangleDown = !"\u23F7" ' triangle down
+ wszTriangleUp = !"\u23F6" ' triangle up
+ wszDocumentIcon = !"\u2802" ' small dot
+ wszUpArrow = !"\u23F6" ' triangle up
+ wszDownArrow = !"\u23F7" ' triangle down
+ wszSelection = !"\u2630" ' selection icon
+ wszDirty = !"\u2022" ' dot
+ wszCompileResultIcon = !"\u26AB" ' larger circle
+ wszMatchCase = "Aa" ' match case
+ wszWholeWord = "W" ' whole word
+ wszPreserveCase = "AB" ' preserve case
+ wszReplace = !"\u2631" ' replace
+ wszReplaceAll = !"\u2637" ' replace all
+ wszMoreActions = !"\u2630" ' ...
+else
+ wszClose = !"\u2715" ' light X
+ wszChevronLeft = !"\uE09A"
+ wszChevronRight = !"\uE097"
+ wszChevronUp = !"\uE098"
+ wszChevronDown = !"\uE099"
+ wszTriangleDown = !"\u23F7" ' triangle down
+ wszTriangleUp = !"\u23F6" ' triangle up
+ wszDocumentIcon = !"\u22C5" ' small dot
+ wszUpArrow = !"\uE1FE" ' up arrow
+ wszDownArrow = !"\uE1FC" ' down arrow
+ wszSelection = !"\uE1EE" ' selection icon
+ wszCheckmark = !"\u2713" ' narrow checkmark
+ wszDirty = !"\u2981" ' larger dot
+ wszCompileResultIcon = !"\u25CF" ' larger circle
+ wszMatchCase = "Aa" ' match case
+ wszWholeWord = "W" ' whole word
+ wszPreserveCase = "AB" ' preserve case
+ wszReplace = !"\uE297" ' replace
+ wszReplaceAll = !"\uE299" ' replace all
+ wszMoreActions = !"\u22EF" ' ...
+ wszSplitEditor = !"\u229F" ' squared minus
+end if
diff --git a/src/modGenerateCode.bi b/src/modGenerateCode.bi
index a5aaa1a2..0cb6baa9 100644
--- a/src/modGenerateCode.bi
+++ b/src/modGenerateCode.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modGenerateCode.bi.bak b/src/modGenerateCode.bi.bak
new file mode 100644
index 00000000..a5aaa1a2
--- /dev/null
+++ b/src/modGenerateCode.bi.bak
@@ -0,0 +1,24 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+type TABORDER_TYPE
+ pCtrl as clsControl ptr
+ TabIndex as Long ' 999999 if TabStop=False or TabIndex property doesn't exist
+END TYPE
+
+declare function GenerateFormMetaData( byval pDoc as clsDocument ptr ) as long
+declare function GenerateFormCode( byval pDoc as clsDocument ptr ) as long
+declare function GetFormName( byval pDoc as clsDocument ptr ) as CWSTR
+
diff --git a/src/modGenerateCode.inc b/src/modGenerateCode.inc
index f7ffc5bd..dba1fce9 100644
--- a/src/modGenerateCode.inc
+++ b/src/modGenerateCode.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modGenerateCode.inc.bak b/src/modGenerateCode.inc.bak
new file mode 100644
index 00000000..f7ffc5bd
--- /dev/null
+++ b/src/modGenerateCode.inc.bak
@@ -0,0 +1,1173 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modGenerateCode.bi"
+#include once "clsControl.bi"
+
+
+
+' ========================================================================================
+' Set values of a WinFormsX Font class (used for code generation)
+' ========================================================================================
+private function SetFontClassFromPropValue( byref wszPropValue as wstring ) as CWSTR
+
+ dim as CWSTR wszFont, wszStyles, wszCharSet
+
+ if val(AfxStrParse(wszPropValue, 3, ",")) <> 400 then
+ wszStyles = wszStyles & "FontStyles.Bold or "
+ END IF
+ if val(AfxStrParse(wszPropValue, 4, ",")) then
+ wszStyles = wszStyles & "FontStyles.Italic or "
+ END IF
+ if val(AfxStrParse(wszPropValue, 5, ",")) then
+ wszStyles = wszStyles & "FontStyles.Underline or "
+ end if
+ if val(AfxStrParse(wszPropValue, 6, ",")) then
+ wszStyles = wszStyles & "FontStyles.StrikeOut or "
+ end if
+ wszStyles = rtrim(wszStyles, " or ")
+ if len(wszStyles) = 0 then wszStyles = "FontStyles.Normal"
+
+ select case val(AfxStrParse(wszPropValue, 7, ",")) ' charset
+ case DEFAULT_CHARSET: wszCharSet = "FontCharset.Default"
+ case ANSI_CHARSET: wszCharSet = "FontCharset.Ansi"
+ case ARABIC_CHARSET: wszCharSet = "FontCharset.Arabic"
+ case BALTIC_CHARSET: wszCharSet = "FontCharset.Baltic"
+ case CHINESEBIG5_CHARSET: wszCharSet = "FontCharset.ChineseBig5"
+ case EASTEUROPE_CHARSET: wszCharSet = "FontCharset.EastEurope"
+ case GB2312_CHARSET: wszCharSet = "FontCharset.GB2312"
+ case GREEK_CHARSET: wszCharSet = "FontCharset.Greek"
+ case HANGUL_CHARSET: wszCharSet = "FontCharset.Hangul"
+ case HEBREW_CHARSET: wszCharSet = "FontCharset.Hebrew"
+ case JOHAB_CHARSET: wszCharSet = "FontCharset.Johab"
+ case MAC_CHARSET: wszCharSet = "FontCharset.Mac"
+ case OEM_CHARSET: wszCharSet = "FontCharset.OEM"
+ case RUSSIAN_CHARSET: wszCharSet = "FontCharset.Russian"
+ case SHIFTJIS_CHARSET: wszCharSet = "FontCharset.Shiftjis"
+ case SYMBOL_CHARSET: wszCharSet = "FontCharset.Symbol"
+ case THAI_CHARSET: wszCharSet = "FontCharset.Thai"
+ case TURKISH_CHARSET: wszCharSet = "FontCharset.Turkish"
+ case VIETNAMESE_CHARSET: wszCharSet = "FontCharset.Vietnamese"
+ case else: wszCharSet = "FontCharset.Default"
+ end select
+
+ wszFont = _
+ chr(34) & AfxStrParse(wszPropValue, 1, ",") & chr(34) & "," & _
+ AfxStrParse(wszPropValue, 2, ",") & "," & wszStyles & "," & wszCharSet
+
+ function = wszFont
+
+end function
+
+
+' ========================================================================================
+' Retrieve the Form name for this document.
+' ========================================================================================
+public function GetFormName( byval pDoc as clsDocument ptr ) as CWSTR
+ if pDoc = 0 then exit function
+
+ dim pCtrl as clsControl ptr
+ dim as CWSTR wszFormName
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if (pCtrl <> 0) andalso (pCtrl->ControlType = CTRL_FORM) then
+ wszFormName = GetControlProperty(pCtrl, "NAME")
+ exit for
+ end if
+ next
+ function = wszFormName
+
+end function
+
+
+' ========================================================================================
+' Generate the metadata that defines the form
+' ========================================================================================
+public function GenerateFormMetaData( byval pDoc as clsDocument ptr ) as long
+
+ ' *** This is legacy pre-version 3.02 code that is still required in order to
+ ' load older form files that have not yet been upgraded.
+
+ if pDoc = 0 then exit function
+
+ dim pCtrl as clsControl ptr
+ dim wszControls as CWSTR
+
+ ' Save Images(if applicable)
+ dim as long numImageItems = Ubound(pDoc->AllImages) - lbound(pDoc->AllImages) + 1
+ if numImageItems > 0 then
+ wszControls = wszControls & "' WINFBE IMAGES_START" & vbcrlf
+ for ii as long = lbound(pDoc->AllImages) to ubound(pDoc->AllImages)
+ dim as CWSTR wszRelative
+ dim as CWSTR wszImageFilename = pDoc->AllImages(ii).wszFilename
+
+ ' Attempt to convert the image file name to relative path
+ if AfxFileExists( pDoc->DiskFilename ) then
+ wszRelative = AfxPathRelativePathTo( pDoc->DiskFilename, FILE_ATTRIBUTE_NORMAL, wszImageFilename, FILE_ATTRIBUTE_NORMAL)
+ if AfxPathIsRelative(wszRelative) then wszImageFilename = wszRelative
+ end if
+
+ wszControls = wszControls & _
+ "' IMAGE_START" & vbcrlf & _
+ "' IMAGENAME=" & pDoc->AllImages(ii).wszImageName & vbcrlf & _
+ "' FILENAME=" & ProcessToCurdriveProject(wszImageFilename) & vbcrlf & _
+ "' RESOURCETYPE=" & pDoc->AllImages(ii).wszFormat & vbcrlf & _
+ "' IMAGE_END" & vbcrlf
+ next
+ wszControls = wszControls & "' WINFBE IMAGES_END" & vbcrlf
+ end if
+
+ ' Save MainMenu (if applicable)
+ dim as long numMenuItems = Ubound(pDoc->MenuItems) - lbound(pDoc->MenuItems) + 1
+ if numMenuItems > 0 then
+ wszControls = wszControls & _
+ "' WINFBE MAINMENU_START" & vbcrlf & _
+ "' MAINMENU_DISPLAY=" & pDoc->GenerateMenu & vbcrlf
+ for ii as long = lbound(pDoc->MenuItems) to ubound(pDoc->MenuItems)
+ wszControls = wszControls & _
+ "' MENUITEM_START" & vbcrlf & _
+ "' NAME=" & pDoc->MenuItems(ii).wszName & vbcrlf & _
+ "' CAPTION=" & pDoc->MenuItems(ii).wszCaption & vbcrlf & _
+ "' INDENT=" & pDoc->MenuItems(ii).nIndent & vbcrlf & _
+ "' ALT=" & pDoc->MenuItems(ii).chkAlt & vbcrlf & _
+ "' SHIFT=" & pDoc->MenuItems(ii).chkShift & vbcrlf & _
+ "' CTRL=" & pDoc->MenuItems(ii).chkCtrl & vbcrlf & _
+ "' SHORTCUT=" & pDoc->MenuItems(ii).wszShortcut & vbcrlf & _
+ "' CHECKED=" & pDoc->MenuItems(ii).chkChecked & vbcrlf & _
+ "' GRAYED=" & pDoc->MenuItems(ii).chkGrayed & vbcrlf & _
+ "' MENUITEM_END" & vbcrlf
+ next
+ wszControls = wszControls & "' WINFBE MAINMENU_END" & vbcrlf
+ end if
+
+ ' Save ToolBar items (if applicable)
+ dim as long numToolBarItems = Ubound(pDoc->ToolBarItems) - lbound(pDoc->ToolBarItems) + 1
+ if numToolBarItems > 0 then
+ wszControls = wszControls & _
+ "' WINFBE TOOLBAR_START" & vbcrlf & _
+ "' TOOLBAR_DISPLAY=" & pDoc->GenerateToolBar & vbcrlf & _
+ "' TOOLBAR_SIZE=" & pDoc->wszToolBarSize & vbcrlf
+ for ii as long = lbound(pDoc->ToolBarItems) to ubound(pDoc->ToolBarItems)
+ wszControls = wszControls & _
+ "' TOOLBARITEM_START" & vbcrlf & _
+ "' BUTTONNAME=" & pDoc->ToolBarItems(ii).wszName & vbcrlf & _
+ "' BUTTONTYPE=" & pDoc->ToolBarItems(ii).wszButtonType & vbcrlf & _
+ "' BUTTONTOOLTIP=" & pDoc->ToolBarItems(ii).wszTooltip & vbcrlf & _
+ "' BUTTONNORMALIMAGE=" & pDoc->ToolBarItems(ii).pPropNormalImage.wszPropValue & vbcrlf & _
+ "' BUTTONHOTIMAGE=" & pDoc->ToolBarItems(ii).pPropHotImage.wszPropValue & vbcrlf & _
+ "' BUTTONDISABLEDIMAGE=" & pDoc->ToolBarItems(ii).pPropDisabledImage.wszPropValue & vbcrlf & _
+ "' TOOLBARITEM_END" & vbcrlf
+ next
+ wszControls = wszControls & "' WINFBE TOOLBAR_END" & vbcrlf
+ end if
+
+ ' Save StatusBar Panels (if applicable)
+ dim as long numPanelItems = Ubound(pDoc->PanelItems) - lbound(pDoc->PanelItems) + 1
+ if numPanelItems > 0 then
+ wszControls = wszControls & _
+ "' WINFBE PANELS_START" & vbcrlf & _
+ "' STATUSBAR_DISPLAY=" & pDoc->GenerateStatusBar & vbcrlf
+ for ii as long = lbound(pDoc->PanelItems) to ubound(pDoc->PanelItems)
+ wszControls = wszControls & _
+ "' PANELITEM_START" & vbcrlf & _
+ "' PANELNAME=" & pDoc->PanelItems(ii).wszName & vbcrlf & _
+ "' PANELTEXT=" & pDoc->PanelItems(ii).wszText & vbcrlf & _
+ "' PANELTOOLTIP=" & pDoc->PanelItems(ii).wszTooltip & vbcrlf & _
+ "' PANELALIGNMENT=" & pDoc->PanelItems(ii).wszAlignment & vbcrlf
+ ' BorderStyle is deprecated as of v2.0.4 as it has no effect
+ ' in WinFBE programs where Windows Themes are enabled.
+ '"' PANELBORDERSTYLE=" & pDoc->PanelItems(ii).wszBorderStyle & vbcrlf & _
+ wszControls = wszControls & _
+ "' PANELAUTOSIZE=" & pDoc->PanelItems(ii).wszAutoSize & vbcrlf & _
+ "' PANELWIDTH=" & pDoc->PanelItems(ii).wszWidth & vbcrlf & _
+ "' PANELMINWIDTH=" & pDoc->PanelItems(ii).wszMinWidth & vbcrlf & _
+ "' PANELIMAGE=" & pDoc->PanelItems(ii).pProp.wszPropValue & vbcrlf & _
+ "' PANELBACKCOLOR=" & pDoc->PanelItems(ii).wszBackColor & vbcrlf & _
+ "' PANELBACKCOLORHOT=" & pDoc->PanelItems(ii).wszBackColorHot & vbcrlf & _
+ "' PANELFORECOLOR=" & pDoc->PanelItems(ii).wszForeColor & vbcrlf & _
+ "' PANELFORECOLORHOT=" & pDoc->PanelItems(ii).wszForeColorHot & vbcrlf & _
+ "' PANELITEM_END" & vbcrlf
+ next
+ wszControls = wszControls & "' WINFBE PANELS_END" & vbcrlf
+ end if
+
+
+ ' Iterate all of the controls on the form
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl then
+ wszControls = wszControls & "' WINFBE CONTROL_START " & GetToolBoxName(pCtrl->ControlType) & vbcrlf & _
+ "' PROPERTIES_START" & vbcrlf
+ for ii as long = lbound(pCtrl->Properties) to ubound(pCtrl->Properties)
+ wszControls = wszControls & _
+ "' PROP_NAME=" & pCtrl->Properties(ii).wszPropName & vbcrlf & _
+ "' PROP_VALUE=" & pCtrl->Properties(ii).wszPropValue & vbcrlf
+ NEXT
+ wszControls = wszControls & "' PROPERTIES_END" & vbcrlf & _
+ "' EVENTS_START" & vbcrlf
+ for ii as long = lbound(pCtrl->Events) to ubound(pCtrl->Events)
+ ' Only need to output the names of the Events that have been ticked as being in use.
+ if pCtrl->Events(ii).bIsSelected then
+ wszControls = wszControls & _
+ "' EVENT_NAME=" & pCtrl->Events(ii).wszEventName & vbcrlf
+ end if
+ next
+ wszControls = wszControls & "' EVENTS_END" & vbcrlf & _
+ "' WINFBE CONTROL_END" & vbcrlf
+ END IF
+ NEXT
+
+ pDoc->wszFormMetaData = _
+ "' WINFBE FORM" & vbcrlf & _
+ "' WINFBE VERSION " & APPVERSION & vbcrlf & _
+ "' LOCKCONTROLS=" & iif(pDoc->bLockControls, "True", "False") & vbcrlf & _
+ "' SNAPLINES=" & iif(pDoc->bSnapLines, "True", "False") & vbcrlf & _
+ "' WINFBE FORM_START" & vbcrlf & _
+ wszControls & _
+ "' WINFBE FORM_END" & vbcrlf
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Generate code for any existing Form ToolBar.
+' ========================================================================================
+private function GenerateToolBarCode( byval pDoc as clsDocument ptr ) as CWSTR
+
+ if pDoc = 0 then return ""
+
+ dim as string sp(5)
+ for i as long = 1 to ubound(sp)
+ sp(i) = space(val(gConfig.TabSize) * i)
+ NEXT
+
+ ' Size the panels in order to accommodate autosize
+ dim as long lb = 0
+ dim as long ub = ubound(pDoc->ToolBarItems)
+ dim as CWSTR DQ = chr(34)
+
+ dim as long nButtonSize = 24
+ select case **pDoc->wszToolBarSize
+ case "SIZE_16": nButtonSize = 16
+ case "SIZE_24": nButtonSize = 24
+ case "SIZE_32": nButtonSize = 32
+ case "SIZE_48": nButtonSize = 48
+ end select
+
+ dim as CWSTR wszText = _
+ sp(1) & "dim as long idxButton" & vbcrlf & _
+ sp(1) & "pForm->ToolBar.Buttons.Clear" & vbcrlf & _
+ sp(1) & "pForm->ToolBar.Parent = pForm" & vbcrlf & _
+ sp(1) & "pForm->ToolBar.ButtonSize = " & nButtonSize & vbcrlf
+
+ for i as long = lb to ub
+ wszText = wszText & _
+ sp(1) & "idxButton = pForm->ToolBar.Buttons.Add" & vbcrlf & _
+ sp(1) & "pForm->ToolBar.Button(idxButton).ButtonType = " & pDoc->ToolBarItems(i).wszButtonType & vbcrlf & _
+ sp(1) & "pForm->ToolBar.Button(idxButton).ToolTip = " & DQ & pDoc->ToolBarItems(i).wszToolTip & DQ & vbcrlf & _
+ sp(1) & "pForm->ToolBar.Button(idxButton).NormalImage = " & DQ & pDoc->ToolBarItems(i).pPropNormalImage.wszPropValue & DQ & vbcrlf & _
+ sp(1) & "pForm->ToolBar.Button(idxButton).HotImage = " & DQ & pDoc->ToolBarItems(i).pPropHotImage.wszPropValue & DQ & vbcrlf & _
+ sp(1) & "pForm->ToolBar.Button(idxButton).DisabledImage = " & DQ & pDoc->ToolBarItems(i).pPropDisabledImage.wszPropValue & DQ & vbcrlf
+ next
+
+ dim as CWSTR wszFormName = GetFormName(pDoc)
+ wszText = wszText & _
+ sp(1) & "pForm->ToolBar.OnClick = @" & wszFormName & "_ToolBar_Click" & vbcrlf & _
+ sp(1) & "pForm->Controls.Add(controltype.ToolBar, @(pForm->ToolBar))" & vbcrlf & vbcrlf
+
+ return wszText
+end function
+
+
+' ========================================================================================
+' Generate code for any existing Form StatusBar.
+' ========================================================================================
+private function GenerateStatusBarCode( byval pDoc as clsDocument ptr ) as CWSTR
+
+ if pDoc = 0 then return ""
+
+ dim as string sp(5)
+ for i as long = 1 to ubound(sp)
+ sp(i) = space(val(gConfig.TabSize) * i)
+ NEXT
+
+ ' Size the panels in order to accommodate autosize
+ dim as long lb = 0
+ dim as long ub = ubound(pDoc->PanelItems)
+ dim as CWSTR DQ = chr(34)
+
+ dim as CWSTR wszText = _
+ sp(1) & "dim as long idxPanel" & vbcrlf & _
+ sp(1) & "pForm->StatusBar.Panels.Clear" & vbcrlf & _
+ sp(1) & "pForm->StatusBar.Parent = pForm" & vbcrlf & _
+ sp(1) & "pForm->StatusBar.SizingGrip = false" & vbcrlf
+
+ for i as long = lb to ub
+ wszText = wszText & _
+ sp(1) & "idxPanel = pForm->StatusBar.Panels.Add" & vbcrlf & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).Text = " & DQ & pDoc->PanelItems(i).wszText & DQ & vbcrlf & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).Icon = " & DQ & pDoc->PanelItems(i).pProp.wszPropValue & DQ & vbcrlf & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).ToolTip = " & DQ & pDoc->PanelItems(i).wszToolTip & DQ & vbcrlf & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).Width = " & pDoc->PanelItems(i).wszWidth & vbcrlf & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).MinWidth = " & pDoc->PanelItems(i).wszMinWidth & vbcrlf & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).Alignment = " & pDoc->PanelItems(i).wszAlignment & vbcrlf & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).AutoSize = " & pDoc->PanelItems(i).wszAutoSize & vbcrlf
+ ' BorderStyle is deprecated as of v2.0.4 as it has no effect
+ ' in WinFBE programs where Windows Themes are enabled.
+ 'sp(1) & "pForm->StatusBar.Panel(idxPanel).BorderStyle = " & pDoc->PanelItems(i).wszBorderStyle & vbcrlf & _
+
+ ' Output the Back/Fore panel colors
+ dim as CWSTR wszPropValue
+ for ii as long = 0 to 3
+ select case ii
+ case 0: wszPropValue = pDoc->PanelItems(i).wszBackColor
+ case 1: wszPropValue = pDoc->PanelItems(i).wszBackColorHot
+ case 2: wszPropValue = pDoc->PanelItems(i).wszForeColor
+ case 3: wszPropValue = pDoc->PanelItems(i).wszForeColorHot
+ end select
+ if left(wszPropValue, 7) = "SYSTEM|" then
+ wszPropValue = "Colors.System" & mid(wszPropValue, 8)
+ elseif left(wszPropValue, 7) = "COLORS|" then
+ wszPropValue = "Colors." & mid(wszPropValue, 8)
+ elseif left(wszPropValue, 7) = "CUSTOM|" then
+ wszPropValue = mid(wszPropValue, 8) & " ' custom color"
+ end if
+ select case ii
+ case 0
+ wszText = wszText & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).BackColor = " & wszPropValue & vbcrlf
+ case 1
+ wszText = wszText & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).BackColorHot = " & wszPropValue & vbcrlf
+ case 2
+ wszText = wszText & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).ForeColor = " & wszPropValue & vbcrlf
+ case 3
+ wszText = wszText & _
+ sp(1) & "pForm->StatusBar.Panel(idxPanel).ForeColorHot = " & wszPropValue & vbcrlf
+ end select
+ next
+
+ next
+
+ dim as CWSTR wszFormName = GetFormName(pDoc)
+ wszText = wszText & _
+ sp(1) & "pForm->StatusBar.OnClick = @" & wszFormName & "_StatusBar_Click" & vbcrlf & _
+ sp(1) & "pForm->Controls.Add(controltype.StatusBar, @(pForm->StatusBar))" & vbcrlf & vbcrlf
+
+ return wszText
+end function
+
+
+' ========================================================================================
+' Generate code for any existing Form MainMenu.
+' ========================================================================================
+private function GenerateMainMenuCode( byval pDoc as clsDocument ptr ) as CWSTR
+
+ if pDoc = 0 then return ""
+
+ dim as clsMenuItem iMenu
+ dim as CWSTR wszText, wszShortcut, wszFormName
+ dim as CWSTR DQ = chr(34)
+ dim as long nIndentParent, idxInsert
+
+ dim as string sp(5)
+ for i as long = 1 to ubound(sp)
+ sp(i) = space(val(gConfig.TabSize) * i)
+ NEXT
+
+ wszText = _
+ sp(1) & "dim ncm As NONCLIENTMETRICS" & vbcrlf & _
+ sp(1) & "ncm.cbSize = SizeOf(ncm)" & vbcrlf & _
+ sp(1) & "SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(ncm), @ncm, 0)" & vbcrlf & _
+ sp(1) & "nClientOffset = AfxUnScaleY(ncm.iMenuHeight) ' holds the height of the mainmenu" & vbcrlf & vbcrlf & _
+ sp(1) & "pForm->MainMenu.MenuItems.Clear" & vbcrlf & _
+ sp(1) & "pForm->MainMenu.Parent = pForm" & vbcrlf
+
+ ' Every level of indent is a parent menu item
+ ' First, create all of the menuitems. Once created, then we can add them
+ ' to their parent menuitem collections.
+ for i as long = 0 to ubound(pDoc->MenuItems)
+ iMenu = pDoc->MenuItems(i)
+ if len(rtrim(iMenu.wszName)) = 0 then continue for
+
+ wszShortcut = ""
+ if iMenu.chkCtrl then wszShortcut = wszShortcut & "Ctrl+"
+ if iMenu.chkAlt then wszShortcut = wszShortcut & "Alt+"
+ if iMenu.chkShift then wszShortcut = wszShortcut & "Shift+"
+ wszShortcut = wszShortcut & iMenu.wszShortcut
+
+ wszText = wszText & sp(1) & _
+ "dim " & iMenu.wszName & " as wfxMenuItem = wfxMenuItem(" & _
+ DQ & iMenu.wszCaption & DQ & ", " & _
+ DQ & iMenu.wszName & DQ & ", " & _
+ DQ & wszShortcut & DQ & ", " & _
+ iMenu.chkChecked & ", " & _
+ iMenu.chkGrayed & _
+ ")" & vbcrlf
+ next
+
+ dim as CWSTR wszNodes(ubound(pDoc->MenuItems))
+ dim as CWSTR wszParentName
+ dim as long NextFreeNode = 0
+
+ ' Copy all of the root mainmenu items into the array first.
+ for i as long = 0 to ubound(pDoc->MenuItems)
+ iMenu = pDoc->MenuItems(i)
+ if len(rtrim(iMenu.wszName)) = 0 then continue for
+ if iMenu.nIndent = 0 then
+ wszNodes(NextFreeNode) = sp(1) & "pForm->MainMenu.MenuItems.Add(" & iMenu.wszName & ")"
+ NextFreeNode = NextFreeNode + 1
+ end if
+ next
+
+ ' Add the child menuitems to their parents
+ for i as long = 0 to ubound(pDoc->MenuItems)
+ iMenu = pDoc->MenuItems(i)
+ if iMenu.nIndent = 0 then continue for
+ if len(rtrim(iMenu.wszName)) = 0 then continue for
+
+ ' Determine where to insert the string into the array by first determining the
+ ' parent node of this menuitem and then insert the menuitem immediately before it.
+ ' If not found then insert at the end of the array (these would be the mainmenu
+ ' root items).
+
+ ' This is a child popup menuitem so we need to find the parent
+ ' menutitem and add this item to that collection
+ nIndentParent = iMenu.nIndent - 1
+ for ii as long = i to 0 step -1
+ if pDoc->MenuItems(ii).nIndent = nIndentParent then
+ wszParentName = pDoc->MenuItems(ii).wszName
+ exit for
+ end if
+ next
+ ' Search the array for the line that adds the parent node to determine the
+ ' insertion point.
+ for ii as long = 0 to ubound(wszNodes)
+ if instr(wszNodes(ii), "MenuItems.Add(" & wszParentName & ")" ) then
+ ' Do the actual inserting into the array
+ idxInsert = ii
+ for yy as long = ubound(wszNodes) to idxInsert + 1 step - 1
+ wszNodes(yy) = wszNodes(yy-1)
+ next
+ wszNodes(idxInsert) = sp(1) & wszParentName & ".MenuItems.Add(" & iMenu.wszName & ")"
+ exit for
+ end if
+ next
+
+ next
+
+
+ ' Join all of the node strings together
+ for i as long = 0 to ubound(wszNodes)
+ wszText = wszText & wszNodes(i) & vbcrlf
+ next
+
+
+ wszFormName = GetFormName(pDoc)
+ wszText = wszText & _
+ sp(1) & "pForm->MainMenu.OnPopup = @" & wszFormName & "_MainMenu_Popup" & vbcrlf & _
+ sp(1) & "pForm->MainMenu.OnClick = @" & wszFormName & "_MainMenu_Click" & vbcrlf & _
+ sp(1) & "pForm->Controls.Add(ControlType.MainMenu, @(pForm->MainMenu))" & vbcrlf & vbcrlf
+
+ return wszText
+end function
+
+
+' ========================================================================================
+' Generate (or regenerate) visual designer code.
+' ========================================================================================
+function GenerateFormCode( byval pDoc as clsDocument ptr ) as long
+ if pDoc = 0 then exit function
+ if pDoc->IsDesigner = false then exit function
+ if pDoc->bRegenerateCode = false then exit function
+
+ dim pCtrl as clsControl ptr
+ dim as CWSTR wszText, wszFormName, wszCtrlName, wszPropName, wszPropValue, wszPropDefault
+ dim as CWSTR wszFunction, wszAllEvents, wszPrototype, wszAllDeclares, wszCaseText
+ dim as CWSTR wszCombinedName, wszCodeGen, wszMenuSelect, wszToolBarSelect, wszStatusBarSelect
+ dim as CWSTR DQ = chr(34)
+ dim as long nStartTag, nEndTag, nPropType
+ dim pData as DB2_DATA ptr
+
+ dim as string sp(5)
+ for i as long = 1 to ubound(sp)
+ sp(i) = space(val(gConfig.TabSize) * i)
+ next
+
+ dim as long initialCtrlID = pDoc->initialCtrlID
+ if initialCtrlID = 0 then initialCtrlID = 10000
+
+ pDoc->wszFormCodegen = ""
+
+ wszFormName = GetFormName(pDoc)
+
+ ' If the Event/function does not already exist in code then create it now.
+ if (gApp.IsProjectLoading = false) andalso (gApp.IsFileLoading = false) then
+ if (pDoc->MainMenuExists = true) orelse _
+ (pDoc->ToolBarExists = true) orelse _
+ (pDoc->StatusBarExists = true) then
+ pDoc->bNeedsParsing = true
+ pDoc->ParseDocument()
+ end if
+ end if
+
+ ''
+ '' Generate the Declares for all of the Events for any MainMenu for the Form
+ ''
+ if pDoc->MainMenuExists then
+ dim as CWSTR wszMenuEvents(1)
+ wszMenuEvents(0) = "Click"
+ wszMenuEvents(1) = "Popup"
+
+ for i as long = lbound(wszMenuEvents) to ubound(wszMenuEvents)
+ ' Determine the name of the event function
+ wszFunction = wszFormName & "_MainMenu_" & wszMenuEvents(i)
+
+ ' Define the function prototype/declaration
+ wszPrototype = "Function " & wszFunction & "( ByRef sender As wfxMenuItem" & _
+ ", ByRef e As EventArgs ) As LRESULT" & vbcrlf
+
+ ' Add the event/function to the list of declares
+ wszAllDeclares = wszAllDeclares & "Declare " & wszPrototype
+
+ ' Only check if we are not loading the project because the event handling
+ ' could already exist but just be in another source code file that has
+ ' not yet been loaded.
+ if (gApp.IsProjectLoading = false) andalso (gApp.IsFileLoading = false) then
+ pData = gdb2.dbFindFunction(wszFunction)
+
+ if pData then
+ dim as long nStartLine = pData->nLineStart
+ dim as long nEndLine = pData->nLineEnd
+ dim as CWSTR wszCasesToAdd
+
+ dim as long CaseElseLine = -1
+ for ii as long = nStartLine to nEndLine
+ if ucase(pDoc->GetLine(ii)) = sp(2) & "CASE ELSE" then
+ CaseElseLine = ii: exit for
+ end if
+ next
+
+ ' Add any new CASE statements
+ if CaseElseLine <> -1 then
+ for ii as long = 0 to ubound(pDoc->MenuItems)
+ if len(rtrim(pDoc->MenuItems(ii).wszName)) = 0 then continue for
+ ' Bypass any Separators
+ if rtrim(pDoc->MenuItems(ii).wszCaption) = "-" then continue for
+ ' Popups only needed for menuitems with IsParent. If the indent level
+ ' of the next menuitem is greater, then this is a Parent menuitem.
+ if i = 1 then
+ if ii = ubound(pDoc->MenuItems) then continue for
+ if pDoc->MenuItems(ii+1).nIndent <= pDoc->MenuItems(ii).nIndent then continue for
+ end if
+ wszCaseText = sp(2) & "Case " & chr(34) & ucase(pDoc->MenuItems(ii).wszName) & chr(34)
+
+ dim as boolean bFoundLine = false
+ for iii as long = nStartLine to nEndLine
+ if ucase(pDoc->GetLine(iii)) = ucase(wszCaseText) then
+ bFoundLine = true: exit for
+ end if
+ next
+ if bFoundLine = false then
+ wszCasesToAdd = wszCasesToAdd & wszCaseText & vbcrlf
+ end if
+ next
+ ' Insert the wszCasesToAdd string imediately before the Case Else
+ if len(wszCasesToAdd) then
+ wszCasesToAdd = wszCasesToAdd & _
+ sp(2) & "Case Else"
+ pDoc->SetLine( CaseElseLine, wszCasesToAdd )
+ end if
+ end if
+ end if
+
+ if pData = 0 then
+ wszMenuSelect = sp(1) & "Select Case UCase(sender.Name)" & vbcrlf
+ for ii as long = 0 to ubound(pDoc->MenuItems)
+ if len(rtrim(pDoc->MenuItems(ii).wszName)) = 0 then continue for
+ ' Bypass any Separators
+ if rtrim(pDoc->MenuItems(ii).wszCaption) = "-" then continue for
+ ' Popups only needed for menuitems with IsParent. If the indent level
+ ' of the next menuitem is greater, then this is a Parent menuitem.
+ if i = 1 then
+ if ii = ubound(pDoc->MenuItems) then continue for
+ if pDoc->MenuItems(ii+1).nIndent <= pDoc->MenuItems(ii).nIndent then continue for
+ end if
+ wszMenuSelect = wszMenuSelect & _
+ sp(2) & "Case " & chr(34) & ucase(pDoc->MenuItems(ii).wszName) & chr(34) & vbcrlf
+ next
+ ' Must add a CASE ELSE because if no child menu items then SELECT CASE will be
+ ' empty causing a compile time error.
+ wszMenuSelect = wszMenuSelect & _
+ sp(2) & "Case Else" & vbcrlf & _
+ sp(1) & "End Select" & vbcrlf
+
+ wszAllEvents = wszAllEvents & "''" & vbcrlf & "''" & vbcrlf & _
+ wszPrototype & _
+ wszMenuSelect & _
+ sp(1) & "Function = 0" & vbcrlf & _
+ "End Function" & vbcrlf & vbcrlf
+ end if
+ end if
+ next
+ end if
+
+ ''
+ '' Generate the Declares for all of the Events for any ToolBar for the Form
+ ''
+ if pDoc->ToolBarExists then
+ dim as CWSTR wszToolBarEvents(0)
+ wszToolBarEvents(0) = "Click"
+
+ for i as long = lbound(wszToolBarEvents) to ubound(wszToolBarEvents)
+ ' Determine the name of the event function
+ wszFunction = wszFormName & "_ToolBar_" & wszToolBarEvents(i)
+
+ ' Define the function prototype/declaration
+ wszPrototype = "Function " & wszFunction & "( ByRef sender As wfxToolBar" & _
+ ", ByRef e As EventArgs ) As LRESULT" & vbcrlf
+
+ ' Add the event/function to the list of declares
+ wszAllDeclares = wszAllDeclares & "Declare " & wszPrototype
+
+ ' Only check if we are not loading the project because the event handling
+ ' could already exist but just be in another source code file that has
+ ' not yet been loaded.
+ if (gApp.IsProjectLoading = false) andalso (gApp.IsFileLoading = false) then
+ pData = gdb2.dbFindFunction(wszFunction)
+
+ if pData then
+ dim as long nStartLine = pData->nLineStart
+ dim as long nEndLine = pData->nLineEnd
+ dim as CWSTR wszCasesToAdd
+
+ dim as long CaseElseLine = -1
+ for ii as long = nStartLine to nEndLine
+ if ucase(pDoc->GetLine(ii)) = sp(2) & "CASE ELSE" then
+ CaseElseLine = ii: exit for
+ end if
+ next
+
+ ' Add any new CASE statements
+ if CaseElseLine <> -1 then
+ for ii as long = 0 to ubound(pDoc->ToolBarItems)
+ wszCaseText = sp(2) & "Case " & ii
+
+ dim as boolean bFoundLine = false
+ for iii as long = nStartLine to nEndLine
+ if ucase(pDoc->GetLine(iii)) = ucase(wszCaseText) then
+ bFoundLine = true: exit for
+ end if
+ next
+ if bFoundLine = false then
+ wszCasesToAdd = wszCasesToAdd & wszCaseText & vbcrlf
+ end if
+ next
+ ' Insert the wszCasesToAdd string imediately before the Case Else
+ if len(wszCasesToAdd) then
+ wszCasesToAdd = wszCasesToAdd & _
+ sp(2) & "Case Else"
+ pDoc->SetLine( CaseElseLine, wszCasesToAdd )
+ end if
+ end if
+ end if
+
+ if pData = 0 then
+ wszToolBarSelect = sp(1) & "Select Case sender.ClickIndex" & vbcrlf
+ for ii as long = 0 to ubound(pDoc->ToolBarItems)
+ wszToolBarSelect = wszToolBarSelect & _
+ sp(2) & "Case " & ii & vbcrlf
+ next
+
+ ' Must add a CASE ELSE because if no child menu items then SELECT CASE will be
+ ' empty causing a compile time error.
+ wszToolBarSelect = wszToolBarSelect & _
+ sp(2) & "Case Else" & vbcrlf & _
+ sp(1) & "End Select" & vbcrlf
+
+ wszAllEvents = wszAllEvents & "''" & vbcrlf & "''" & vbcrlf & _
+ wszPrototype & _
+ wszToolBarSelect & _
+ sp(1) & "Function = 0" & vbcrlf & _
+ "End Function" & vbcrlf & vbcrlf
+ end if
+ end if
+ next
+ end if
+
+
+ ''
+ '' Generate the Declares for all of the Events for any StatusBar for the Form
+ ''
+ if pDoc->StatusBarExists then
+ dim as CWSTR wszStatusBarEvents(0)
+ wszStatusBarEvents(0) = "Click"
+
+ for i as long = lbound(wszStatusBarEvents) to ubound(wszStatusBarEvents)
+ ' Determine the name of the event function
+ wszFunction = wszFormName & "_StatusBar_" & wszStatusBarEvents(i)
+
+ ' Define the function prototype/declaration
+ wszPrototype = "Function " & wszFunction & "( ByRef sender As wfxStatusBar" & _
+ ", ByRef e As EventArgs ) As LRESULT" & vbcrlf
+
+ ' Add the event/function to the list of declares
+ wszAllDeclares = wszAllDeclares & "Declare " & wszPrototype
+
+ ' Only check if we are not loading the project because the event handling
+ ' could already exist but just be in another source code file that has
+ ' not yet been loaded.
+ if (gApp.IsProjectLoading = false) andalso (gApp.IsFileLoading = false) then
+ pData = gdb2.dbFindFunction(wszFunction)
+
+ if pData then
+ dim as long nStartLine = pData->nLineStart
+ dim as long nEndLine = pData->nLineEnd
+ dim as CWSTR wszCasesToAdd
+
+ dim as long CaseElseLine = -1
+ for ii as long = nStartLine to nEndLine
+ if ucase(pDoc->GetLine(ii)) = sp(2) & "CASE ELSE" then
+ CaseElseLine = ii: exit for
+ end if
+ next
+
+ ' Add any new CASE statements
+ if CaseElseLine <> -1 then
+ for ii as long = 0 to ubound(pDoc->PanelItems)
+ wszCaseText = sp(2) & "Case " & ii
+
+ dim as boolean bFoundLine = false
+ for iii as long = nStartLine to nEndLine
+ if ucase(pDoc->GetLine(iii)) = ucase(wszCaseText) then
+ bFoundLine = true: exit for
+ end if
+ next
+ if bFoundLine = false then
+ wszCasesToAdd = wszCasesToAdd & wszCaseText & vbcrlf
+ end if
+ next
+ ' Insert the wszCasesToAdd string imediately before the Case Else
+ if len(wszCasesToAdd) then
+ wszCasesToAdd = wszCasesToAdd & _
+ sp(2) & "Case Else"
+ pDoc->SetLine( CaseElseLine, wszCasesToAdd )
+ end if
+ end if
+ end if
+
+ if pData = 0 then
+ wszStatusBarSelect = sp(1) & "Select Case sender.ClickIndex" & vbcrlf
+ for ii as long = 0 to ubound(pDoc->PanelItems)
+ wszStatusBarSelect = wszStatusBarSelect & _
+ sp(2) & "Case " & ii & vbcrlf
+ next
+
+ ' Must add a CASE ELSE because if no child menu items then SELECT CASE will be
+ ' empty causing a compile time error.
+ wszStatusBarSelect = wszStatusBarSelect & _
+ sp(2) & "Case Else" & vbcrlf & _
+ sp(1) & "End Select" & vbcrlf
+
+ wszAllEvents = wszAllEvents & "''" & vbcrlf & "''" & vbcrlf & _
+ wszPrototype & _
+ wszStatusBarSelect & _
+ sp(1) & "Function = 0" & vbcrlf & _
+ "End Function" & vbcrlf & vbcrlf
+ end if
+ end if
+ next
+ end if
+
+
+ ''
+ '' Generate the Declares for all of the Events for the Form & Controls
+ ''
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl then
+ wszCtrlName = GetControlProperty(pCtrl, "NAME")
+ for ii as long = lbound(pCtrl->Events) to ubound(pCtrl->Events)
+ if pCtrl->Events(ii).bIsSelected then
+ ' Determine the name of the event function
+ wszFunction = wszFormName
+ if pCtrl->ControlType <> CTRL_FORM then wszFunction = wszFunction & "_" & wszCtrlName
+ wszFunction = wszFunction & "_" & pCtrl->Events(ii).wszEventName
+
+ if ucase(pCtrl->Events(ii).wszEventName) = "MESSAGEPUMPHOOK" then
+ wszPrototype = "Function " & wszFunction & "( byval lpMSG as MSG ptr ) as boolean" & vbcrlf & vbcrlf
+ else
+ ' Define the function prototype/declaration
+ wszPrototype = "Function " & wszFunction & "( ByRef sender As " & _
+ GetWinformsXClassName(pCtrl->ControlType) & ", ByRef e As EventArgs ) As LRESULT" & vbcrlf
+ end if
+
+ ' Add the event/function to the list of declares
+ wszAllDeclares = wszAllDeclares & "Declare " & wszPrototype
+
+ ' Only check if we are not loading the project because the event handling
+ ' could already exist but just be in another source code file that has
+ ' not yet been loaded.
+ if (gApp.IsProjectLoading = false) andalso (gApp.IsFileLoading = false) then
+ pData = gdb2.dbFindFunction(wszFunction)
+ if pData = 0 THEN
+ wszAllEvents = wszAllEvents & "''" & vbcrlf & "''" & vbcrlf & _
+ wszPrototype & _
+ sp(1) & "Function = 0" & vbcrlf & _
+ "End Function" & vbcrlf & vbcrlf
+ end if
+ end if
+ end if
+ next
+ end if
+ next
+
+
+ ''
+ '' Generate the TYPE definition for the Form
+ ''
+ wszText = wszText & wszAllDeclares & iif(len(wszAllDeclares), vbcrlf, "") & _
+ "type " & wszFormName & "Type extends wfxForm" & vbcrlf & _
+ sp(1) & "private:" & vbcrlf & _
+ sp(2) & "temp as byte" & vbcrlf & _
+ sp(1) & "public:" & vbcrlf & _
+ sp(2) & "declare static function FormInitializeComponent( byval pForm as " & wszFormName & "Type ptr ) as LRESULT" & vbcrlf & _
+ sp(2) & "declare constructor" & vbcrlf & _
+ sp(2) & "' Controls" & vbcrlf
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl then
+ if pCtrl->ControlType = CTRL_FORM then continue for
+ wszCtrlName = GetControlProperty(pCtrl, "NAME")
+ wszText = wszText & sp(2) & wszCtrlName & " As " & GetWinformsXClassName(pCtrl->ControlType) & vbcrlf
+ end if
+ next
+ wszText = wszText & _
+ "end type" & vbcrlf & vbcrlf
+
+
+ ''
+ '' Generate the Constructor that defines the properties for the form and controls
+ ''
+ wszText = wszText & vbcrlf & _
+ "function " & wszFormName & "Type.FormInitializeComponent( byval pForm as " & wszFormName & "Type ptr ) as LRESULT" & vbcrlf & _
+ sp(1) & "dim as long nClientOffset" & vbcrlf & _
+ sp(1) & "pForm->SetInitialCtrlID(" & str(initialCtrlID) & " )" & vbcrlf & vbcrlf
+
+ ' If a menu exists for the Form then add the code generation
+ if pDoc->MainMenuExists then
+ wszText = wszText & GenerateMainMenuCode(pDoc)
+ end if
+
+ ' If a toolbar exists for the Form then add the code generation
+ if pDoc->ToolBarExists then
+ wszText = wszText & GenerateToolBarCode(pDoc)
+ end if
+
+ ' If a statusbar exists for the Form then add the code generation
+ if pDoc->StatusBarExists then
+ wszText = wszText & GenerateStatusBarCode(pDoc)
+ end if
+
+ ' If a TabControl exists to be code generated then we need to output
+ ' a variable that holds the tab page index. We do it here because inside
+ ' the For/Next would result in duplicate definition error.
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl then
+ if pCtrl->ControlType = CTRL_TABCONTROL then
+ wszText = wszText & sp(1) & "dim as long nTabIndex" & vbcrlf
+ exit for
+ end if
+ end if
+ next
+
+ ' Generate code for all of the controls
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+
+ if pCtrl then
+ wszCtrlName = GetControlProperty(pCtrl, "NAME")
+
+ wszCombinedName = "pForm->"
+ if pCtrl->ControlType <> CTRL_FORM then
+ wszCombinedName = wszCombinedName & **wszCtrlName
+ end if
+
+ if pCtrl->ControlType <> CTRL_FORM then
+ wszText = wszText & sp(1) & wszCombinedName & ".Parent = pForm" & vbcrlf
+ END IF
+
+ dim as long nLeft, nTop, nWidth, nHeight
+ for ii as long = lbound(pCtrl->Properties) to ubound(pCtrl->Properties)
+ wszPropName = pCtrl->Properties(ii).wszPropName
+ wszPropValue = pCtrl->Properties(ii).wszPropValue
+ wszPropDefault = pCtrl->Properties(ii).wszPropDefault
+ nPropType = pCtrl->Properties(ii).PropType
+
+ select case ucase(wszPropName)
+ CASE "LEFT"
+ nLeft = wszPropValue.ValLong
+ continue for
+ case "TOP"
+ nTop = wszPropValue.ValLong
+ continue for
+ case "WIDTH"
+ nWidth = wszPropValue.ValLong
+ continue for
+ case "HEIGHT"
+ nHeight = wszPropValue.ValLong
+ continue for
+ case "NAME"
+ wszPropDefault = "" ' force it to be output
+ case "TABINDEX"
+ continue for
+ END SELECT
+
+ if nPropType = PropertyType.CustomDialog then
+ if pCtrl->ControlType = CTRL_TABCONTROL then
+ frmVDTabChild_LoadTabPagesArray( wszPropValue )
+ for i as long = 0 to ubound(gTabPages)
+ wszText = wszText & sp(1) & _
+ "nTabIndex = " & wszCombinedName & ".TabPages.Add(" & _
+ DQ & gTabPages(i).wszText & DQ & "," & _
+ DQ & gTabPages(i).wszTabPage & DQ & "," & _
+ DQ & gTabPages(i).wszImage & DQ & "," & _
+ "0" & ")" & vbcrlf
+ if gTabPages(i).IsActiveTab then
+ wszText = wszText & sp(1) & _
+ wszCombinedName & ".SelectedIndex = nTabIndex" & vbcrlf
+ end if
+ next
+ ' Reset the global gTabPages array
+ erase gTabPages
+ continue for
+ end if
+ end if
+
+
+ ' Only output properties that are different than the default WinFormsX values
+ if ucase(wszPropValue) <> ucase(wszPropDefault) then
+ select case ucase(wszPropName)
+ case "TEXT", "TAG", "PASSWORDCHAR", "GROUPNAME", _
+ "MASKSTRING", "INPUTSTRING", "DEFAULTCHARACTER", "VALIDCHARACTERS", _
+ "ICON", "IMAGE", "CUEBANNERTEXT", "SELECTEDDATE", "SELECTEDTIME", _
+ "FORMATCUSTOM", "NAME", "TOOLTIP", "CHILDFORMPARENT"
+ ' Ensure that any embedded double quotes are escaped
+ wszPropValue = AfxStrReplace(wszPropValue, DQ, DQ & " & chr(34) & " & DQ)
+ wszPropValue = DQ & wszPropValue & DQ
+
+ ' TEXT properties for MultiLine Buttons would have embedded chr(10)
+ if pCtrl->ControlType = CTRL_BUTTON then
+ dim pPropMultiLine as clsProperty ptr
+ pPropMultiLine = GetControlPropertyPtr(pCtrl, "MULTILINE")
+ if pPropMultiLine then
+ if pPropMultiLine->wszPropValue = "True" then
+ wszPropValue = AfxStrReplace(wszPropValue, "{br}" , DQ & " & chr(10) & " & DQ)
+ end if
+ end if
+ end if
+ case "ACCEPTBUTTON", "CANCELBUTTON"
+ if len(rtrim(wszPropValue)) then
+ wszPropValue = "@pForm->" & wszPropValue
+ end if
+ end select
+ select case nPropType
+ CASE PropertyType.ColorPicker
+ if left(wszPropValue, 7) = "SYSTEM|" then
+ wszPropValue = "Colors.System" & mid(**wszPropValue, 8)
+ elseif left(wszPropValue, 7) = "COLORS|" then
+ wszPropValue = "Colors." & mid(**wszPropValue, 8)
+ elseif left(wszPropValue, 7) = "CUSTOM|" then
+ wszPropValue = mid(**wszPropValue, 8) & " ' custom color"
+ end if
+ case PropertyType.AnchorPicker
+ wszPropValue = chr(34) & wszPropValue & chr(34)
+ case PropertyType.FontPicker
+ wszPropValue = "New wfxFont(" & SetFontClassFromPropValue(wszPropValue) & ")"
+ END SELECT
+
+ if pCtrl->ControlType = CTRL_FORM then
+ wszText = wszText & sp(1) & wszCombinedName & wszPropName & " = " & wszPropValue & vbcrlf
+ else
+ wszText = wszText & sp(1) & wszCombinedName & "." & wszPropName & " = " & wszPropValue & vbcrlf
+ end if
+ end if
+ NEXT
+ if pCtrl->ControlType = CTRL_FORM then
+ wszText = wszText & sp(1) & wszCombinedName & "SetBounds(" & nLeft & "," & nTop & "," & nWidth & "," & nHeight & ")" & vbcrlf
+ else
+ wszText = wszText & sp(1) & wszCombinedName & ".SetBounds(" & nLeft & "," & nTop & "-nClientOffset," & nWidth & "," & nHeight & ")" & vbcrlf
+ end if
+
+
+ for ii as long = lbound(pCtrl->Events) to ubound(pCtrl->Events)
+ if pCtrl->Events(ii).bIsSelected then
+ ' Determine the name of the event function
+ wszFunction = wszFormName
+ if pCtrl->ControlType <> CTRL_FORM then wszFunction = wszFunction & "_" & wszCtrlName
+ wszFunction = wszFunction & "_" & pCtrl->Events(ii).wszEventName
+ if pCtrl->ControlType = CTRL_FORM then
+ wszText = wszText & sp(1) & wszCombinedName & "On" & pCtrl->Events(ii).wszEventName & " = @" & wszFunction & vbcrlf
+ else
+ wszText = wszText & sp(1) & wszCombinedName & ".On" & pCtrl->Events(ii).wszEventName & " = @" & wszFunction & vbcrlf
+ end if
+ end if
+ next
+
+ end if
+ next
+
+
+ ''
+ '' Add the controls to the form collection (we first need to sort based on TabIndex).
+ ''
+ dim pProp as clsProperty ptr
+ dim TabOrder(pDoc->Controls.Count) as TABORDER_TYPE
+ dim nTabIndex as Long
+
+ ' Load the temporary array
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl then
+ TabOrder(i).pCtrl = pCtrl
+ pProp = GetControlPropertyPtr(pCtrl, "TABINDEX")
+ if pProp then
+ nTabIndex = val(pProp->wszPropValue)
+ pProp = GetControlPropertyPtr(pCtrl, "TABSTOP")
+ if pProp = 0 then nTabIndex = 999999
+ else
+ nTabIndex = 999999
+ end if
+ TabOrder(i).TabIndex = nTabIndex
+ end if
+ next
+
+
+ ' Sort the array using a simple bubble sort
+ Dim As Long lb = LBound(TabOrder)
+ Dim As Long ub = UBound(TabOrder)
+ Dim As boolean bHasChanged
+ Do
+ bHasChanged = false
+ For i as long = lb To ub - 1
+ If TabOrder(i).TabIndex > TabOrder(i+1).TabIndex Then
+ Swap TabOrder(i), TabOrder(i+1)
+ bHasChanged = true
+ End If
+ Next
+ Loop Until bHasChanged = false
+
+ ' Finally, output the controls
+ dim as CWSTR wszGroupName, wszTemp
+ for i as long = lb to ub
+ pCtrl = TabOrder(i).pCtrl
+ if pCtrl then
+ if pCtrl->ControlType <> CTRL_FORM then
+ ' If this is an optionbutton then add a group for each change in the
+ ' groupname value.
+ wszCtrlName = GetControlProperty(pCtrl, "NAME")
+ if pCtrl->ControlType = CTRL_OPTION then
+ wszTemp = ucase(GetControlProperty(pCtrl, "GROUPNAME"))
+ if wszTemp <> wszGroupName then
+ wszText = wszText & _
+ sp(1) & "pForm->" & wszCtrlName & ".StartGroup = True" & vbcrlf
+ wszGroupName = wszTemp
+ end if
+ end if
+ wszText = wszText & _
+ sp(1) & "pForm->Controls.Add(ControlType." & GetToolBoxName(pCtrl->ControlType) & ", @(pForm->" & wszCtrlName & "))" & vbcrlf
+ end if
+ end if
+ next
+
+ ''
+ '' Add the form to the application
+ ''
+ wszText = wszText & _
+ sp(1) & "Application.Forms.Add(ControlType.Form, pForm)" & vbcrlf & _
+ sp(1) & "function = 0" & vbcrlf & _
+ "end function" & vbcrlf & vbcrlf
+
+
+ wszText = wszText & _
+ "constructor " & wszFormName & "Type" & vbcrlf & _
+ sp(1) & "InitializeComponent = cast( any ptr, @FormInitializeComponent )" & vbcrlf & _
+ sp(1) & "this.FormInitializeComponent( @this )" & vbcrlf & _
+ "end constructor" & vbcrlf & vbcrlf
+
+ wszText = wszText & _
+ "dim shared " & wszFormName & " as " & wszFormName & "Type" & vbcrlf
+
+ wszCodeGen = wszText & vbcrlf
+
+ dim as any ptr pSci = pDoc->GetActiveScintillaPtr()
+ if pSci <> 0 then
+ if SciMsg( pSci, SCI_GETLENGTH, 0 , 0) = 0 then
+ ' If this is the first time generating code then add the boilerplate code
+ ' to start the application and show the form.
+ dim as CWSTR wszHeader
+ if gApp.IsProjectActive = false then
+ wszHeader = wszHeader & _
+ "' You should always include a resource file that references a valid manifest.xml" & vbcrlf & _
+ "' file otherwise your application will not properly display Windows themed controls." & vbcrlf & _
+ "' Sample resource.rc and manifest.xml files can be found in the WinFBE \Settings folder." & vbcrlf & _
+ "' The following WinFBE directive includes the resource in your application. Simply" & vbcrlf & _
+ "' uncomment the line." & vbcrlf & _
+ "' If you are using WinFBE's project management features then delete the following line" & vbcrlf & _
+ "' because a resource file will be generated automatically." & vbcrlf & _
+ "' '#RESOURCE " & DQ & "resource.rc" & DQ & vbcrlf & vbcrlf
+ END IF
+
+
+ wszHeader = wszHeader & vbcrlf & _
+ "''" & vbcrlf & _
+ "'' Remove the following Application.Run code if it used elsewhere in your application." & vbcrlf
+ ' Do a check to see if Application.Run already exists in the project. If it does then
+ ' comment out the Application.Run
+ dim as long TotalAppRunCount = 0
+ dim as clsDocument ptr pDocSearch = gApp.pDocList
+ do until pDocSearch = 0
+ if pDocSearch->AppRunCount > 0 then
+ TotalAppRunCount = TotalAppRunCount + pDocSearch->AppRunCount
+ exit do
+ end if
+ pDocSearch = pDocSearch->pDocNext
+ loop
+ wszHeader = wszHeader & _
+ iif(TotalAppRunCount > 0, "'", "") & _
+ "Application.Run(" & wszFormName & ")" & vbcrlf & vbcrlf
+
+ if pDoc->IsNewFlag then
+ pDoc->AppendText(wszHeader)
+ end if
+ end if
+ end if
+
+ ' If any new Events were discovered then append them to the code editor
+ if len(wszAllEvents) then
+ pDoc->AppendText( wszAllEvents )
+ pDoc->bNeedsParsing = true
+ pDoc->ParseDocument()
+ END IF
+
+ ' Save the generated codegen code because we will output it to a disk file
+ pDoc->wszFormCodeGen = wszCodeGen
+ pDoc->bRegenerateCode = false
+
+ function = 0
+end function
+
diff --git a/src/modMRU.bi b/src/modMRU.bi
index 9c363d7e..ac440b46 100644
--- a/src/modMRU.bi
+++ b/src/modMRU.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modMRU.bi.bak b/src/modMRU.bi.bak
new file mode 100644
index 00000000..9c363d7e
--- /dev/null
+++ b/src/modMRU.bi.bak
@@ -0,0 +1,24 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+declare Function updateMRUFilesItems() as long
+declare Function updateMRUProjectFilesItems() as long
+declare Function OpenMRUFile( ByVal HWnd As HWnd, ByVal wID As Long ) As Long
+declare Function ClearMRUlist( ByVal wID As Long ) As Long
+declare Function UpdateMRUList( Byref wzFilename As WString ) As Long
+declare Function OpenMRUProjectFile( ByVal HWnd As HWnd, ByVal wID As Long) As Long
+declare Function UpdateMRUProjectList( Byval wszFilename As CWSTR ) As Long
+
+
diff --git a/src/modMRU.inc b/src/modMRU.inc
index 0fb8f850..e49e9cc1 100644
--- a/src/modMRU.inc
+++ b/src/modMRU.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modMRU.inc.bak b/src/modMRU.inc.bak
new file mode 100644
index 00000000..0fb8f850
--- /dev/null
+++ b/src/modMRU.inc.bak
@@ -0,0 +1,278 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modMRU.bi"
+
+''
+''
+private function clearMRUFilesItems( byval nParentID as long ) as long
+ ' clear out any existing items that match the nParentID so that they can be
+ ' reused when the MRU popup menu is created and shown. This function is used
+ ' for Files and Projects and UserTools MRU lists.
+ for i as long = lbound(gTopMenu) to ubound(gTopMenu)
+ if gTopMenu(i).nParentID = nParentID then
+ gTopMenu(i).nParentID = 0
+ gTopMenu(i).nID = 0
+ gTopMenu(i).nChildID = 0
+ end if
+ next
+ function = 0
+end function
+
+''
+''
+private function getNextFreeMRUindex() as long
+ ' gets the first available free MRU index in the gTopMenu array. If there are
+ ' none free then the gTopMenu array is extended and that index is returned. This
+ ' function is used for both Files and Projects MRU lists.
+ dim as long nFoundAt = -1
+ for i as long = lbound(gTopMenu) to ubound(gTopMenu)
+ if gTopMenu(i).nParentID = 0 then return i
+ next
+ if nFoundAt = -1 then
+ nFoundAt = ubound(gTopMenu) + 1
+ redim preserve gTopMenu(nFoundAt) as TOPMENU_TYPE
+ end if
+ function = nFoundAt
+end function
+
+
+''
+''
+public Function updateMRUFilesItems() as long
+ ' clear MRU items already existing in the gTopMenu array. We overwrite and extend
+ ' the gTopMenu array rather than erase it because existing menus depend on the
+ ' array index that aready exist. The function also returns the width to use for
+ ' the resulting popup menu (based on text width metrics of each filename).
+ clearMRUFilesItems( IDM_MRU )
+
+ dim wszText as WSTRING * 256
+ dim as boolean hasMRUfiles = false
+ dim as long txtWidth = 0
+ dim as long nMenuWidth = -1
+
+ For i As Long = 0 To 9
+ ' If the file no longer exists then remove it from the MRU list
+ gConfig.MRU(i) = ProcessFromCurdriveApp( gConfig.MRU(i) )
+ If AfxFileExists( gConfig.MRU(i) ) = 0 Then
+ gConfig.MRU(i) = ""
+ Else
+ hasMRUfiles = true
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_MRU, IDM_MRUBASE + i, 0, false, false )
+ wszText = gConfig.MRU(i)
+ txtWidth = getTextWidth( HWND_FRMMAIN_MENUBAR, wszText, ghMenuBar.hFontMenuBar, 30 )
+ if txtWidth > nMenuWidth then nMenuWidth = txtWidth
+ End If
+ Next
+
+ if hasMRUfiles = false then
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_MRU, IDM_MRUFILES, 0, false, false ) ' (empty)
+ else
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_MRU, IDM_MRUFILES, 0, false, true )
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_MRU, IDM_MRUCLEAR, 0, false, false )
+ end if
+
+ function = nMenuWidth
+end function
+
+
+''
+''
+public Function updateMRUProjectFilesItems() as long
+ ' clear MRU items already existing in the gTopMenu array. We overwrite and extend
+ ' the gTopMenu array rather than erase it because existing menus depend on the
+ ' array index that aready eist.
+ clearMRUFilesItems( IDM_MRUPROJECT )
+
+ dim wszText as WSTRING * 256
+ dim as boolean hasMRUfiles = false
+ dim as long txtWidth = 0
+ dim as long nMenuWidth = -1
+
+ For i As Long = 0 To 9
+ ' If the file no longer exists then remove it from the MRU list
+ gConfig.MRUPROJECT(i) = ProcessFromCurdriveApp( gConfig.MRUPROJECT(i) )
+ If AfxFileExists( gConfig.MRUPROJECT(i) ) = 0 Then
+ gConfig.MRUPROJECT(i) = ""
+ Else
+ hasMRUfiles = true
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_MRUPROJECT, IDM_MRUPROJECTBASE + i, 0, false, false )
+ wszText = gConfig.MRUPROJECT(i)
+ txtWidth = getTextWidth( HWND_FRMMAIN_MENUBAR, wszText, ghMenuBar.hFontMenuBar, 30 )
+ if txtWidth > nMenuWidth then nMenuWidth = txtWidth
+ End If
+ Next
+
+ if hasMRUfiles = false then
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_MRUPROJECT, IDM_MRUPROJECTFILES, 0, false, false ) ' (empty)
+ else
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_MRUPROJECT, IDM_MRUPROJECTFILES, 0, false, true )
+ setTopMenuMRUItem( getNextFreeMRUindex(), IDM_MRUPROJECT, IDM_MRUPROJECTCLEAR, 0, false, false )
+ end if
+
+ function = nMenuWidth
+end function
+
+
+''
+''
+public function OpenMRUFile( byval HWnd As HWnd, _
+ byval wID As long _
+ ) as long
+ dim wszFile as WString * MAX_PATH
+ dim pDoc as clsDocument ptr
+ dim pDocIn as clsDocument ptr
+ wszFile = gConfig.MRU(wID - IDM_MRUBASE)
+
+ ' If file is already loaded then simply switch to that file
+ ' within the editor.
+ pDocIn = gApp.GetDocumentPtrByFilename( wszFile )
+
+ pDoc = frmMain_OpenFileSafely( _
+ HWND_FRMMAIN, _
+ false, _ ' bIsNewFile
+ false, _ ' bIsTemplate
+ true, _ ' bShowInTab
+ false, _ ' bIsInclude
+ wszFile, _ ' wszName
+ pDocIn, _ ' pDocIn
+ IsFormFilename(wszFile) _
+ )
+
+ ' Give this document a default project type depending on its file extension
+ if (pDoc->IsNewFlag = false) andalso (pDoc->ProjectFileType = FILETYPE_UNDEFINED) then
+ if ( gApp.IsProjectActive = true ) orelse ( gApp.IsProjectLoading = true ) then
+ if pDoc->IsDesigner then
+ pDoc->ProjectFileType = FILETYPE_NORMAL
+ else
+ gApp.ProjectSetFileType( pDoc, pDoc->ProjectFileType )
+ end if
+ end if
+ end if
+
+ LoadExplorerFiles()
+ LoadFunctionsFiles()
+
+ function = 0
+end function
+
+
+''
+''
+public Function ClearMRUlist( ByVal wID As Long ) As Long
+ Select Case wID
+ Case IDM_MRUCLEAR
+ For i as long = 0 To 9
+ gConfig.MRU(i) = ""
+ Next
+ Case IDM_MRUPROJECTCLEAR
+ For i as long = 0 To 9
+ gConfig.MRUPROJECT(i) = ""
+ Next
+ End Select
+ Function = 0
+End Function
+
+
+''
+''
+public Function UpdateMRUList( Byref wzFilename As WString ) As Long
+
+ Dim idxExistsAt as Long = -1 ' index of where filename already exists
+ Dim i as Long
+ Dim wzFile As WString * MAX_PATH
+
+ if gApp.IsProjectLoading then exit function
+
+ ' Search the 10 MRU items to see if the filename already exists and
+ ' also for an available entry to put the filename in.
+ For i = 0 To 9
+ wzFile = gConfig.MRU(i)
+ wzFile = ProcessFromCurdriveApp(wzFile)
+ If Ucase(wzFile) = Ucase(wzFilename) Then
+ idxExistsAt = i: Exit For
+ End If
+ Next
+
+ ' If does not already exist then we simply need to move all entries
+ ' down and add at the beginning of the list. The original 10th entry
+ ' will now drop off the list.
+ If idxExistsAt = -1 Then idxExistsAt = 9
+
+ For i = idxExistsAt To 1 Step -1
+ gConfig.MRU(i) = gConfig.MRU(i-1)
+ Next
+ gConfig.MRU(0) = wzFilename
+
+ ' Save the MRU to the configuration file. Only write the MRU items
+ ' the ini file rather than overwriting the whole file. This enables
+ ' WinFBE to work better with external tools that manually modify the
+ ' WinFBE.ini file.
+ gConfig.WriteMRU
+
+ Function = 0
+End Function
+
+
+
+'' PROJECTS ''
+
+''
+''
+public Function OpenMRUProjectFile( ByVal HWnd As HWnd, _
+ ByVal wID As Long _
+ ) As Long
+ Dim wzFile As WString * MAX_PATH
+ wzFile = gConfig.MRUPROJECT(wID - IDM_MRUPROJECTBASE)
+ frmMain_OpenProjectSafely(HWnd, wzFile)
+ Function = 0
+End Function
+
+
+''
+''
+public Function UpdateMRUProjectList( Byval wszFilename As CWSTR ) As Long
+
+ Dim idxExistsAt As Long = -1 ' index of where filename already exists
+ Dim i As Long
+
+ ' Search the 10 MRU items to see if the filename already exists and
+ ' also for an available entry to put the filename in.
+ For i = 0 To 9
+ gConfig.MRUProject(i) = ProcessFromCurdriveApp(gConfig.MRUProject(i))
+ If Ucase(gConfig.MRUProject(i)) = Ucase(wszFilename) Then
+ idxExistsAt = i: Exit For
+ End If
+ Next
+
+ ' If does not already exist then we simply need to move all entries
+ ' down and add at the beginning of the list. The original 10th entry
+ ' will now drop off the list.
+ If idxExistsAt = -1 Then idxExistsAt = 9
+
+ For i = idxExistsAt To 1 Step -1
+ gConfig.MRUProject(i) = gConfig.MRUProject(i-1)
+ Next
+ gConfig.MRUProject(0) = wszFilename
+
+ ' Save the MRU to the configuration file. Only write the MRU items
+ ' the ini file rather than overwriting the whole file. This enables
+ ' WinFBE to work better with external tools that manually modify the
+ ' WinFBE.ini file.
+ gConfig.WriteMRUProjects
+
+ Function = 0
+End Function
+
+
+
diff --git a/src/modMenuDefinitions.inc b/src/modMenuDefinitions.inc
index cc2ff6b5..30bedb88 100644
--- a/src/modMenuDefinitions.inc
+++ b/src/modMenuDefinitions.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modMenuDefinitions.inc.bak b/src/modMenuDefinitions.inc.bak
new file mode 100644
index 00000000..cc2ff6b5
--- /dev/null
+++ b/src/modMenuDefinitions.inc.bak
@@ -0,0 +1,435 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modMRU.bi"
+#include once "frmKeyboard.bi"
+
+' ========================================================================================
+' Get the menu accelerator text (if one exists) for this menu item
+' ========================================================================================
+function getMenuAccelText( byval idMenu as long ) As CWSTR
+ dim as CWSTR wszAccel
+ ' Search the gKeys array for a match
+ for i as long = lbound(gKeys) to ubound(gKeys)
+ if gKeys(i).idAction = idMenu then
+ if len(gKeys(i).wszUserKeys) then
+ wszAccel = gKeys(i).wszUserKeys
+ else
+ if gKeys(i).bDefaultDisabled = false then
+ wszAccel = gKeys(i).wszDefaultKeys
+ end if
+ end if
+ exit for
+ end if
+ next
+
+ if len(wszAccel) then wszAccel = chr(9) & wszAccel
+ return wszAccel
+end function
+
+' ========================================================================================
+' Get the menu text based on the incoming control id
+' ========================================================================================
+Function getMenuText( byval idMenu as long ) As CWSTR
+ dim as CWSTR wszText
+ select case idMenu
+ case 0: return "-" ' this is a separator line
+ case IDC_MENUBAR_FILE: wszText = L(2,"&File")
+ case IDC_MENUBAR_EDIT: wszText = L(14,"Edit")
+ case IDC_MENUBAR_SEARCH: wszText = L(42,"Search")
+ case IDC_MENUBAR_VIEW: wszText = L(54,"View")
+ case IDC_MENUBAR_PROJECT: wszText = L(63,"Project")
+ case IDC_MENUBAR_COMPILE: wszText = L(64,"Compile")
+ case IDC_MENUBAR_DESIGNER: wszText = L(309,"Designer")
+ case IDC_MENUBAR_HELP: wszText = L(73,"Help")
+ case IDM_FILENEW: wszText = L(3,"New")
+ case IDM_FILEOPEN: wszText = L(4,"Open") & "..."
+ case IDM_FILEOPENTEMPLATES: wszText = L(197,"Open Templates") & "..."
+ case IDM_MRU: return L(10,"Open Recent")
+ case IDM_MRUBASE to IDM_MRUBASE + 9: return gConfig.MRU( idMenu - IDM_MRUBASE )
+ case IDM_MRUCLEAR: return L(225, "Clear this list")
+ case IDM_MRUFILES: return L(11,"(Empty)")
+ case IDM_FILECLOSE: wszText = L(5,"Close")
+ case IDM_FILECLOSEALL: wszText = L(6,"Close All")
+ case IDM_FILESAVE: wszText = L(7,"Save")
+ case IDM_FILESAVEAS: wszText = L(8,"Save As") & "..."
+ case IDM_FILESAVEAS: wszText = L(8,"Save As") & "..."
+ case IDM_FILESAVEALL: wszText = L(9,"Save All")
+ case IDM_AUTOSAVE: wszText = L(427,"Auto Save")
+ case IDM_SAVESESSION: wszText = L(425,"Save Session") & "..."
+ case IDM_LOADSESSION: wszText = L(426,"Load Session") & "..."
+ case IDM_KEYBOARDSHORTCUTS: wszText = L(220,"Keyboard Shortcuts") & "..."
+ case IDM_USERTOOLS: return L(289,"User Tools")
+ case IDM_USERTOOLSDIALOG: wszText = L(289,"User Tools") & "..."
+ case IDM_USERTOOLSBASE to IDM_USERTOOLSBASE + ubound(gConfig.Tools)
+ dim as CWSTR wszText = gConfig.Tools(idMenu - IDM_USERTOOLSBASE).wszDescription
+ dim as CWSTR wszShortcut = createToolsMenuShortcut(idMenu - IDM_USERTOOLSBASE)
+ if len(wszShortcut) then wszText = wszText & chr(9) & wszShortcut
+ return wszText
+ case IDM_USERTOOLSLIST: return L(11,"(Empty)")
+ case IDM_OPTIONS: return L(288,"Preferences")
+ case IDM_OPTIONSDIALOG: wszText = L(62,"Environment Options") & "..."
+ case IDM_BUILDCONFIG: wszText = L(277,"Build Configurations") & "..."
+ case IDM_USERSNIPPETS: wszText = L(88,"User Snippets") & "..."
+ case IDM_CATEGORIES: wszText = L(436,"Explorer Categories") & "..."
+ case IDM_EXIT: wszText = L(13,"Exit")
+
+ case IDM_UNDO: wszText = L(15,"Undo")
+ case IDM_REDO: wszText = L(16,"Redo")
+ case IDM_CUT: wszText = L(17,"Cut")
+ case IDM_COPY: wszText = L(18,"Copy")
+ case IDM_PASTE: wszText = L(19,"Paste")
+ case IDM_DELETELINE: wszText = L(20,"Delete Line")
+ case IDM_FIND: wszText = L(43,"Find") & "..."
+ case IDM_FINDINFILES: wszText = L(257,"Find In Files") & "..."
+ case IDM_REPLACE: wszText = L(46,"Replace") & "..."
+ case IDM_COMMENTBLOCK: wszText = L(25,"Comment Block")
+ case IDM_UNCOMMENTBLOCK: wszText = L(26,"UnComment Block")
+ case IDM_DUPLICATELINE: wszText = L(28,"Duplicate Line")
+ case IDM_MOVELINEUP: wszText = L(29,"Move Line Up")
+ case IDM_MOVELINEDOWN: wszText = L(30,"Move Line Down")
+ case IDM_SELECTLINE: wszText = L(41,"Select Line")
+ case IDM_SELECTALL: wszText = L(40,"Select All")
+
+ case IDM_DEFINITION: wszText = L(47,"Sub/Function Definition")
+ case IDM_LASTPOSITION: wszText = L(48,"Last Position")
+ case IDM_GOTONEXTFUNCTION: wszText = L(84,"Next Function")
+ case IDM_GOTOPREVFUNCTION: wszText = L(85,"Previous Function")
+ case IDM_GOTOHEADERFILE: wszText = L(231,"Goto Header File")
+ case IDM_GOTOSOURCEFILE: wszText = L(232,"Goto Code File")
+ case IDM_GOTOMAINFILE: wszText = L(233,"Goto Main File")
+ case IDM_GOTORESOURCEFILE: wszText = L(234,"Goto Resource File")
+ case IDM_GOTO: wszText = L(49,"Goto Line") & "..."
+ case IDM_BOOKMARKTOGGLE: wszText = L(50,"Toggle Bookmark")
+ case IDM_BOOKMARKNEXT: wszText = L(51,"Next Bookmark")
+ case IDM_BOOKMARKPREV: wszText = L(52,"Previous Bookmark")
+ case IDM_BOOKMARKCLEARALL: wszText = L(53,"Clear Bookmarks")
+
+ case IDM_FOLDTOGGLE: wszText = L(55,"Toggle Current Fold Point")
+ case IDM_FOLDBELOW: wszText = L(56,"Toggle Current And All Below")
+ case IDM_FOLDALL: wszText = L(57,"Fold All")
+ case IDM_UNFOLDALL: wszText = L(58,"Unfold All")
+ case IDM_ZOOMIN: wszText = L(59,"Zoom In")
+ case IDM_ZOOMOUT: wszText = L(60,"Zoom Out")
+ case IDM_BOOKMARKSLIST: wszText = L(443,"View Bookmarks List")
+ case IDM_FUNCTIONLIST: wszText = L(221,"View Function List")
+ case IDM_VIEWEXPLORER: wszText = L(250,"View Explorer Window")
+ case IDM_VIEWOUTPUT: wszText = L(251,"View Output Window")
+ case IDM_VIEWTODO: wszText = L(263,"TODO")
+ case IDM_VIEWNOTES: wszText = L(264,"Notes")
+ case IDM_RESTOREMAIN: wszText = L(61,"Restore Main Window Size")
+
+ case IDM_PROJECTNEW: wszText = L(180,"New Project")
+ case IDM_PROJECTOPEN: wszText = L(182,"Open Project") & "..."
+ case IDM_MRUPROJECT: wszText = L(219,"Recent Projects")
+ case IDM_MRUPROJECTBASE to IDM_MRUPROJECTBASE + 9
+ return gConfig.MRUPROJECT( idMenu - IDM_MRUPROJECTBASE )
+ case IDM_MRUPROJECTCLEAR: return L(225, "Clear this list")
+ case IDM_MRUPROJECTFILES: return L(11,"(Empty)")
+ case IDM_PROJECTCLOSE: wszText = L(183,"Close Project")
+ case IDM_PROJECTSAVE: wszText = L(184,"Save Project")
+ case IDM_PROJECTSAVEAS: wszText = L(185,"Save Project As") & "..."
+ case IDM_PROJECTFILESADD: wszText = L(207,"Add Files to Project") & "..."
+ case IDM_PROJECTOPTIONS: wszText = L(186,"Project Options") & "..."
+
+ case IDM_BUILDEXECUTE: wszText = L(65,"Build And Execute")
+ case IDM_COMPILE: wszText = L(64,"Compile")
+ case IDM_REBUILDALL: wszText = L(268,"Rebuild All")
+ case IDM_QUICKRUN: wszText = L(285,"Quick Run")
+ case IDM_RUNEXE: wszText = L(67,"Run Executable")
+ case IDM_COMMANDLINE: wszText = L(68,"Command Line") & "..."
+
+ case IDM_NEWFORM: wszText = L(310,"New Form")
+ case IDM_VIEWTOOLBOX: wszText = L(311,"View Toolbox")
+ case IDM_TOGGLEVIEWCODE: wszText = L(382,"Toggle View Form/Code")
+ case IDM_ALIGN: wszText = L(315,"Align")
+ case IDM_ALIGNLEFTS: wszText = L(316,"Lefts")
+ case IDM_ALIGNCENTERS: wszText = L(317,"Centers")
+ case IDM_ALIGNRIGHTS: wszText = L(318,"Rights")
+ case IDM_ALIGNTOPS: wszText = L(319,"Tops")
+ case IDM_ALIGNMIDDLES: wszText = L(320,"Middles")
+ case IDM_ALIGNBOTTOMS: wszText = L(321,"Bottoms")
+ case IDM_MAKESAME: wszText = L(322,"Make Same Size")
+ case IDM_SAMEWIDTHS: wszText = L(323,"Widths")
+ case IDM_SAMEHEIGHTS: wszText = L(324,"Heights")
+ case IDM_SAMEBOTH: wszText = L(325,"Both")
+ case IDM_HORIZSPACING: wszText = L(265,"Horizontal Spacing")
+ case IDM_HORIZEQUAL: wszText = L(329,"Make Equal")
+ case IDM_HORIZINCREASE: wszText = L(330,"Increase")
+ case IDM_HORIZDECREASE: wszText = L(331,"Decrease")
+ case IDM_HORIZREMOVE: wszText = L(349,"Remove")
+ case IDM_VERTSPACING: wszText = L(284,"Vertical Spacing")
+ case IDM_VERTEQUAL: wszText = L(329,"Make Equal")
+ case IDM_VERTINCREASE: wszText = L(330,"Increase")
+ case IDM_VERTDECREASE: wszText = L(331,"Decrease")
+ case IDM_VERTREMOVE: wszText = L(349,"Remove")
+ case IDM_CENTER: wszText = L(332,"Center in Form")
+ case IDM_CENTERHORIZ: wszText = L(333,"Horizontally")
+ case IDM_CENTERVERT: wszText = L(334,"Vertically")
+ case IDM_CENTERBOTH: wszText = L(325,"Both")
+ case IDM_MENUEDITOR: wszText = L(312,"Menu Editor") & "..."
+ case IDM_TOOLBAREDITOR: wszText = L(313,"Toolbar Editor") & "..."
+ case IDM_STATUSBAREDITOR: wszText = L(314,"Statusbar Editor") & "..."
+ case IDM_IMAGEMANAGER: wszText = L(368,"Image Manager") & "..."
+ case IDM_SNAPLINES: wszText = L(365,"Enable SnapLines")
+ case IDM_LOCKCONTROLS: wszText = L(335,"Lock Controls")
+
+ case IDM_HELP: wszText = "FreeBASIC " & L(73,"Help")
+ case IDM_HELPWINFBE: wszText = "WinFBE Editor " & L(73,"Help")
+ case IDM_HELPWINFBX: wszText = "WinFBX Framework " & L(73,"Help")
+ case IDM_CHECKFORUPDATES: wszText = L(91,"Check for Updates")
+ case IDM_ABOUT: wszText = L(74,"About")
+
+ case else
+ return ""
+ end select
+
+ wszText = wszText & getMenuAccelText( idMenu )
+ return wszText
+end function
+
+
+' ========================================================================================
+' Set the values for one element in the gTopMenu TYPE array
+' ========================================================================================
+function setTopMenuItem( byval nParentID as long, _
+ byval nID as long, _
+ byval nChildID as long, _
+ byval isDisabled as boolean, _
+ byval isSeparator as boolean _
+ ) as long
+
+ redim preserve gTopMenu(ubound(gTopMenu)+1) as TOPMENU_TYPE
+ dim as long i = ubound(gTopMenu)
+
+ gTopMenu(i).nParentID = nParentID
+ gTopMenu(i).nID = nID
+ gTopMenu(i).nChildID = nChildID
+ gTopMenu(i).isDisabled = isDisabled
+ gTopMenu(i).isSeparator = isSeparator
+
+ function = 0
+
+end function
+
+' ========================================================================================
+' Set the values for one MRU element in the gTopMenu TYPE array
+' ========================================================================================
+function setTopMenuMRUItem( byval nIndex as long, _
+ byval nParentID as long, _
+ byval nID as long, _
+ byval nChildID as long, _
+ byval isDisabled as boolean, _
+ byval isSeparator as boolean _
+ ) as long
+ ' do sanity check to ensure that nIndex is within range
+ if (nIndex >= lbound(gTopMenu)) andalso (nIndex <= ubound(gTopMenu)) then
+ gTopMenu(nIndex).nParentID = nParentID
+ gTopMenu(nIndex).nID = nID
+ gTopMenu(nIndex).nChildID = nChildID
+ gTopMenu(nIndex).isDisabled = isDisabled
+ gTopMenu(nIndex).isSeparator = isSeparator
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Reurns a pointer to the gTopMenu TYPE array for the incoming nID
+' Used mostly during the painting of the line
+' ========================================================================================
+public function getTopMenuPtr( byval nID as long ) as TOPMENU_TYPE ptr
+ static dummy as TOPMENU_TYPE ' returned in case no match in order to avoid null pointer
+ for i as long = lbound(gTopMenu) to ubound(gTopMenu)
+ if gTopMenu(i).nID = nID then
+ return @gTopMenu(i)
+ end if
+ next
+ return @dummy
+end function
+
+
+
+function buildTopMenuDefinitions() as long
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_FILENEW, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_FILEOPEN, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_FILEOPENTEMPLATES, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_MRU, IDM_MRUFILES, false, false )
+
+ updateMRUFilesItems()
+
+ setTopMenuItem( IDC_MENUBAR_FILE, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_FILECLOSE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_FILECLOSEALL, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_FILESAVE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_FILESAVEAS, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_FILESAVEALL, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_AUTOSAVE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_LOADSESSION, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_SAVESESSION, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_KEYBOARDSHORTCUTS, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_USERTOOLS, IDM_USERTOOLSLIST, false, false )
+
+ updateUserToolsMenuItems()
+
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_OPTIONS, IDM_OPTIONSDIALOG, false, false )
+ setTopMenuItem( IDM_OPTIONS, IDM_OPTIONSDIALOG, 0, false, false )
+ setTopMenuItem( IDM_OPTIONS, IDM_BUILDCONFIG, 0, false, false )
+ setTopMenuItem( IDM_OPTIONS, IDM_USERSNIPPETS, 0, false, false )
+ setTopMenuItem( IDM_OPTIONS, IDM_CATEGORIES, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_FILE, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_FILE, IDM_EXIT, 0, false, false )
+
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_UNDO, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_REDO, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_CUT, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_COPY, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_PASTE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_DELETELINE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_FIND, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_FINDINFILES, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_REPLACE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_DUPLICATELINE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_MOVELINEUP, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_MOVELINEDOWN, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_COMMENTBLOCK, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_UNCOMMENTBLOCK, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_SELECTLINE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_EDIT, IDM_SELECTALL, 0, false, false )
+
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_DEFINITION, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_LASTPOSITION, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_GOTONEXTFUNCTION, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_GOTOPREVFUNCTION, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_GOTOHEADERFILE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_GOTOSOURCEFILE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_GOTOMAINFILE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_GOTORESOURCEFILE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_BOOKMARKTOGGLE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_BOOKMARKNEXT, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_BOOKMARKPREV, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_BOOKMARKCLEARALL, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_SEARCH, IDM_GOTO, 0, false, false )
+
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_VIEWEXPLORER, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_VIEWOUTPUT, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_FUNCTIONLIST, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_BOOKMARKSLIST, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_ZOOMIN, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_ZOOMOUT, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_FOLDTOGGLE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_FOLDBELOW, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_FOLDALL, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_UNFOLDALL, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_VIEW, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_VIEW, IDM_RESTOREMAIN, 0, false, false )
+
+ setTopMenuItem( IDC_MENUBAR_PROJECT, IDM_PROJECTNEW, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, IDM_PROJECTOPEN, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, IDM_MRUPROJECT, IDM_MRUPROJECTFILES, false, false )
+
+ updateMRUProjectFilesItems()
+
+ setTopMenuItem( IDC_MENUBAR_PROJECT, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, IDM_PROJECTCLOSE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, IDM_PROJECTSAVEAS, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, IDM_PROJECTSAVE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, IDM_PROJECTFILESADD, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_PROJECT, IDM_PROJECTOPTIONS, 0, false, false )
+
+ setTopMenuItem( IDC_MENUBAR_COMPILE, IDM_BUILDEXECUTE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_COMPILE, IDM_COMPILE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_COMPILE, IDM_REBUILDALL, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_COMPILE, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_COMPILE, IDM_QUICKRUN, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_COMPILE, IDM_RUNEXE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_COMPILE, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_COMPILE, IDM_COMMANDLINE, 0, false, false )
+
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_NEWFORM, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_VIEWTOOLBOX, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_TOGGLEVIEWCODE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_ALIGN, IDM_ALIGNLEFTS, false, false )
+ setTopMenuItem( IDM_ALIGN, IDM_ALIGNLEFTS, 0, false, false )
+ setTopMenuItem( IDM_ALIGN, IDM_ALIGNCENTERS, 0, false, false )
+ setTopMenuItem( IDM_ALIGN, IDM_ALIGNRIGHTS, 0, false, false )
+ setTopMenuItem( IDM_ALIGN, 0, 0, false, true )
+ setTopMenuItem( IDM_ALIGN, IDM_ALIGNTOPS, 0, false, false )
+ setTopMenuItem( IDM_ALIGN, IDM_ALIGNMIDDLES, 0, false, false )
+ setTopMenuItem( IDM_ALIGN, IDM_ALIGNBOTTOMS, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_MAKESAME, IDM_SAMEWIDTHS, false, false )
+ setTopMenuItem( IDM_MAKESAME, IDM_SAMEWIDTHS, 0, false, false )
+ setTopMenuItem( IDM_MAKESAME, IDM_SAMEHEIGHTS, 0, false, false )
+ setTopMenuItem( IDM_MAKESAME, 0, 0, false, true )
+ setTopMenuItem( IDM_MAKESAME, IDM_SAMEBOTH, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_HORIZSPACING, IDM_HORIZEQUAL, false, false )
+ setTopMenuItem( IDM_HORIZSPACING, IDM_HORIZEQUAL, 0, false, false )
+ setTopMenuItem( IDM_HORIZSPACING, 0, 0, false, true )
+ setTopMenuItem( IDM_HORIZSPACING, IDM_HORIZINCREASE, 0, false, false )
+ setTopMenuItem( IDM_HORIZSPACING, IDM_HORIZDECREASE, 0, false, false )
+ setTopMenuItem( IDM_HORIZSPACING, 0, 0, false, true )
+ setTopMenuItem( IDM_HORIZSPACING, IDM_HORIZREMOVE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_VERTSPACING, IDM_VERTEQUAL, false, false )
+ setTopMenuItem( IDM_VERTSPACING, IDM_VERTEQUAL, 0, false, false )
+ setTopMenuItem( IDM_VERTSPACING, 0, 0, false, true )
+ setTopMenuItem( IDM_VERTSPACING, IDM_VERTINCREASE, 0, false, false )
+ setTopMenuItem( IDM_VERTSPACING, IDM_VERTDECREASE, 0, false, false )
+ setTopMenuItem( IDM_VERTSPACING, 0, 0, false, true )
+ setTopMenuItem( IDM_VERTSPACING, IDM_VERTREMOVE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_CENTER, IDM_CENTERHORIZ, false, false )
+ setTopMenuItem( IDM_CENTER, IDM_CENTERHORIZ, 0, false, false )
+ setTopMenuItem( IDM_CENTER, IDM_CENTERVERT, 0, false, false )
+ setTopMenuItem( IDM_CENTER, 0, 0, false, true )
+ setTopMenuItem( IDM_CENTER, IDM_CENTERBOTH, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_MENUEDITOR, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_TOOLBAREDITOR, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_STATUSBAREDITOR, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_IMAGEMANAGER, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_SNAPLINES, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_DESIGNER, IDM_LOCKCONTROLS, 0, false, false )
+
+ setTopMenuItem( IDC_MENUBAR_HELP, IDM_HELP, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_HELP, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_HELP, IDM_HELPWINFBE, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_HELP, IDM_HELPWINFBX, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_HELP, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_HELP, IDM_CHECKFORUPDATES, 0, false, false )
+ setTopMenuItem( IDC_MENUBAR_HELP, 0, 0, false, true )
+ setTopMenuItem( IDC_MENUBAR_HELP, IDM_ABOUT, 0, false, false )
+
+ function = 0
+end function
diff --git a/src/modMenus.bi b/src/modMenus.bi
index d0d7a487..dea4dd68 100644
--- a/src/modMenus.bi
+++ b/src/modMenus.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modMenus.bi.bak b/src/modMenus.bi.bak
new file mode 100644
index 00000000..d0d7a487
--- /dev/null
+++ b/src/modMenus.bi.bak
@@ -0,0 +1,26 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+declare Function frmMain_BuildAcceleratorTable( ByVal pWindow As CWindow Ptr ) As long
+declare Function frmMain_ChangeTopMenuStates() As Long
+declare Function CreateStatusBarFileTypeContextMenu() As HMENU
+declare Function CreateStatusBarFileEncodingContextMenu() As HMENU
+declare function CreateTopTabCtlContextMenu( ByVal idx As Long ) As HMENU
+declare Function CreateExplorerContextMenu( ByVal pDoc As clsDocument Ptr ) As HMENU
+declare Function CreateScintillaContextMenu() As HMENU
+declare Function CreateStatusBarSpacesContextMenu() As HMENU
+declare Function CreateStatusBarLineEndingsContextMenu() As HMENU
+declare function getTopMenuPtr( byval nID as long ) as TOPMENU_TYPE ptr
+
diff --git a/src/modMenus.inc b/src/modMenus.inc
index ef71c52a..9d100add 100644
--- a/src/modMenus.inc
+++ b/src/modMenus.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modMenus.inc.bak b/src/modMenus.inc.bak
new file mode 100644
index 00000000..ef71c52a
--- /dev/null
+++ b/src/modMenus.inc.bak
@@ -0,0 +1,706 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modMenus.bi"
+
+' ========================================================================================
+' EnableTopMenuItem: basically my internal version of the EnableMenuItem api
+' ========================================================================================
+function EnableTopMenuItem( byval nID as long, byval bEnabled as boolean ) as long
+ dim p as TOPMENU_TYPE ptr = getTopMenuPtr(nID)
+ if p = 0 then exit function
+ if bEnabled = false then
+ p->isDisabled = true
+ else
+ p->isDisabled = false
+ end if
+ function = 0
+end function
+
+' ========================================================================================
+' CheckMarkTopMenuItem: Show a checkmark to the left of the menu entry
+' ========================================================================================
+function CheckMarkTopMenuItem( byval nID as long, byval bChecked as boolean ) as long
+ dim p as TOPMENU_TYPE ptr = getTopMenuPtr(nID)
+ if p = 0 then exit function
+ p->isChecked = bChecked
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable/Disable top menu items depending on application state
+' ========================================================================================
+function frmMain_FileTopMenuStates() as long
+
+ ' Start off by disabling everything in order to make things easier.
+ For idMenu as long = IDM_FILE_START To IDM_FILE_END
+ EnableTopMenuItem( idMenu, false )
+ Next
+
+ ' Items that will always be enabled.
+ EnableTopMenuItem( IDM_FILENEW, true )
+ EnableTopMenuItem( IDM_FILEOPEN, true )
+ EnableTopMenuItem( IDM_FILEOPENTEMPLATES, true )
+ EnableTopMenuItem( IDM_LOADSESSION, true )
+ EnableTopMenuItem( IDM_MRU, true )
+ EnableTopMenuItem( IDM_KEYBOARDSHORTCUTS, true )
+ EnableTopMenuItem( IDM_USERTOOLS, true )
+ EnableTopMenuItem( IDM_USERTOOLSDIALOG, true )
+ EnableTopMenuItem( IDM_OPTIONS, true )
+ EnableTopMenuItem( IDM_OPTIONSDIALOG, true )
+ EnableTopMenuItem( IDM_BUILDCONFIG, true )
+ EnableTopMenuItem( IDM_USERSNIPPETS, true )
+ EnableTopMenuItem( IDM_CATEGORIES, true )
+ EnableTopMenuItem( IDM_EXIT, true )
+ EnableTopMenuItem( IDM_AUTOSAVE, true )
+ CheckMarkTopMenuItem( IDM_AUTOSAVE, iif( gConfig.AutoSaveFiles, true, false ))
+
+ If gTTabCtl.GetItemCount() Then
+ For idMenu as long = IDM_FILECLOSE To IDM_SAVESESSION
+ EnableTopMenuItem( idMenu, true )
+ Next
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable/Disable top menu items depending on application state
+' ========================================================================================
+function frmMain_EditTopMenuStates() as long
+
+ ' Start off by disabling everything in order to make things easier.
+ For idMenu as long = IDM_EDIT_START To IDM_EDIT_END
+ EnableTopMenuItem( idMenu, false )
+ Next
+
+ ' If any documents exist in the editor then enable FindInFiles
+ if gApp.GetDocumentCount then EnableTopMenuItem( IDM_FINDINFILES, true )
+
+ ' Enable or disable specific edit menu items (based on the currently active document)
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 Then exit function
+
+ ' Enable/Disable if Visual Designer is active
+ if (pDoc->IsDesigner = true) andalso (IsDesignerView(pDoc) = true) THEN
+ ' Only re-enable the cut/copy if an actual control is selected.
+ if pDoc->Controls.SelectedControlsCount > 0 then
+ EnableTopMenuItem( IDM_CUT, true )
+ EnableTopMenuItem( IDM_COPY, true )
+ end if
+ EnableTopMenuItem( IDM_PASTE, true )
+ EnableTopMenuItem( IDM_SELECTALL, true )
+
+ else
+ ' A code editing window is active
+ If len(pDoc->GetSelText) Then
+ EnableTopMenuItem( IDM_CUT, true )
+ EnableTopMenuItem( IDM_COPY, true )
+ End If
+
+ dim as HWND hEdit = pDoc->hWndActiveScintilla
+ if SendMessage( hEdit, SCI_CANUNDO, 0, 0) then EnableTopMenuItem( IDM_UNDO, true )
+ if SendMessage( hEdit, SCI_CANREDO, 0, 0) then EnableTopMenuItem( IDM_REDO, true )
+ If SendMessage( hEdit, SCI_CANPASTE, 0, 0) then EnableTopMenuItem( IDM_PASTE, true )
+ For idMenu as long = IDM_DELETELINE To IDM_SELECTALL
+ EnableTopMenuItem( idMenu, true )
+ Next
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable/Disable top menu items depending on application state
+' ========================================================================================
+function frmMain_SearchTopMenuStates() as long
+
+ ' Start off by disabling everything in order to make things easier.
+ For idMenu as long = IDM_SEARCH_START To IDM_SEARCH_END
+ EnableTopMenuItem( idMenu, false )
+ Next
+
+ ' Enable or disable specific edit menu items (based on the currently active document)
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 Then exit function
+
+ For idMenu as long = IDM_DEFINITION To IDM_GOTOPREVFUNCTION
+ EnableTopMenuItem( idMenu, true )
+ Next
+
+ if gApp.GetMainDocumentPtr then EnableTopMenuItem( IDM_GOTOMAINFILE, true )
+ if gApp.GetResourceDocumentPtr then EnableTopMenuItem( IDM_GOTORESOURCEFILE, true )
+ if gApp.GetHeaderDocumentPtr(pDoc) then EnableTopMenuItem( IDM_GOTOHEADERFILE, true )
+ if gApp.GetSourceDocumentPtr(pDoc) then EnableTopMenuItem( IDM_GOTOSOURCEFILE, true )
+
+ For idMenu as long = IDM_BOOKMARKTOGGLE To IDM_GOTO
+ EnableTopMenuItem( idMenu, true )
+ Next
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable/Disable top menu items depending on application state
+' ========================================================================================
+function frmMain_ViewTopMenuStates() as long
+
+ ' Start off by disabling everything in order to make things easier.
+ For idMenu as long = IDM_VIEW_START To IDM_VIEW_END
+ EnableTopMenuItem( idMenu, false )
+ Next
+
+ EnableTopMenuItem( IDM_VIEWEXPLORER, true )
+ EnableTopMenuItem( IDM_VIEWOUTPUT, true )
+ EnableTopMenuItem( IDM_RESTOREMAIN, true )
+
+ CheckMarkTopMenuItem( IDM_VIEWEXPLORER, iif( IsWindowVisible(HWND_FRMEXPLORER), true, false ))
+ CheckMarkTopMenuItem( IDM_VIEWOUTPUT, iif( IsWindowVisible(HWND_FRMOUTPUT), true, false ))
+ CheckMarkTopMenuItem( IDM_FUNCTIONLIST, iif( IsWindowVisible(HWND_FRMFUNCTIONS), true, false ))
+ CheckMarkTopMenuItem( IDM_BOOKMARKSLIST, iif( IsWindowVisible(HWND_FRMBOOKMARKS), true, false ))
+
+ ' Enable or disable specific edit menu items (based on the currently active document)
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 Then exit function
+
+ EnableTopMenuItem( IDM_FUNCTIONLIST, true )
+ EnableTopMenuItem( IDM_BOOKMARKSLIST, true )
+
+ For idMenu as long = IDM_ZOOMIN To IDM_RESTOREMAIN
+ EnableTopMenuItem( idMenu, true )
+ Next
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable/Disable top menu items depending on application state
+' ========================================================================================
+function frmMain_ProjectTopMenuStates() as long
+
+ ' Start off by disabling everything in order to make things easier.
+ For idMenu as long = IDM_PROJECT_START To IDM_PROJECT_END
+ EnableTopMenuItem( idMenu, false )
+ Next
+
+ EnableTopMenuItem( IDM_PROJECTNEW, true )
+ EnableTopMenuItem( IDM_PROJECTOPEN, true )
+ EnableTopMenuItem( IDM_MRUPROJECT, true )
+
+ ' Check if a Project is open and active
+ Dim As Long fEnabled = Iif( gApp.IsProjectActive, true, false )
+ EnableTopMenuItem( IDM_PROJECTCLOSE, fEnabled )
+ EnableTopMenuItem( IDM_PROJECTSAVEAS, fEnabled )
+ EnableTopMenuItem( IDM_PROJECTSAVE, fEnabled )
+ EnableTopMenuItem( IDM_PROJECTFILESADD, fEnabled )
+ EnableTopMenuItem( IDM_PROJECTOPTIONS, fEnabled )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable/Disable top menu items depending on application state
+' ========================================================================================
+function frmMain_CompileTopMenuStates() as long
+
+ ' Start off by disabling everything in order to make things easier.
+ For idMenu as long = IDM_COMPILE_START To IDM_COMPILE_END
+ EnableTopMenuItem( idMenu, false )
+ Next
+
+ dim as boolean fEnabled = iif( gApp.IsProjectActive orelse cbool(gTTabCtl.GetItemCount), true, false )
+ EnableTopMenuItem( IDM_BUILDEXECUTE, fEnabled )
+ EnableTopMenuItem( IDM_COMPILE, fEnabled )
+ EnableTopMenuItem( IDM_REBUILDALL, fEnabled )
+ EnableTopMenuItem( IDM_COMMANDLINE, fEnabled )
+
+ ' QuickRun should be enabled for non-Projects
+ If gApp.IsProjectActive = false then
+ if gTTabCtl.GetItemCount then EnableTopMenuItem( IDM_QUICKRUN, true )
+ end if
+
+ ' Determine if an executable exists based on the current active file or project
+ dim as CWSTR wszRunFile = GetRunExecutableFilename()
+ If AfxFileExists(wszRunFile) Then EnableTopMenuItem( IDM_RUNEXE, true )
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable/Disable top menu items depending on application state
+' ========================================================================================
+function frmMain_DesignerTopMenuStates() as long
+
+ ' Start off by disabling everything in order to make things easier.
+ For idMenu as long = IDM_DESIGNER_START To IDM_DESIGNER_END
+ EnableTopMenuItem( idMenu, false )
+ Next
+
+ EnableTopMenuItem( IDM_NEWFORM, true )
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 Then exit function
+
+ ' Enable if Visual Designer is active
+ if pDoc->IsDesigner then
+ EnableTopMenuItem( IDM_VIEWTOOLBOX, true )
+ EnableTopMenuItem( IDM_TOGGLEVIEWCODE, true )
+ EnableTopMenuItem( IDM_MENUEDITOR, true )
+ EnableTopMenuItem( IDM_TOOLBAREDITOR, true )
+ EnableTopMenuItem( IDM_STATUSBAREDITOR, true )
+ EnableTopMenuItem( IDM_IMAGEMANAGER, true )
+ end if
+
+ ' Enable if Visual Designer is active AND design window has selected controls
+ if (pDoc->IsDesigner = true) andalso (IsDesignerView(pDoc) = true) THEN
+ ' Enable Align, Horiz, Vert, and Same Size if more than 1 control is selected.
+ if pDoc->Controls.SelectedControlsCount > 1 then
+ for idMenu as long = IDM_ALIGN to IDM_SAMEBOTH
+ EnableTopMenuItem( idMenu, true )
+ next
+ end if
+ ' Enable Center in Form if control(s) are selected
+ if pDoc->Controls.SelectedControlsCount THEN
+ for idMenu as long = IDM_CENTER to IDM_CENTERBOTH
+ EnableTopMenuItem( idMenu, true )
+ next
+ end if
+ EnableTopMenuItem( IDM_SNAPLINES, true )
+ EnableTopMenuItem( IDM_LOCKCONTROLS, true )
+ CheckMarkTopMenuItem( IDM_SNAPLINES, iif( pDoc->bSnapLines, true, false ) )
+ CheckMarkTopMenuItem( IDM_LOCKCONTROLS, iif( pDoc->bLockControls, true, false ) )
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable/Disable top menu items depending on application state
+' ========================================================================================
+function frmMain_HelpTopMenuStates() as long
+
+ ' All Help menu items are always enabled
+ For idMenu as long = IDM_HELP_START To IDM_HELP_END
+ EnableTopMenuItem( idMenu, true )
+ Next
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable/Disable top menu items depending on application state
+' ========================================================================================
+Function frmMain_ChangeTopMenuStates() As Long
+
+ select case GetDlgCtrlID( ghWndActiveMenuBarButton )
+ case IDC_MENUBAR_FILE: frmMain_FileTopMenuStates()
+ case IDC_MENUBAR_EDIT: frmMain_EditTopMenuStates()
+ case IDC_MENUBAR_SEARCH: frmMain_SearchTopMenuStates()
+ case IDC_MENUBAR_VIEW: frmMain_ViewTopMenuStates()
+ case IDC_MENUBAR_PROJECT: frmMain_ProjectTopMenuStates()
+ case IDC_MENUBAR_COMPILE: frmMain_CompileTopMenuStates()
+ case IDC_MENUBAR_DESIGNER: frmMain_DesignerTopMenuStates()
+ case IDC_MENUBAR_HELP: frmMain_HelpTopMenuStates()
+ end select
+
+ Function = 0
+End Function
+
+
+''
+''
+Function AddProjectFileTypesToMenu( _
+ ByVal hPopUpMenu As HMENU, _
+ ByVal pDoc As clsDocument Ptr, _
+ byval fSeparator as BOOLEAN, _
+ byval fExplorerTreeview as BOOLEAN _
+ ) As Long
+
+ Dim As HMENU hPopUpSubMenu
+
+ if fSeparator then AppendMenu( hPopUpMenu, MF_SEPARATOR, 0, "" )
+
+ dim messages(...) as long => _
+ { IDM_SETFILEMAIN, _
+ IDM_SETFILERESOURCE, _
+ IDM_SETFILEHEADER, _
+ IDM_SETFILEMODULE, _
+ IDM_SETFILENORMAL, _
+ IDM_SETFILEMAIN_EXPLORERTREEVIEW, _
+ IDM_SETFILERESOURCE_EXPLORERTREEVIEW, _
+ IDM_SETFILEHEADER_EXPLORERTREEVIEW, _
+ IDM_SETFILEMODULE_EXPLORERTREEVIEW, _
+ IDM_SETFILENORMAL_EXPLORERTREEVIEW, _
+ IDM_SETCATEGORY _
+ }
+
+ ' If we need to use the Explorer Treeview version of the messages then we
+ ' simply just increment our array starting index.
+ dim as long idx = iif( fExplorerTreeview, 5, 0 )
+
+ AppendMenu hPopUpMenu, MF_ENABLED Or MFT_RADIOCHECK, messages(idx + 0), L(206,"Main file")
+ AppendMenu hPopUpMenu, MF_ENABLED Or MFT_RADIOCHECK, messages(idx + 1), L(209,"Resource file")
+ AppendMenu hPopUpMenu, MF_ENABLED Or MFT_RADIOCHECK, messages(idx + 2), L(181,"Header file")
+ AppendMenu hPopUpMenu, MF_ENABLED Or MFT_RADIOCHECK, messages(idx + 3), L(205,"Module file")
+ AppendMenu hPopUpMenu, MF_ENABLED Or MFT_RADIOCHECK, messages(idx + 4), L(204,"Normal file")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ hPopUpSubMenu = CreatePopupMenu
+ AppendMenu hPopUpMenu, MF_POPUP Or MF_ENABLED, Cast(UINT_PTR, hPopUpSubMenu), L(439,"User Defined Categories")
+ for i as long = lbound(gConfig.Cat) to ubound(gConfig.Cat)
+ ' User defined categories will have an GUID id. Starts with an {
+ if left(gConfig.Cat(i).idFileType, 1) = "{" then
+ AppendMenu hPopUpSubMenu, MF_ENABLED or MFT_RADIOCHECK, IDM_SETCATEGORY + i, gConfig.Cat(i).wszDescription
+ end if
+ next
+
+ Dim nFileType As Long
+ Select Case pDoc->ProjectFileType
+ Case FILETYPE_MAIN: nFileType = messages(idx + 0)
+ Case FILETYPE_RESOURCE: nFileType = messages(idx + 1)
+ Case FILETYPE_HEADER: nFileType = messages(idx + 2)
+ Case FILETYPE_MODULE: nFileType = messages(idx + 3)
+ Case FILETYPE_NORMAL: nFileType = messages(idx + 4)
+ case else
+ ' The file is part of a User Defined Category so set a message
+ ' value that will not result in a checkmark in the code below.
+ nFileType = IDM_SETCATEGORY
+ End Select
+
+ ' Some of our available chocies are affected by the fact that multiple selections
+ ' in the explorer listbox may exist. In that case, we a default FileType selection
+ ' only when the selection count is 1
+ dim as long nSelCount = SendMessage( HWND_FRMEXPLORER_LISTBOX, LB_GETSELCOUNT, 0, 0 )
+ dim as long bAllowCheckMark = true
+ if (fExplorerTreeview = true) and (nSelCount > 1) then bAllowCheckMark = false
+ if bAllowCheckMark then
+ CheckMenuRadioItem( hPopupMenu, messages(idx + 0), messages(idx + 4), nFileType, MF_BYCOMMAND )
+ end if
+
+ Function = 0
+End Function
+
+
+''
+''
+Function CreateStatusBarFileTypeContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ If gApp.IsProjectActive Then
+ hPopUpMenu = CreatePopupMenu
+ AddProjectFileTypesToMenu( hPopUpMenu, pDoc, false, false )
+ End If
+ End If
+ Function = hPopupMenu
+End Function
+
+
+''
+''
+Function CreateStatusBarFileEncodingContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ hPopUpMenu = CreatePopupMenu
+ AppendMenu hPopUpMenu, MF_ENABLED or MFT_RADIOCHECK, IDM_ANSI, "ANSI"
+ AppendMenu hPopUpMenu, MF_ENABLED or MFT_RADIOCHECK, IDM_UTF8BOM, "UTF-8 (BOM)"
+ AppendMenu hPopUpMenu, MF_ENABLED or MFT_RADIOCHECK, IDM_UTF16BOM, "UTF-16 (BOM)"
+
+ Dim nEncoding As Long
+ Select Case pDoc->FileEncoding
+ Case FILE_ENCODING_ANSI: nEncoding = IDM_ANSI
+ Case FILE_ENCODING_UTF8_BOM: nEncoding = IDM_UTF8BOM
+ Case FILE_ENCODING_UTF16_BOM: nEncoding = IDM_UTF16BOM
+ End Select
+ CheckMenuRadioItem( hPopupMenu, IDM_ANSI, IDM_UTF16BOM, nEncoding, MF_BYCOMMAND )
+ End If
+
+ Function = hPopupMenu
+End Function
+
+
+''
+''
+Function CreateStatusBarSpacesContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ hPopUpMenu = CreatePopupMenu
+ for i as long = 0 to 8
+ dim as long idMenu = IDM_SPACES + i
+ dim as CWSTR wszCaption = str(i)
+ if i = val(gConfig.TabSize) then wszCaption = wszCaption & " (Current Tab Size)"
+ AppendMenu hPopUpMenu, MF_ENABLED or MFT_RADIOCHECK, idMenu, wszCaption
+ next
+ CheckMenuRadioItem( hPopupMenu, IDM_SPACES, IDM_SPACES+8, IDM_SPACES+gConfig.TabSize, MF_BYCOMMAND )
+ End If
+
+ Function = hPopupMenu
+End Function
+
+
+
+''
+''
+Function CreateStatusBarLineEndingsContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc Then
+ hPopUpMenu = CreatePopupMenu
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_EOLTOCRLF, L(36,"Convert to CRLF")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_EOLTOCR, L(37,"Convert to CR")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_EOLTOLF, L(38,"Convert to LF")
+ End If
+
+ Function = hPopupMenu
+End Function
+
+''
+''
+Function CreateTopTabCtlContextMenu( ByVal idx As Long ) As HMENU
+ Dim hPopUpMenu As HMENU
+ Dim hPopUpSubMenu As HMENU
+ Dim wszText As WString * MAX_PATH
+ Dim As Long CuriTab = gTTabCtl.CurSel
+ Dim As Long MaxiTab = gTTabCtl.GetItemCount - 1
+
+ hPopUpMenu = CreatePopupMenu
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILECLOSE, L(5,"Close")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILESAVE, L(7,"Save")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILESAVEAS, L(8,"Save As")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, iif(MaxiTab > 0, MF_ENABLED,MF_DISABLED), IDM_FILECLOSEALL, L(6,"Close All")
+ AppendMenu hPopUpMenu, iif(MaxiTab > 0, MF_ENABLED,MF_DISABLED), IDM_FILECLOSEALLOTHERS, L(354,"Close Others")
+ AppendMenu hPopUpMenu, iif(CuriTab > 0, MF_ENABLED,MF_DISABLED), IDM_CLOSEALLBACKWARD, L(355,"Close Tabs on the Left")
+ AppendMenu hPopUpMenu, iif(MaxiTab > CuriTab, MF_ENABLED,MF_DISABLED), IDM_CLOSEALLFORWARD, L(356,"Close Tabs on the Right")
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetDocumentPtr(idx)
+ If pDoc Then
+ If gApp.IsProjectActive = True Then
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ wszText = L(190, "Remove from project")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_REMOVEFILEFROMPROJECT, wszText
+ AddProjectFileTypesToMenu(hPopUpMenu, pDoc, true, false)
+ End If
+ End If
+
+ Function = hPopupMenu
+End Function
+
+
+''
+''
+Function CreateScintillaContextMenu() As HMENU
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 Then Exit Function
+
+ Dim hPopupMenu As HMENU
+ Dim hPopupSubMenu As HMENU
+ Dim pt As Point
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+
+ ' Ensure that the window under the cursor is actually a Scintilla window
+ ' and not another window like a tab in the top tabcontrol.
+ GetCursorPos(@pt)
+ ScreenToClient(HWND_FRMMAIN, @pt)
+
+ If RealChildWindowFromPoint(HWND_FRMMAIN, pt) <> hEdit Then Exit Function
+
+ hPopupMenu = CreatePopupMenu
+
+ ' Determine if the text under the cursor is an #Include file. If yes, then add a
+ ' menu option to allow to open it.
+ if IsCurrentLineIncludeFilename() then
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_OPENINCLUDE, L(75,"Open") + Chr(32, 34) + gApp.IncludeFilename + Chr(34)
+ AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
+ end if
+
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_UNDO, L(15,"Undo")
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_REDO, L(16,"Redo")
+ AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_CUT, L(17,"Cut")
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_COPY, L(18,"Copy")
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_PASTE, L(19,"Paste")
+ AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_INDENTBLOCK, L(23,"Block Indent")
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_UNINDENTBLOCK, L(24,"Block Unindent")
+ AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_COMMENTBLOCK, L(25,"Block Comment")
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_UNCOMMENTBLOCK, L(26,"Block Uncomment")
+ AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_SELECTALL, L(40,"Select All")
+
+ If (gApp.IsProjectActive = True) Then
+ AppendMenu hPopupMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopupMenu, MF_ENABLED, IDM_REMOVEFILEFROMPROJECT, L(190,"Remove from project")
+ AddProjectFileTypesToMenu(hPopUpMenu, pDoc, true, false)
+ End If
+
+ Function = hPopupMenu
+
+End Function
+
+
+
+''
+''
+Function CreateExplorerContextMenu(ByVal pDoc As clsDocument Ptr ) As HMENU
+
+ Dim wszText As WString * MAX_PATH
+ Dim hPopUpMenu As HMENU = CreatePopupMenu()
+
+ ' Some of our available chocies are affected by the fact that multiple selections
+ ' in the explorer listbox may exist. In that case, we allow options like "Close"
+ ' and also don't set a selected FileType.
+ dim as long nSelCount = SendMessage( HWND_FRMEXPLORER_LISTBOX, LB_GETSELCOUNT, 0, 0 )
+
+ ' if pDoc is zero then most likely we have right clicked on a Project or FILES root node
+ if pDoc THEN
+ If gApp.IsProjectActive Then
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILEOPEN_EXPLORERLISTBOX, L(75,"Open")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ if (gTTabCtl.GetTabIndexByDocumentPtr( pDoc ) <> -1) orelse (nSelCount > 0) then
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILECLOSE_EXPLORERLISTBOX, L(5,"Close")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ end if
+ if nSelCount = 1 then
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILESAVE_EXPLORERLISTBOX, L(7,"Save")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILESAVEAS_EXPLORERLISTBOX, L(8,"Save As")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ end if
+ wszText = L(190,"Remove from project")
+ AppendMenu( hPopUpMenu, MF_ENABLED, IDM_REMOVEFILEFROMPROJECT_EXPLORERLISTBOX, wszText )
+ AddProjectFileTypesToMenu(hPopUpMenu, pDoc, true, true)
+ Else
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILECLOSE_EXPLORERLISTBOX, L(5,"Close")
+ if nSelCount = 1 then
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILESAVE_EXPLORERLISTBOX, L(7,"Save")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FILESAVEAS_EXPLORERLISTBOX, L(8,"Save As")
+ end if
+ End If
+ END IF
+
+ Function = hPopupMenu
+
+End Function
+
+''
+''
+Function CreateExplorerActionButtonContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+ dim as CWSTR wszCaption
+
+ hPopUpMenu = CreatePopupMenu
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_EXPLORER_EXPANDALL, L(441,"Expand All")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_EXPLORER_COLLAPSEALL, L(442,"Collapse All")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_CLOSEPANEL, L(161,"Close")
+
+ Function = hPopupMenu
+End Function
+
+''
+''
+Function CreateFunctionsActionButtonContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+ dim as CWSTR wszCaption
+
+ hPopUpMenu = CreatePopupMenu
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FUNCTIONS_EXPANDALL, L(441,"Expand All")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FUNCTIONS_COLLAPSEALL, L(442,"Collapse All")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FUNCTIONS_VIEWASTREE, L(445,"View as Tree")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_FUNCTIONS_VIEWASLIST, L(446,"View as List")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_CLOSEPANEL, L(161,"Close")
+
+ Function = hPopupMenu
+End Function
+
+''
+''
+Function CreateBookmarksActionButtonContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+ dim as CWSTR wszCaption
+
+ hPopUpMenu = CreatePopupMenu
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_BOOKMARKS_EXPANDALL, L(441,"Expand All")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_BOOKMARKS_COLLAPSEALL, L(442,"Collapse All")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_BOOKMARKCLEARALLDOCS, L(53,"Clear Bookmarks")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_CLOSEPANEL, L(161,"Close")
+
+ Function = hPopupMenu
+End Function
+
+''
+''
+Function CreateBookmarksHeaderNodeContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+ dim as CWSTR wszCaption
+
+ hPopUpMenu = CreatePopupMenu
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_CLEARALLBOOKMARKNODE, L(53,"Clear Bookmarks")
+
+ Function = hPopupMenu
+End Function
+
+''
+''
+Function CreateBookmarksBookmarkNodeContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+ dim as CWSTR wszCaption
+
+ hPopUpMenu = CreatePopupMenu
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_REMOVEBOOKMARKNODE, L(444,"Remove Bookmark")
+
+ Function = hPopupMenu
+End Function
+
+''
+''
+Function CreateTopTabsActionButtonContextMenu() As HMENU
+ Dim hPopUpMenu As HMENU
+ dim as CWSTR wszCaption
+ ' List all of the Top Tab open tabs in the popup menu. Simply use the array
+ ' index as the ID because the calling program will use this ID to set the
+ ' gTTabCtl.CurSel. Must add 1 to idMenu because Win32 returns 0 if the popup
+ ' menu is cancelled.
+ hPopUpMenu = CreatePopupMenu
+ for idMenu as long = 0 to gTTabCtl.GetItemCount - 1
+ wszCaption = gTTabCtl.tabs(idMenu).wszText
+ AppendMenu( hPopUpMenu, MF_ENABLED or MFT_RADIOCHECK, idMenu + 1, wszCaption )
+ next
+ ' Check the item that is the currently active tab (1 based)
+ CheckMenuRadioItem( hPopupMenu, 1, gTTabCtl.GetItemCount, gTTabCtl.CurSel+1, MF_BYCOMMAND )
+
+ Function = hPopupMenu
+End Function
+
diff --git a/src/modMsgPump.inc b/src/modMsgPump.inc
index 2ab27fb7..7e2d1b0d 100644
--- a/src/modMsgPump.inc
+++ b/src/modMsgPump.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modMsgPump.inc.bak b/src/modMsgPump.inc.bak
new file mode 100644
index 00000000..2ab27fb7
--- /dev/null
+++ b/src/modMsgPump.inc.bak
@@ -0,0 +1,428 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+'' HANDLE RAW INCOMING MESSAGES IN THE MESSAGE PUMP
+
+
+function handleMouseScrollBar( byval uMsg as MSG ) as boolean
+ if (gApp.IsProjectLoading) orelse (gApp.IsFileLoading) then return false
+ if HWND_FRMPANEL_VSCROLLBAR = 0 then return false
+
+ ' Determine if the mouse message should be intercepted by the
+ ' transparent WS_EX_LAYERED scrollbar
+ select case uMsg.message
+ case WM_MOUSEMOVE, WM_LBUTTONDOWN, WM_LBUTTONUP
+ if IsWindowVisible( HWND_FRMPANEL_VSCROLLBAR ) then
+ dim as POINT pt: GetCursorPos( @pt )
+ dim as RECT rc = AfxGetWindowRect(HWND_FRMPANEL_VSCROLLBAR)
+ if PtInRect( @rc, pt ) orelse _
+ GetCapture() = HWND_FRMPANEL_VSCROLLBAR then
+ ' forward the message to the scrollbar instead of say
+ ' the Explorer listbox that is underneath it
+ AfxRedrawWindow( gPanelVScroll.hListBox )
+ SendMessage( HWND_FRMPANEL_VSCROLLBAR, uMsg.message, uMsg.wParam, uMsg.lParam )
+ return true
+ end if
+ end if
+ end select
+ ' we want our mouse message to continue so return FALSE
+ return false
+end function
+
+
+function handleMouseShowScrollBar( byval uMsg as MSG ) as boolean
+ if (gApp.IsProjectLoading) orelse (gApp.IsFileLoading) then return false
+
+ ' Determine if the mouse has moved over (or away from) a window that should invoke
+ ' showing or hiding our custom Panel VScroll or Editor HScroll.
+ if (uMsg.message = WM_MOUSEMOVE) orelse (uMsg.message = WM_NCMOUSEMOVE) then
+ ' if mouse is currently in drag operation then simply exit
+ if gApp.bDragActive then return false
+ ' if mouse is currently scrolling through top menus then exit
+ if IsWindowVisible( HWND_MENU(0) ) then return false
+ if IsWindowVisible( HWND_FRMPANEL ) = 0 then return false
+
+ ' HIT TEST for VSCROLLBAR in PANEL
+ dim as boolean isVisible = IsWindowVisible(HWND_FRMPANEL_VSCROLLBAR)
+ dim as long curState = iif(isVisible, SW_SHOWNA, SW_HIDE)
+ dim as long newState = SW_HIDE
+ if isMouseOverWindow( gPanelVScroll.hListBox ) orelse _
+ isMouseOverWindow( HWND_FRMPANEL_VSCROLLBAR ) then
+ newState = SW_SHOWNA
+ end if
+ if newState <> curState then frmPanelVScroll_PositionWindows( newState )
+ end if
+
+ ' Should we show an Editor HScrollbar
+ dim as clsDocument ptr pDoc = gTTabCtl.GetActiveDocumentPtr()
+ if pDoc then
+ if (pDoc->IsDesigner) andalso (IsDesignerView(pDoc)) then
+ ' visual designer design view is currently active
+ else
+ for i as long = lbound(pDoc->hWindow) to ubound(pDoc->hWindow)
+ dim as boolean isVisible = IsWindowVisible( HWND_FRMEDITOR_HSCROLLBAR(i) )
+ dim as long curState = iif(isVisible, SW_SHOWNA, SW_HIDE)
+ dim as long newState = SW_HIDE
+ if isMouseOverWindow( pDoc->hWindow(i) ) orelse _
+ isMouseOverWindow( HWND_FRMEDITOR_HSCROLLBAR(i) ) then
+ newState = frmEditorHScroll_NeedScrollBar( pDoc, i )
+ end if
+ if newState <> curState then
+ ShowWindow( HWND_FRMEDITOR_HSCROLLBAR(i), newState )
+ frmMain_PositionWindows()
+ end if
+ next
+ end if
+ end if
+
+ ' we want our mouse message to continue so return FALSE
+ return false
+end function
+
+
+function handleMouseTopMenu( byval uMsg as MSG ) as boolean
+ ' Handle any mouse clicks that are outside of a popup menu in order
+ ' to close any open top menu popups.
+
+ if uMsg.message = WM_LBUTTONDOWN then
+ if (uMsg.HWnd <> ghWndActiveMenuBarButton) andalso _
+ (uMsg.HWnd <> HWND_MENU(0)) andalso _
+ (GetParent(uMsg.HWnd) <> HWND_MENU(0)) andalso _
+ (uMsg.HWnd <> HWND_MENU(1)) andalso _
+ (GetParent(uMsg.HWnd) <> HWND_MENU(1)) then
+ killAllPopupMenus()
+ end if
+ elseif uMsg.message = WM_NCLBUTTONDOWN then
+ killAllPopupMenus()
+ end if
+ ' we want our mouse message to continue so return FALSE
+ return false
+end function
+
+
+function handleAltKeyMenuBar( byval uMsg as MSG ) as boolean
+ ' 2022-01-08: skip processing the Alt key here because it seems to
+ ' interfere with the Alt+Mouse column editing in Scintilla. Need
+ ' to investigate a better alternative. The following testing for
+ ' the mouse button does work, but it still results in the menubar
+ ' being selected/deselected.
+
+' ' single ALT key pressed, activate the first top menubar button
+' if (uMsg.message = WM_SYSKEYDOWN) and (uMsg.wParam = VK_MENU) then
+' killPopupSubMenus()
+' killPopupMenus()
+' ' if active menubar exists then simply toggle it off and exit
+' dim as HWND hCtrl
+' if ghWndActiveMenuBarButton then
+' hCtrl = ghWndActiveMenuBarButton
+' ghWndActiveMenuBarButton = 0
+' AfxRedrawWindow(hCtrl)
+' return true
+' else
+' hCtrl = GetDlgItem(HWND_FRMMAIN_MENUBAR, IDC_MENUBAR_FILE)
+' ghWndActiveMenuBarButton = hCtrl
+' AfxRedrawWindow(hCtrl)
+' return true
+' end if
+' end if
+ ' we want our message to continue so return FALSE
+ return false
+end function
+
+
+function handleKeysTopMenu( byval uMsg as MSG ) as boolean
+ ' If topmenus or menubar are active then process all keyboard input for them rather than
+ ' passing it off to the system to process.
+ if (uMsg.message = WM_KEYDOWN) and (ghWndActiveMenuBarButton <> 0) then
+ if uMsg.wParam = VK_RETURN then
+ ' simulate pressing ENTER on a menuitem by sending WM_LBUTTONUP message
+ ' to the active popup menu or menubar button. If this item hasa submenu
+ ' then convert the key from ENTER to RIGHT ARROW.
+ dim as HWND hListBox
+ if IsWindowVisible( HWND_MENU(0) ) THEN hListBox = GetDlgItem(HWND_MENU(0), IDC_MENU_LISTBOX)
+ if IsWindowVisible( HWND_MENU(1) ) THEN hListBox = GetDlgItem(HWND_MENU(1), IDC_MENU_LISTBOX)
+ ' If we have a valid listbox then process the action on the current listbox selection, otherwise
+ ' no popup menu exists so simulate pressing enter on the active menubar button.
+ if hListBox then
+ ' Determine if the menu entry has a child popup. If yes, then convert the keypress to right
+ ' arrow and process it below in the VK_RIGHT handler.
+ dim as long nCurSel = ListBox_GetCurSel(hListBox)
+ dim as long idx = ListBox_GetItemData(hListBox, nCurSel)
+ if gTopMenu(idx).nChildID <> 0 then
+ uMsg.wParam = VK_RIGHT
+ else
+ SendMessage( hListBox, WM_LBUTTONUP, 0, 0 )
+ return true
+ end if
+ else
+ SendMessage( ghWndActiveMenuBarButton, WM_LBUTTONDOWN, 0, 0 )
+ return true
+ end if
+ end if
+
+ select case uMsg.wParam
+ case VK_ESCAPE
+ if IsWindowVisible( HWND_MENU(1) ) THEN
+ killPopupSubMenus()
+ return true
+ elseif IsWindowVisible( HWND_MENU(0) ) THEN
+ killPopupMenus()
+ return true
+ elseif ghWndActiveMenuBarButton <> 0 then
+ dim as HWND hCtrl = ghWndActiveMenuBarButton
+ ghWndActiveMenuBarButton = 0
+ AfxRedrawWindow(hCtrl)
+ return true
+ end if
+
+ case VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN
+ if IsWindowVisible(HWND_MENU(0)) or IsWindowVisible(HWND_MENU(1)) then
+ if uMsg.wParam = VK_DOWN then
+ setNextMenuItemTabIndex(false)
+ return true
+ end if
+ if uMsg.wParam = VK_UP then
+ setNextMenuItemTabIndex(true)
+ return true
+ end if
+ if uMsg.wParam = VK_LEFT then
+ if IsWindowVisible(HWND_MENU(1)) then
+ killPopupSubMenus()
+ return true
+ end if
+ end if
+ if uMsg.wParam = VK_RIGHT then
+ if IsWindowVisible(HWND_MENU(0)) then
+ dim as HWND hListBox = GetDlgItem(HWND_MENU(0), IDC_MENU_LISTBOX)
+ gMenuLastCurSel = ListBox_GetCurSel(hListBox)
+ if frmPopupMenu_Show( ID_SUBPOPUP, gMenuLastCurSel, hListBox ) then
+ setNextMenuItemTabIndex(false)
+ return true
+ end if
+ end if
+ end if
+ end if
+
+ if ghWndActiveMenuBarButton <> 0 then
+ dim as HWND prevCtrl = ghWndActiveMenuBarButton
+ if uMsg.wParam = VK_LEFT then
+ ghWndActiveMenuBarButton = GetNextDlgGroupItem( HWND_FRMMAIN_MENUBAR, ghWndActiveMenuBarButton, true )
+ ' if popup menus are already activated then continue to show them as
+ ' we move through the various menubar buttons.
+ if IsWindowVisible(HWND_MENU(0)) then
+ frmPopupMenu_Show(ID_POPUP, 0, ghWndActiveMenuBarButton)
+ setNextMenuItemTabIndex(false)
+ end if
+ end if
+ if uMsg.wParam = VK_RIGHT then
+ ghWndActiveMenuBarButton = GetNextDlgGroupItem( HWND_FRMMAIN_MENUBAR, ghWndActiveMenuBarButton, false )
+ ' if popup menus are already activated then continue to show them as
+ ' we move through the various menubar buttons.
+ if IsWindowVisible(HWND_MENU(0)) then
+ frmPopupMenu_Show(ID_POPUP, 0, ghWndActiveMenuBarButton)
+ setNextMenuItemTabIndex(false)
+ end if
+ end if
+ if uMsg.wParam = VK_DOWN then
+ frmPopupMenu_Show(ID_POPUP, 0, ghWndActiveMenuBarButton)
+ setNextMenuItemTabIndex(false)
+ end if
+ AfxRedrawWindow(prevCtrl)
+ AfxRedrawWindow(ghWndActiveMenuBarButton)
+ return true
+ end if
+
+ case else
+ return true
+ end select
+ end if
+
+ ' we want our message to continue so return FALSE
+ return false
+end function
+
+
+function handleKeysExplorerListBox( byval uMsg as MSG ) as boolean
+ ' Was ENTER key pressed while scrolling the Explorer listbox via keyboard
+ dim as HWND hList = GetDlgItem(HWND_FRMEXPLORER, IDC_FRMEXPLORER_LISTBOX)
+ if (uMsg.message = WM_KEYDOWN) andalso (uMsg.HWnd = hList) then
+ dim as long nSel = ListBox_GetCaretIndex( hList )
+ dim as CWSTR wszCaption = AfxGetListBoxText( hList, nSel )
+ if uMsg.wParam = VK_RETURN then
+ if left(wszCaption, 1) = "%" then
+ ' expand/contract the header node
+ dim as long idxArray = getExplorerNodeHeaderIndex( wszCaption )
+ if idxArray <> -1 then
+ gConfig.Cat(idxArray).bShow = not gConfig.Cat(idxArray).bShow
+ end if
+ LoadExplorerFiles()
+ SetFocus( hList )
+ return true
+ else
+ ' open the selected document
+ dim as CWSTR wszFilename
+ dim as long p = ListBox_GetItemData( hList, nSel )
+ dim pDoc as clsDocument ptr = cast( clsDocument ptr, cast(integer, p) )
+ if pDoc then
+ wszFilename = pDoc->DiskFilename
+ OpenSelectedDocument( wszFilename, "" )
+ end if
+ SetFocus( hList )
+ return true
+ end if
+ end if
+ end if
+
+ ' we want our message to continue so return FALSE
+ return false
+end function
+
+
+function handleEscKeyModeless( byval uMsg as MSG ) as boolean
+ ' Close any open Find/Replace window with ESC key
+ ' Close any open FindInFiles window with ESC key
+ ' Close any open FunctionList window
+ if (uMsg.message = WM_KEYDOWN) andAlso (uMsg.wParam = VK_ESCAPE) THEN
+ if IsWindowVisible( HWND_FRMFINDREPLACE ) THEN
+ SendMessage( HWND_FRMFINDREPLACE, WM_CLOSE, 0, 0 )
+ return true
+ end if
+ if IsWindowVisible( HWND_FRMFINDINFILES ) THEN
+ SendMessage( HWND_FRMFINDINFILES, WM_CLOSE, 0, 0 )
+ return true
+ end if
+ end if
+ ' we want our message to continue so return FALSE
+ return false
+end function
+
+
+function handleKeysFindReplace( byval uMsg as MSG ) as boolean
+ ' For Find textbox, an ENTER will move to the next selection. A SHIFT+ENTER
+ ' will move to the previous. For Replace textbox, use the same logic but
+ ' also perform the replace action.
+ dim as HWND hFind = GetDlgItem( HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTFIND )
+ dim as HWND hReplace = GetDlgItem( HWND_FRMFINDREPLACE, IDC_FRMFINDREPLACE_TXTREPLACE )
+ if (GetFocus = hFind) orelse (GetFocus = hReplace) then
+ if (uMsg.message = WM_KEYDOWN) and (uMsg.wParam = VK_RETURN) then
+ if (GetAsyncKeyState(VK_CONTROL) and &H8000) andalso _
+ (GetAsyncKeyState(VK_MENU) and &H8000) THEN
+ ' Ctrl+Alt+Enter Replace All
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(IDM_REPLACEALL, 0), 0 )
+ return true
+ end if
+ if (GetAsyncKeyState(VK_SHIFT) and &H8000) THEN
+ if GetFocus = hFind then
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(IDM_FINDPREV, 0), 0 )
+ elseif GetFocus = hReplace then
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(IDM_REPLACEPREV, 0), 0 )
+ end if
+ return true
+ else
+ if GetFocus = hFind then
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(IDM_FINDNEXT, 0), 0 )
+ elseif GetFocus = hReplace then
+ SendMessage( HWND_FRMMAIN, WM_COMMAND, MAKEWPARAM(IDM_REPLACENEXT, 0), 0 )
+ end if
+ return true
+ end if
+ end if
+ end if
+ ' we want our message to continue so return FALSE
+ return false
+end function
+
+
+function handleKeysVisualDesigner( byval uMsg as MSG ) as boolean
+ ' Handle any keypress that would move or resize control(s) on a Designer Form.
+ if uMsg.message = WM_KEYDOWN THEN
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc THEN
+ ' We don't want keystrokes going into the scintilla control if the
+ ' visual designer form is active.
+ if pDoc->IsDesigner THEN
+ if IsDesignerView(pDoc) then
+ ' Don't allow keys to the scintilla control
+ if pDoc->IsValidScintillaID(GetDlgCtrlID(GetFocus)) then
+ if uMsg.wParam = VK_DELETE then
+ frmMain_OnCommand(HWND_FRMMAIN, IDM_DELETE, 0, 0)
+ return true
+ end if
+ end if
+ end if
+ end if
+ end if
+
+ select CASE uMsg.wParam
+ case VK_SPACE
+ dim as HWND hEventList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTEVENTS)
+ if pDoc andalso GetFocus() = hEventList then
+ ' Toggle the selected Event listbox item
+ dim as long nCurSel = ListBox_GetCurSel(hEventList)
+ if nCurSel > -1 then
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr
+ if pDoc then
+ pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl THEN
+ pCtrl->Events(nCurSel).bIsSelected = not pCtrl->Events(nCurSel).bIsSelected
+ AfxRedrawWindow(hEventList)
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+ frmMain_SetStatusbar
+ return true
+ end if
+ end if
+ end if
+ end if
+
+ case VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT
+ if pDoc THEN
+ if pDoc->IsDesigner THEN
+ select case GetFocus
+ ' Allow arrows to move selected item in a listbox or edit textbox
+ case GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTTOOLBOX), _
+ GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES), _
+ GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTEVENTS), _
+ HWND_PROPLIST_EDIT
+ case else
+ ' Allow arrows to move/resize selected controls
+ if IsDesignerView(pDoc) then
+ if pDoc->Controls.SelectedControlsCount > 0 then
+ ' Move control(s)
+ if (GetAsyncKeyState(VK_CONTROL) and &H8000) then
+ KeyboardMoveControls(pDoc, uMsg.wParam)
+ return true
+ end if
+ ' Resize control(s)
+ if (GetAsyncKeyState(VK_SHIFT) and &H8000) THEN
+ KeyboardResizeControls(pDoc, uMsg.wParam)
+ return true
+ end if
+ ' Move active selected control focus within group of controls
+ KeyboardCycleActiveControls(pDoc, uMsg.wParam)
+ return true
+ end if
+ end if
+ end select
+ end if
+ end if
+ end select
+ end if
+
+ ' we want our message to continue so return FALSE
+ return false
+end function
+
+
\ No newline at end of file
diff --git a/src/modParser.bi b/src/modParser.bi
index 51c6e591..624b578e 100644
--- a/src/modParser.bi
+++ b/src/modParser.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modParser.bi.bak b/src/modParser.bi.bak
new file mode 100644
index 00000000..51c6e591
--- /dev/null
+++ b/src/modParser.bi.bak
@@ -0,0 +1,91 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "clsDocument.bi"
+
+enum PARSINGACTION
+ PARSE_NONE
+ PARSE_SUB
+ PARSE_FUNCTION
+ PARSE_PROPERTY
+ PARSE_CONSTRUCTOR
+ PARSE_DESTRUCTOR
+ PARSE_TYPE
+ PARSE_ENUM
+ PARSE_DIM
+ PARSE_TODO
+end enum
+
+enum DIMSCOPE
+ SCOPEGLOBAL
+ SCOPEFUNCTION
+ SCOPETYPE
+end enum
+
+type ctxParser
+ as clsDocument ptr pDoc
+ as zstring ptr text
+ as boolean incomment
+ as boolean escaped
+ as boolean startofline
+ as boolean inprepro
+ as boolean EOL
+
+ as integer lineNum
+ as integer n
+ as integer s
+ as integer i
+ as string token
+ as string ltoken
+ as string fullLine
+ as integer nFileType ' one of the DB2_FILETYPE_* codes
+
+ as integer objectStartLine
+ as integer objectEndLine
+
+ ' FUNCTIONS
+ as string functionName
+ as string functionAlias
+ as string functionParams
+ as string functionReturnType
+ as string GetSet
+
+ ' TYPES
+ as string typeName
+ as string typeAlias
+ as string typeExtends
+
+ ' VARIABLES
+ as string varName
+ as string varType
+ as DIMSCOPE varScope
+
+ declare function Parse( byval pDoc as clsDocument ptr ) as boolean
+ declare function GenerateVisualDesignerVariables( byval pDoc as clsDocument ptr ) as boolean
+ declare function ResetFunctionValues() as boolean
+ declare function IsStandardDataType( byref sVarType as string ) as boolean
+ declare function PeekChar( byval x as integer = 0 ) as integer
+ declare function ReadChar() as integer
+ declare function ReadToEOL() as boolean
+ declare function ReadToSOL() as boolean
+ declare function GetToken() as boolean
+ declare function GetLine() as boolean
+ declare function UnwindToken() as boolean
+ declare function ParseFunction( byval action as PARSEACTION ) as boolean
+ declare function ParseFunctionParams() as boolean
+ declare function ParseDIM( byval action as PARSEACTION, byval originFrom as DIMscope ) as boolean
+ declare function ParseTYPE( byval action as PARSEACTION ) as boolean
+ declare function ParseENUM( byval action as PARSEACTION ) as boolean
+ declare function ParseTODO( byval action as PARSEACTION ) as boolean
+ declare function ReadQuoted( byval escapedonce as boolean = FALSE ) as boolean
+end type
diff --git a/src/modParser.inc b/src/modParser.inc
index ef426f56..530bcdf8 100644
--- a/src/modParser.inc
+++ b/src/modParser.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modParser.inc.bak b/src/modParser.inc.bak
new file mode 100644
index 00000000..ef426f56
--- /dev/null
+++ b/src/modParser.inc.bak
@@ -0,0 +1,1005 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modParser.bi"
+#include once "modGenerateCode.bi"
+#include once "modVDProperties.bi"
+#include once "modVDRoutines.bi"
+
+'':::::
+function ctxParser.GenerateVisualDesignerVariables( byval pDoc as clsDocument ptr ) as boolean
+
+ dim pData as DB2_DATA ptr
+ dim pCtrl as clsControl ptr
+
+ dim as CWSTR wszFormName = GetFormName(pDoc)
+ dim as CWSTR wszTypeName = wszFormName & "type"
+
+'type frmMainType extends wfxForm
+' List1 As wfxListBox
+'end type
+ this.objectStartLine = 0
+ this.objectEndLine = 0
+ this.typeName = wszTypeName
+ this.typeAlias = wszTypeName
+ this.typeExtends = "wfxForm"
+ gdb2.dbAdd( @this, DB2_TYPE )
+
+'dim shared frmMain as frmMainType
+ this.varName = wszFormName
+ this.varType = wszTypeName
+ this.varScope = DIMSCOPE.SCOPEGLOBAL
+ this.functionName = ""
+ gdb2.dbAdd( @this, DB2_VARIABLE )
+
+'List1 As wfxListBox
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl then
+ if pCtrl->ControlType = CTRL_FORM then continue for
+ this.varName = GetControlProperty(pCtrl, "NAME")
+ this.varType = GetWinformsXClassName(pCtrl->ControlType)
+ this.varScope = DIMSCOPE.SCOPETYPE
+ this.functionName = wszTypeName
+ gdb2.dbAdd( @this, DB2_VARIABLE )
+ end if
+ next
+
+ return true
+end function
+
+
+'':::::
+function ctxParser.ParseTODO( byval action as PARSEACTION ) as boolean
+
+ this.objectStartLine = this.lineNum
+ this.objectEndLine = this.lineNum
+
+ ' Get the remainder of the line after the TODO: statement
+ if this.GetLine() = true then
+ gdb2.dbAdd( @this, DB2_TODO )
+ end if
+
+ return true
+end function
+
+
+'':::::
+function ctxParser.ParseDIM( _
+ byval action as PARSEACTION, _
+ byval originFrom as DIMSCOPE _
+ ) as boolean
+
+ ' DIMSCOPE tells us from where this function is being called. The origin is important
+ ' because when saving the DIM data to the database we need to the parent scope of
+ ' the DIM statement.
+
+ dim as string text
+ dim as boolean parenActive
+ dim as integer numStatements = 0 ' the number of "as" clauses
+
+ ' Get the tokens for this DIM statement up until the EOL
+ do until this.GetToken() = false
+ if this.EOL then exit do
+ select case this.ltoken
+ case "shared"
+ ' change the scope of this variable to global and do not add it to the statement
+ originFrom = DIMSCOPE.SCOPEGLOBAL
+ case "ptr", "pointer", "byref", "any", "preserve"
+ ' simply skip these tokens
+ case "("
+ parenActive = true
+ case ")"
+ parenActive = false
+ case "="
+ ' We have hit an initializer. No need to continue to parse.
+ this.ReadToEOL()
+ continue do
+ case "as"
+ if parenActive = false then
+ text = text & this.ltoken & " "
+ numStatements += 1
+ end if
+ case else
+ if parenActive = false then
+ if this.token = "," then
+ text = rtrim(text) & ","
+ else
+ text = text & this.token & " "
+ end if
+ end if
+ end select
+ loop
+
+ ' remove any trailing spaces
+ text = rtrim(text)
+
+ ' If we are parsing a DIM from global space then reset any sub/function data.
+ if originFrom = DIMSCOPE.SCOPEGLOBAL then
+ this.ResetFunctionValues()
+ end if
+
+ ' Dim Shared name1 As DataType, name2 As DataType
+ ' There could be multiple DIMS on the same line. These would have more than one " as "
+ ' clause and the statements will be separated by a comma.
+ dim statements( 1 to numStatements ) as string
+ if numStatements = 1 then
+ statements(1) = text
+ else
+ for ii as long = 1 to numStatements
+ statements(ii) = AfxStrParse( text, ii, "," )
+ next
+ end if
+
+ for ii as long = 1 to ubound(statements)
+ text = statements(ii)
+
+ ' Normalize the line to move "AS TYPE" to front of the list.
+ ' va1 as long
+ ' as long var1, var2, var3
+ ' var1 as long
+ ' p as long
+ dim as long i = instr(text, " as ")
+ if i > 1 then
+ text = mid(text, i + 1) & " " & left(text, i - 1)
+ end if
+
+ ' as long val
+ ' as long var1,var2,var3
+ ' The first space deliminated token should be "as" followed by the data type at
+ ' position two, followed by one or more list of variables.
+ dim as string dataType = AfxStrParse( text, 2, " " )
+
+ dim as boolean bAddToDatabase = true
+
+ ' TYPE variables are always added to the database regardless of whether they include
+ ' standard datatypes. This is essential in order to display all of the Type elements
+ ' in the autocomplete popup.
+ if originFrom <> DIMSCOPE.SCOPETYPE then
+ if this.IsStandardDataType( dataType ) then
+ bAddToDatabase = false
+ end if
+ end if
+
+ if bAddToDatabase then
+ dim as string varName, varNames
+ i = InStrRev( text, " " )
+ if i then varNames = mid( text, i + 1 )
+ dim as long numItems = AfxStrParseCount( varNames, "," )
+ for i as long = 1 to numItems
+ this.varName = AfxStrParse( varNames, i, "," )
+ this.varType = dataType
+ this.varScope = originFrom
+ if originFrom = DIMSCOPE.SCOPETYPE then
+ this.functionName = this.typeName
+ end if
+ gdb2.dbAdd( @this, DB2_VARIABLE )
+ next
+ end if
+
+ next
+
+ return true
+end function
+
+
+'':::::
+function ctxParser.ParseFunctionParams() as boolean
+
+ dim as string text = this.functionParams
+ dim as integer numStatements = 0 ' the number of "as" clauses
+
+ ' There could be multiple DIMS on the same line. These would have more than one " as "
+ ' clause and the statements will be separated by a comma.
+ dim as long numParts = AfxStrParseCount(this.functionParams, ",")
+ for ii as long = 1 to numParts
+ text = trim(AfxStrParse(this.functionParams, ii, ","))
+ text = AfxStrRemoveI(text, "ptr")
+ text = AfxStrRemoveI(text, "pointer")
+ text = AfxStrRemoveI(text, "byval")
+ text = AfxStrRemoveI(text, "byref")
+ text = AfxStrRemoveI(text, "ptr")
+
+ ' Isolate the variable name and variable type
+ dim as string varName, dataType
+ dim as long f = instr( ucase(text), " AS " )
+ if f then
+ varName = trim(left(text, f-1))
+ dataType = trim(mid(text, f+4))
+ if len(varName) andalso len(dataType) then
+ if this.IsStandardDataType( dataType ) = false then
+ this.varName = varName
+ this.varType = dataType
+ this.varScope = DIMSCOPE.SCOPEFUNCTION
+ ' We have the full DIM statement so now commit it to the database
+ gdb2.dbAdd( @this, DB2_VARIABLE )
+ end if
+ end if
+ end if
+ next
+
+ return true
+end function
+
+
+'':::::
+function ctxParser.ParseENUM( byval action as PARSEACTION ) as boolean
+
+ ' We store ENUM data the same way as TYPE data
+ this.ResetFunctionValues()
+ this.objectStartLine = this.lineNum
+ this.objectEndLine = this.lineNum
+
+ ' Get next expected token (ENUM name)
+ if this.EOL then return false
+
+ if this.GetToken() then
+ ' bypass any ENUM's that do not have names
+ if this.EOL then return false
+ this.typeName = this.token
+ end if
+
+ ' Finally, look for the END ENUM that will complete the parsing
+ do until this.GetToken() = false
+ ' tokens from the body of the ENUM should be processed here
+
+ select case this.ltoken
+ case "explicit", "="
+ this.ReadToEOL()
+ case "'todo:"
+ this.ParseTODO( PARSINGACTION.PARSE_TODO )
+ case "end"
+ case else
+ if len(this.token) then
+ ' Everything else in this structure must be an actual ENUM
+ this.varName = this.token
+ this.varType = "long"
+ this.varScope = DIMSCOPE.SCOPETYPE
+ this.functionName = this.typeName
+ gdb2.dbAdd( @this, DB2_VARIABLE )
+ end if
+ end select
+
+ if( this.ltoken = "end" ) then
+ if this.GetToken() then
+ if this.EOL then return false
+ if( this.ltoken = "enum" ) then
+ this.objectEndLine = this.lineNum
+ this.typeAlias = this.typeName
+ gdb2.dbAdd( @this, DB2_TYPE )
+
+ ' Also add a variable so that the enum can be accessed directly
+ ' without having to assign it first to a variable.
+ this.varName = this.typeName
+ this.varType = this.typeName
+ this.varScope = DIMSCOPE.SCOPEGLOBAL
+ this.functionName = ""
+ gdb2.dbAdd( @this, DB2_VARIABLE )
+
+ exit do
+ end if
+ end if
+ end if
+ loop
+
+ return true
+end function
+
+
+'':::::
+function ctxParser.ParseTYPE( byval action as PARSEACTION ) as boolean
+
+ this.ResetFunctionValues()
+ this.objectStartLine = this.lineNum
+ this.objectEndLine = this.lineNum
+
+ dim as boolean bReadingExtends = false
+ dim as string extendsTYPE
+
+ ' Get next expected token (typeName)
+ if this.EOL then return false
+
+ if this.GetToken() then
+ this.typeName = this.token
+ end if
+
+ ' Finally, look for the END TYPE that will complete the parsing
+ do until this.GetToken() = false
+ ' tokens from the body of the TYPE should be processed here
+
+ if bReadingExtends then
+ extendsTYPE = this.token
+ bReadingExtends = false
+ end if
+
+ select case this.ltoken
+ case "extends"
+ bReadingExtends = true
+ case "as"
+ this.ReadToSOL()
+ this.ParseDim( action, DIMSCOPE.SCOPETYPE )
+ case "'todo:"
+ this.ParseTODO( PARSINGACTION.PARSE_TODO )
+ end select
+
+ if( this.ltoken = "end" ) then
+ if this.GetToken() then
+ if this.EOL then return false
+ if( this.ltoken = "type" ) then
+ this.objectEndLine = this.lineNum
+ this.typeAlias = this.typeName
+ this.typeExtends = extendsTYPE
+ gdb2.dbAdd( @this, DB2_TYPE )
+ exit do
+ end if
+ end if
+ end if
+ loop
+
+ return true
+end function
+
+
+'':::::
+function ctxParser.ResetFunctionValues() as boolean
+ this.functionName = ""
+ this.functionAlias = ""
+ this.functionParams = ""
+ this.functionReturnType = ""
+ this.objectStartLine = -1
+ this.objectEndLine = -1
+ this.varName = ""
+ this.varType = ""
+ this.typeName = ""
+ this.typeAlias = ""
+ this.typeExtends = ""
+ this.varScope = SCOPEGLOBAL
+ this.GetSet = ""
+ return true
+end function
+
+
+'':::::
+function ctxParser.ParseFunction( byval action as PARSEACTION ) as boolean
+
+ ' This handles parsing FUNCTION, SUB, PROPERTY, CONSTRUCTOR, DESTRUCTOR
+
+ dim as boolean readingAllParams = false
+ dim as boolean readingSingleParam = false
+ dim as boolean readingArrayParam = false
+
+ this.ResetFunctionValues()
+
+ ' Get next expected token (functionName)
+ if this.EOL then return false
+ if this.GetToken() then
+ this.functionName = this.token
+ ' If there is an embedded "." then the function belongs to a TYPE/CLASS
+ dim as long i = instr(this.functionName, ".")
+ if i then
+ this.typeName = left(this.functionName, i - 1)
+ ' Add a "THIS" variable
+ dim temp as ctxParser
+ temp.pDoc = this.pDoc
+ temp.functionName = this.functionName
+ temp.varName = "this"
+ temp.varType = this.typeName
+ temp.varScope = DIMSCOPE.SCOPEFUNCTION
+ temp.nFileType = this.nFileType
+ temp.objectStartLine = this.lineNum
+ temp.objectEndLine = this.lineNum
+ gdb2.dbAdd( @temp, DB2_VARIABLE )
+ end if
+ end if
+
+ this.objectStartLine = this.lineNum
+ this.objectEndLine = this.lineNum
+
+ select case action
+ case PARSINGACTION.PARSE_PROPERTY
+ ' Default that this is a Set property. This could be changed later to Get
+ ' if a Property statement is found within the body.
+ this.GetSet = "(set)"
+ case PARSINGACTION.PARSE_CONSTRUCTOR
+ this.GetSet = "(ctor)"
+ case PARSINGACTION.PARSE_DESTRUCTOR
+ this.GetSet = "(dtor)"
+ end select
+
+ ' Get next token (left parenthesis but is optional for sub/function)
+ do until this.GetToken() = false
+ if this.EOL then
+ if (action = PARSINGACTION.PARSE_SUB) orelse _
+ (action = PARSINGACTION.PARSE_CONSTRUCTOR) orelse _
+ (action = PARSINGACTION.PARSE_DESTRUCTOR) then
+ exit do ' only for Sub b/c for Function we haven't encountered AS RETURN_TYPE yet
+ else
+ ' Functions/Properties
+ this.UnwindToken
+ end if
+ end if
+
+ select case this.ltoken
+ case "(" ' start of the list of parameters
+ if readingSingleParam then
+ ' This is start of an Array() parameter within the list so save it.
+ this.functionParams = this.functionParams & "("
+ readingArrayParam = true
+ continue do
+ end if
+ readingAllParams = true
+ readingSingleParam = true
+ case ")" ' end of the list of parameters
+ if readingArrayParam then
+ ' This is end of an Array() parameter within the list so save it.
+ this.functionParams = this.functionParams & ")"
+ readingArrayParam = false
+ continue do
+ end if
+ readingAllParams = false
+ readingSingleParam = false
+ exit do
+ case "="
+ ' if reading a parameter then need to bypass any initializer
+ if readingSingleParam then
+ ' Need to continue until we reach a comma that separates the parameters
+ ' or until we hit the closing parenthesis.
+ readingSingleParam = false
+ end if
+ case else
+ ' Get the parameter tokens until we get (right parenthesis)
+ if readingAllParams andalso readingSingleParam then
+ this.functionParams = this.functionParams & iif(this.token = ",", ",", " " & this.token)
+ if this.token = "," then readingSingleParam = true
+ else
+ ' we are not reading params so maybe we have encountered the start of the RETURN_TYPE
+ select case this.ltoken
+ case "byref", "as"
+ this.UnwindToken
+ exit do
+ end select
+ end if
+ end select
+ loop
+
+ if (action = PARSINGACTION.PARSE_FUNCTION) orelse _
+ (action = PARSINGACTION.PARSE_PROPERTY) then
+ ' Look for the Function RETURN_TYPE
+ do until this.GetToken() = false
+ if this.EOL then exit do
+ ' This should pickup any "byref" "as" RETURN_TYPE
+ this.functionReturnType = this.functionReturnType & this.token & " "
+ loop
+ end if
+
+ ' Parse any function parameters to add to DIM variables. We use a separate
+ ' so that we don't interfere with the regular GetToken() parsing of the
+ ' main code.
+ if len(this.functionParams) then
+ this.ParseFunctionParams()
+ end if
+
+ ' Finally, look for the End Sub/Function that will complete the parsing
+ do until this.GetToken() = false
+ ' tokens from the body of the sub/function should be processed here
+
+ select case this.ltoken
+ case "dim", "static"
+ this.ParseDim( action, DIMSCOPE.SCOPEFUNCTION )
+ case "'todo:"
+ this.ParseTODO( PARSINGACTION.PARSE_TODO )
+ case "property", "return"
+ if action = PARSINGACTION.PARSE_PROPERTY then
+ ' A Property statement found at this point would be a return statement
+ ' indicating that this would be a (get) property.
+ this.GetSet = "(get)"
+ end if
+ end select
+
+ if( this.ltoken = "end" ) then
+ if this.GetToken() then
+ if this.EOL then return false
+ if( this.ltoken = "sub" ) orelse _
+ (this.ltoken = "function") orelse _
+ (this.ltoken = "property") orelse _
+ (this.ltoken = "constructor") orelse _
+ (this.ltoken = "destructor") then
+ this.objectEndLine = this.lineNum
+ exit do
+ end if
+ end if
+ end if
+ loop
+
+ ' Construct the CallTip that we store in functionParams that dbAdd
+ ' will use when storing to the database.
+ this.functionParams = this.functionName & "(" & this.functionParams & ") " & this.functionReturnType
+ gdb2.dbAdd( @this, DB2_FUNCTION )
+
+ return true
+end function
+
+
+'':::::
+function ctxParser.UnwindToken() as boolean
+ this.s -= len(this.token)
+ this.i = this.s
+ return true
+end function
+
+
+'':::::
+function ctxParser.IsStandardDataType( byref sVarType as string ) as boolean
+ ' Determine if the variable is one of the predefined standard data types
+ static as string sList
+ sList = " boolean byte double integer long longint short single" & _
+ " string ubyte uinteger ushort wstring zstring cwstr "
+ if instr(sList, " " & lcase(sVarType) & " " ) then return true
+ return false
+end function
+
+
+'':::::
+function ctxParser.PeekChar _
+ ( _
+ byval x as integer = 0 _
+ ) as integer
+
+ if( this.i + x < this.n ) then
+ return cast( ubyte ptr, this.text )[this.i + x]
+ end if
+
+ return 0
+
+end function
+
+
+'':::::
+function ctxParser.ReadChar() as integer
+
+ if( this.i < this.n ) then
+ this.i += 1
+ return cast( ubyte ptr, this.text )[this.i - 1]
+ end if
+
+ return 0
+
+end function
+
+
+'':::::
+function ctxParser.ReadToEOL() as boolean
+
+ dim as integer c
+
+ c = this.PeekChar()
+ while( c )
+ c = this.PeekChar()
+ if( c = 10 or c = 13 ) then
+ exit while
+ elseif( c = asc("'") ) then
+ c = this.ReadChar()
+ if( this.incomment ) then
+ if( this.PeekChar() = asc("/") ) then
+ c = ReadChar()
+ this.incomment = false
+ exit while
+ end if
+ end if
+ else
+ c = this.ReadChar()
+ end if
+ wend
+
+ return true
+
+end function
+
+
+'':::::
+function ctxParser.ReadToSOL() as boolean
+ ' Rewind to start of line. Used when a token is found part way through a
+ ' line but parsing it depends on tokens that would have occured earlier
+ ' in the line.
+ ' For example, a dim within a TYPE structure.
+ ' firstName as string
+ '
+ dim as integer curPos = this.s
+ for ii as integer = curPos to 0 step - 1
+ if( (this.text[ii] = 10) or (this.text[ii] = 13) ) then
+ exit for
+ end if
+ this.s = ii: this.i = ii
+ next
+ this.startofline = true
+
+ return true
+
+end function
+
+
+'':::::
+function ctxParser.ReadQuoted _
+ ( _
+ byval escapedonce as boolean = FALSE _
+ ) as boolean
+
+ dim as integer c
+
+ c = this.PeekChar()
+ if( c <> 34 ) then
+ return false
+ end if
+
+ '' Expects Opening Quote
+ c = ReadChar()
+
+ if( escapedonce or this.escaped ) then
+
+ while( this.i < this.n )
+ c = this.ReadChar()
+ if( c = asc("""") ) then
+ c = this.PeekChar()
+ if( c = asc("""") ) then
+ c = this.ReadChar()
+ else
+ exit while
+ end if
+ elseif( c = asc("\") ) then
+ c = this.PeekChar()
+ if( c = 10 or c = 13 ) then
+ exit while
+ else
+ c = this.ReadChar()
+ end if
+ end if
+ wend
+
+ else
+
+ while( this.i < this.n )
+ c = this.ReadChar()
+ if( c = asc("""") ) then
+ if( this.PeekChar() = asc("""") ) then
+ c = this.ReadChar()
+ else
+ exit while
+ end if
+ endif
+ wend
+
+ end if
+
+ return true
+
+end function
+
+
+'':::::
+function ctxParser.GetLine() as boolean
+ this.ReadToEOL()
+ this.fullLine = mid( *this.text, this.s + 1, this.i - this.s)
+ this.s = this.i
+ return true
+end function
+
+
+'':::::
+function ctxParser.GetToken() as boolean
+
+ while ( this.s < this.n )
+
+ dim as integer c
+ this.EOL = false
+
+ '' newline ?
+ c = this.PeekChar()
+ if( c = 13 or c = 10 ) then
+ c = this.ReadChar()
+ if( c = 13 ) then
+ c = this.PeekChar()
+ if( c = 10 ) then
+ c = this.ReadChar()
+ end if
+ end if
+
+ this.EOL = true
+
+ ' If line continuation was set then we can not set the
+ ' statement terminated marker yet.
+ if( this.ltoken = "_" ) then
+ this.EOL = false
+ end if
+
+ this.lineNum += 1
+ this.startofline = true
+ this.inprepro = false
+ this.s = this.i
+
+ if this.EOL then
+ this.token = ""
+ this.ltoken = ""
+ return true
+ else
+ continue while
+ end if
+ end if
+
+ if( this.incomment ) then
+ this.ReadToEOL()
+ this.s = this.i
+ continue while
+ end if
+
+ '' tab | space ?
+ c = this.PeekChar()
+ if( c = 9 or c = 32 ) then
+ c = this.ReadChar()
+ while ( c )
+ c = this.PeekChar()
+ if( c = 9 or c = 32 )then
+ c = this.ReadChar()
+ else
+ this.startofline = false
+ exit while
+ end if
+ wend
+ this.s = this.i
+ continue while
+ end if
+
+ '' '
+ c = this.PeekChar()
+ if( c = asc("'") ) then
+ c = this.ReadChar()
+
+ ' We are in a Comment but we need to check if the comment starts
+ ' with a TODO: statement. If yes, then we need to return that token
+ c = this.PeekChar()
+ if( c = asc("t") or c = asc("T") ) then
+ c = this.ReadChar()
+ while( c )
+ c = this.PeekChar()
+ select case c
+ 'case "O", "o", "D", "d", ":"
+ case 79, 111, 68, 100, 58
+ c = this.ReadChar()
+ case else
+ exit while
+ end select
+ wend
+ this.token = mid( *this.text, this.s + 1, this.i - this.s)
+ this.ltoken = lcase(this.token)
+ this.s = this.i
+ if this.ltoken = "'todo:" then
+ return true
+ end if
+ end if
+
+ ' Reach this point then this is just a normal comment line
+ ' to continue to the end of the line.
+ this.ReadToEOL()
+ this.s = this.i
+ continue while
+ end if
+
+ '' #
+ c = this.PeekChar()
+ if( c = asc("#") and this.startofline ) then
+ c = this.ReadChar()
+ while( c )
+ c = this.PeekChar()
+ if( ( c = asc("_") ) or _
+ ( c >= asc("A") and c <= asc("Z") ) or _
+ ( c >= asc("a") and c <= asc("z") ) _
+ ) then
+ c = this.ReadChar()
+ else
+ exit while
+ end if
+ wend
+ this.inprepro = true
+ this.s = this.i
+ continue while
+ end if
+
+ '' /'
+ c = this.PeekChar()
+ if( c = asc("/") ) then
+ if( this.PeekChar(1) = asc("'") ) then
+ c = this.ReadChar()
+ c = this.ReadChar()
+ this.incomment = TRUE
+ this.ReadToEOL()
+ this.s = this.i
+ continue while
+ end if
+ end if
+
+ '' $"..."
+ c = this.PeekChar()
+ if( c = asc("$") ) then
+ if( this.PeekChar(1) = asc("""") ) then
+ c = this.ReadChar() '' $
+ if( this.ReadQuoted(true) ) then
+ this.s = this.i
+ continue while
+ end if
+ end if
+ end if
+
+ '' "
+ c = this.PeekChar()
+ if( c = asc("""") ) then
+ if( this.ReadQuoted(false) ) then
+ this.s = this.i
+ continue while
+ end if
+ end if
+
+ '' Special characters that we want to process
+ c = this.PeekChar()
+ if( c = asc("(") or _
+ c = asc(")") or _
+ c = asc("=") or _
+ c = asc(",") _
+ ) then
+
+ c = this.ReadChar()
+
+ this.token = chr(c)
+ this.ltoken = this.token
+ this.s = this.i
+
+ return true
+ end if
+
+ '' Name | keyword
+ c = this.PeekChar()
+ if( c = asc("_") or _
+ ( c >= asc("A") and c <= asc("Z") ) or _
+ ( c >= asc("a") and c <= asc("z") ) _
+ ) then
+
+ c = this.ReadChar()
+ while( c )
+ c = this.PeekChar()
+ if( ( c = asc("_") ) or _
+ ( c >= asc("A") and c <= asc("Z") ) or _
+ ( c >= asc("a") and c <= asc("z") ) or _
+ ( c >= asc("0") and c <= asc("9") ) or _
+ ( c = asc(".") ) _
+ ) then
+
+ c = this.ReadChar()
+ else
+ '_ReadSuffix( ctx )
+ exit while
+ end if
+ wend
+
+ this.token = mid( *this.text, this.s + 1, this.i - this.s)
+ this.ltoken = lcase(this.token)
+
+ ' Bypass REM statements and Line Continuation underscore character
+ if (this.ltoken = "declare") orelse _
+ (this.ltoken = "rem") orelse _
+ (this.ltoken = "_") then
+ this.ReadToEOL()
+ this.s = this.i
+ continue while
+ end if
+
+ this.s = this.i
+
+ return true
+
+ end if
+
+ c = this.ReadChar()
+
+ this.s = this.i
+ wend
+
+ return false
+
+end function
+
+
+'':::::
+function ctxParser.Parse( byval pDoc as clsDocument ptr ) as boolean
+
+ if pDoc = 0 then return false
+
+ this.pDoc = pDoc
+
+ this.text = Cast( ZString Ptr, SciExec(pDoc->hWindow(0), SCI_GETCHARACTERPOINTER, 0, 0) )
+ if( this.text = 0 ) then return false
+
+ this.incomment = false
+ this.startofline = true
+ this.lineNum = 0
+ this.token = ""
+ this.ltoken = ""
+ this.fullline = ""
+ this.nfileType = DB2_FILETYPE_USERCODE
+ this.s = 0
+ this.i = 0
+ this.n = len(*this.text)
+
+ do until this.GetToken() = false
+
+ select case this.ltoken
+ case "dim", "redim"
+ if this.ParseDIM( PARSINGACTION.PARSE_DIM, DIMSCOPE.SCOPEGLOBAL ) = false then
+ '? this.lineNum, "Error parsing DIM statement. Unexpected token: "; this.token
+ end if
+
+ case "sub"
+ if this.ParseFunction( PARSINGACTION.PARSE_SUB ) = false then
+ '? this.lineNum, "Error parsing SUB statement. Unexpected token: "; this.token
+ end if
+
+ case "function"
+ if this.ParseFunction( PARSINGACTION.PARSE_FUNCTION ) = false then
+ '? this.lineNum, "Error parsing FUNCTION statement. Unexpected token: "; this.token
+ end if
+
+ case "property"
+ if this.ParseFunction( PARSINGACTION.PARSE_PROPERTY ) = false then
+ '? this.lineNum, "Error parsing PROPERTY statement. Unexpected token: "; this.token
+ end if
+
+ case "constructor"
+ if this.ParseFunction( PARSINGACTION.PARSE_CONSTRUCTOR ) = false then
+ '? this.lineNum, "Error parsing CONSTRUCTORE statement. Unexpected token: "; this.token
+ end if
+
+ case "destructor"
+ if this.ParseFunction( PARSINGACTION.PARSE_DESTRUCTOR ) = false then
+ '? this.lineNum, "Error parsing DESTRUCTOR statement. Unexpected token: "; this.token
+ end if
+
+ case "type"
+ if this.ParseTYPE( PARSINGACTION.PARSE_TYPE ) = false then
+ '? this.lineNum, "Error parsing TYPE statement. Unexpected token: "; this.token
+ end if
+
+ case "enum"
+ if this.ParseENUM( PARSINGACTION.PARSE_ENUM ) = false then
+ '? this.lineNum, "Error parsing ENUM statement. Unexpected token: "; this.token
+ end if
+
+ case "'todo:"
+ if this.ParseTODO( PARSINGACTION.PARSE_TODO ) = false then
+ '? this.lineNum, "Error parsing TODO statement. Unexpected token: "; this.token
+ end if
+
+ end select
+
+ loop
+
+ this.text = 0
+
+ ' The main code source file has now been parsed. If this is a visual designer form then
+ ' we also need to add all of the Form and Control TYPE's and variables.
+ if pDoc->IsDesigner then
+ this.GenerateVisualDesignerVariables( pDoc )
+ end if
+
+ return true
+
+end function
+
+
+
\ No newline at end of file
diff --git a/src/modRoutines.bi b/src/modRoutines.bi
index cbace742..4aec4c4e 100644
--- a/src/modRoutines.bi
+++ b/src/modRoutines.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modRoutines.bi.bak b/src/modRoutines.bi.bak
new file mode 100644
index 00000000..cbace742
--- /dev/null
+++ b/src/modRoutines.bi.bak
@@ -0,0 +1,62 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+declare function IsFormFilename( byref wszName as wstring ) as boolean
+declare function qstr( byval singleQuoteString as CWSTR ) as CWSTR
+declare function isMouseOverRECT( byval hWin as HWND, byval rc as RECT ) as boolean
+declare function isMouseOverWindow( byval hChild as HWND ) as boolean
+declare function GetTextWidthPixels( byval hWin as HWND, byref wszText as WString ) as Long
+declare function JulianDateNow() as long
+declare function ConvertWinFBEversion( byref wszVersion as wstring ) as long
+declare function DisableAllModeless() as long
+declare function EnableAllModeless() as long
+declare FUNCTION GetTemporaryFilename( byref wszFolder as wstring, BYREF wszExtension AS wSTRING) AS string
+declare FUNCTION ComboBox_ReplaceString (BYVAL hComboBox AS HWND, BYVAL index AS LONG, BYVAL pwszNewText AS WSTRING PTR, BYVAL pNewData AS LONG_PTR = 0) AS LONG
+declare Function GetFontCharSetID(ByREF wzCharsetName As CWSTR ) As Long
+declare function RemoveDuplicateSpaces( byref sText as const string) as string
+declare function ConvertCase( byval sText as string) as string
+declare FUNCTION Utf8ToAscii(byref strUtf8 AS STRING) AS STRING
+declare FUNCTION AnsiToUtf8(BYREF sAnsi AS STRING) AS STRING
+declare FUNCTION Utf8ToUnicode(BYREF ansiStr AS CONST STRING) AS STRING
+declare FUNCTION UnicodeToUtf8(byval wzUnicode as CWSTR) AS STRING
+declare function GetStringToArray( byref txtBuffer as string, txtArray() as string ) as long
+declare function GetFileToString( byref wszFilename as const wstring, byref txtBuffer as string, byval pDoc as clsDocument ptr ) as boolean
+declare function ConvertTextBuffer( byval pDoc as clsDocument ptr, byval FileEncoding as long ) as Long
+declare function IsCurrentLineIncludeFilename() as Boolean
+declare function OpenSelectedDocument( byref wszFilename as wstring, byref wszFunctionName as WSTRING = "", byval nLineNumber as long = -1 ) as clsDocument ptr
+declare Function ProcessToCurdriveProject( Byval wzFilename As CWSTR ) As CWSTR
+declare Function ProcessFromCurdriveProject( Byval wzFilename As CWSTR ) As CWSTR
+declare Function ProcessToCurdriveApp( Byval wzFilename As CWSTR ) As CWSTR
+declare Function ProcessFromCurdriveApp( Byval wzFilename As CWSTR ) As CWSTR
+declare Function AfxIFileOpenDialogW( ByVal hwndOwner As HWnd, ByVal idButton As Long) As WString Ptr
+declare Function AfxIFileOpenDialogMultiple( ByVal hwndOwner As HWnd, ByVal idButton As Long) As IShellItemArray Ptr
+Declare Function AfxIFileSaveDialog( ByVal hwndOwner As HWnd, ByVal pwszFileName As WString Ptr, ByVal pwszDefExt As WString Ptr, ByVal id As Long = 0, ByVal sigdnName As SIGDN = SIGDN_FILESYSPATH ) As WString Ptr
+declare Function FF_Toolbar_EnableButton (ByVal hToolBar As HWnd, ByVal idButton As Long) As BOOLEAN
+declare Function FF_Toolbar_DisableButton (ByVal hToolBar As HWnd, ByVal idButton As Long) As BOOLEAN
+Declare Function FF_ListView_InsertItem( ByVal hWndControl As HWnd, ByVal iRow As Long, ByVal iColumn As Long, ByVal pwszText As WString Ptr, ByVal lParam As LPARAM = 0 ) As BOOLEAN
+Declare Function FF_ListView_GetItemText( ByVal hWndControl As HWnd, ByVal iRow As Long, ByVal iColumn As Long, ByVal pwszText As WString Ptr, ByVal nTextMax As Long ) As BOOLEAN
+Declare Function FF_ListView_SetItemText( ByVal hWndControl As HWnd, ByVal iRow As Long, ByVal iColumn As Long, ByVal pwszText As WString Ptr, ByVal nTextMax As Long ) As Long
+Declare Function FF_ListView_GetlParam( ByVal hWndControl As HWnd, ByVal iRow As Long ) As LPARAM
+Declare Function FF_ListView_SetlParam( ByVal hWndControl As HWnd, ByVal iRow As Long, ByVal ilParam As LPARAM ) As long
+Declare Function LoadLocalizationFile( Byref wszFileName As CWSTR, byval IsEnglish as boolean = false ) As BOOLEAN
+Declare Function GetProcessImageName( ByVal pe32w As PROCESSENTRY32W Ptr, ByVal pwszExeName As WString Ptr ) As Long
+Declare Function IsProcessRunning( ByVal pwszExeFileName As WString Ptr ) As BOOLEAN
+Declare Function GetRunExecutableFilename() as CWSTR
+Declare Function LoadPNGfromRes(BYVAL hInstance AS HINSTANCE, BYREF wszImageName AS WSTRING) as any ptr
+declare function DoCheckForUpdates( byval hWndParent as hwnd, byval bSilentCheck as Boolean = false ) as long
+declare function GetListBoxEmptyClientArea( byval hListBox as HWND, byval nLineHeight as long ) as RECT
+
+
+
diff --git a/src/modRoutines.inc b/src/modRoutines.inc
index 5572635d..a6d55736 100644
--- a/src/modRoutines.inc
+++ b/src/modRoutines.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modRoutines.inc.bak b/src/modRoutines.inc.bak
new file mode 100644
index 00000000..5572635d
--- /dev/null
+++ b/src/modRoutines.inc.bak
@@ -0,0 +1,1665 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modRoutines.bi"
+#include once "frmUserTools.bi"
+#include once "frmOutput.bi"
+#include once "frmOptionsCompiler.bi"
+#include once "frmOptionsLocal.bi"
+#include once "frmProjectOptions.bi"
+#include once "frmMain.bi"
+
+
+' ========================================================================================
+' Determine if filename is a *.FRM form file
+' ========================================================================================
+function IsFormFilename( byref wszName as wstring ) as boolean
+ dim as CWSTR ext = ucase(AfxStrPathName( "EXT", wszName ))
+ if ext = "FRM" then
+ return true
+ else
+ return false
+ end if
+end function
+
+
+' ========================================================================================
+' Enclose JSON string (both sides) in double quotes
+' ========================================================================================
+function qstr( byval wst as CWSTR ) as CWSTR
+ if len(wst) = 0 then return wst
+ dim as CWSTR stLeft = AfxStrParse(wst, 1, ":")
+ dim as CWSTR stRight = AfxStrParse(wst, 2, ":")
+ dim as CWSTR newSt = AfxStrWrap(stLeft) & ":" & AfxStrWrap(stRight)
+ return newSt
+end function
+
+' ========================================================================================
+' Enclose JSON string (left side) in double quotes
+' This is used mostly for creating JSON numbers/booleans/arrays.
+' ========================================================================================
+function qnum( byval wst as CWSTR ) as CWSTR
+ if len(wst) = 0 then return wst
+ dim as CWSTR stLeft = AfxStrParse(wst, 1, ":")
+ dim as CWSTR stRight = AfxStrParse(wst, 2, ":")
+ dim as CWSTR newSt = AfxStrWrap(stLeft) & ":" & stRight
+ return newSt
+end function
+
+
+' ========================================================================================
+' Get the width of the text in unscaled pixels because we feed this value
+' to the pWindow create control function that will then scale up the value.
+' ========================================================================================
+function getTextWidth( _
+ byval hWnd as HWND, _
+ byref wszText as WSTRING, _
+ byval _hFont as HFONT, _
+ byval nPadding as long _
+ ) as long
+
+ dim size AS SIZEL
+ dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+
+ dim as HDC hDC = GetDC(hWnd)
+ if _hFont then SelectObject(hDC, _hFont)
+ GetTextExtentPoint32( hDC, @wszText, len(wszText), @size ) 'get text size
+ ReleaseDC hWnd, hDC
+
+ function = pWindow->UnScaleX(size.cx) + pWindow->ScaleX(nPadding) ' add enough padding
+
+end function
+
+' ========================================================================================
+' Determine if the mouse cursor is currently over the incoming window
+' ========================================================================================
+function isMouseOverWindow( byval hChild as HWND ) as boolean
+ dim as POINT pt
+ GetCursorPos( @pt )
+ 'dim as RECT rc = AfxGetWindowRect(hChild)
+ 'if PtInRect( @rc, pt ) then return true
+ if WindowFromPoint( pt ) = hChild then return true
+end function
+
+' ========================================================================================
+' Determine if the mouse cursor is currently over client RECT area
+' ========================================================================================
+function isMouseOverRECT( byval hWin as HWND, byval rc as RECT ) as boolean
+ dim as POINT pt
+ GetCursorPos( @pt )
+ MapWindowPoints( hWin, HWND_DESKTOP, cast( POINT ptr, @rc), 2 )
+ if PtInRect( @rc, pt ) then return true
+end function
+
+' ========================================================================================
+' Return the pixel width of the incoming text string
+' ========================================================================================
+function GetTextWidthPixels( byval hWin as HWND, byref wszText as WString ) as Long
+ dim as HDC _hdc = GetDC(hWin)
+ dim as SIZE _size
+ dim as HFONT oldfont = SelectObject( _hdc, AfxGetWindowFont(hWin) )
+ GetTextExtentPoint32( _hdc, wszText, len(wszText), @_size)
+ SelectObject( _hdc, oldfont )
+ ReleaseDC( hWin, _hdc )
+ function = _size.cx
+end function
+
+
+' ========================================================================================
+' Calculate the Julian date for today's date. Used by CheckForUpdates.
+' ========================================================================================
+function JulianDateNow() as long
+ function = AfxGregorianToJulian( AfxSystemDay, AfxSystemMonth, AfxSystemYear )
+end function
+
+
+' ========================================================================================
+' Convert WinFBE version to whole number for comparison to file versions being loaded.
+' ========================================================================================
+function ConvertWinFBEversion( byref wszVersion as wstring ) as long
+ dim as CWSTR wszPart1, wszPart2, wszPart3
+
+ wszPart1 = AfxStrLSet( AfxStrParse(wszVersion, 1, "."), 3, "0" )
+ wszPart2 = AfxStrLSet( AfxStrParse(wszVersion, 2, "."), 3, "0" )
+ wszPart3 = AfxStrRSet( AfxStrParse(wszVersion, 3, "."), 3, "0" )
+
+ function = val(wszPart1 + wszPart2 + wszPart3)
+end function
+
+
+' ========================================================================================
+' Disable all modeless windows belonging to frmMain so that the popup modal is truly modal.
+' ========================================================================================
+function DisableAllModeless() as long
+ ' No need to enable/disable the modeless Help form.
+ if IsWindowVisible(HWND_FRMFINDREPLACE) then EnableWindow(HWND_FRMFINDREPLACE, false)
+ if IsWindowVisible(HWND_FRMVDTOOLBOX) then EnableWindow(HWND_FRMVDTOOLBOX, false)
+ EnableWindow(HWND_FRMMAIN, false)
+ function = 0
+end function
+
+
+' ========================================================================================
+' Enable all modeless windows belonging to frmMain.
+' ========================================================================================
+function EnableAllModeless() as long
+ ' No need to enable/disable the modeless Help form.
+ if IsWindowVisible(HWND_FRMFINDREPLACE) then EnableWindow(HWND_FRMFINDREPLACE, true)
+ if IsWindowVisible(HWND_FRMVDTOOLBOX) then EnableWindow(HWND_FRMVDTOOLBOX, true)
+ EnableWindow(HWND_FRMMAIN, true)
+ function = 0
+end function
+
+
+' ========================================================================================
+' Return temporary file name
+' ========================================================================================
+FUNCTION GetTemporaryFilename( _
+ byref wszFolder as wstring, _
+ BYREF wszExtension AS wSTRING _
+ ) AS string
+
+ dim wszTempFilename as wstring * MAX_PATH
+ if GetTempFileName( @wszFolder, "TMP", 0, @wszTempFilename ) then
+ ' Delete the temp file that gets created b/c we will create it ourselves based on the
+ ' returned filename.
+ AfxDeleteFile( wszTempFilename )
+ IF LEN(wszExtension) THEN
+ wszTempFilename = LEFT(wszTempFilename, LEN(wszTempFilename) - 3) & wszExtension
+ end if
+ end if
+ function = wszTempFilename
+END FUNCTION
+
+
+' ========================================================================================
+' Replace a string in a combobox
+' ========================================================================================
+FUNCTION ComboBox_ReplaceString( _
+ BYVAL hComboBox AS HWND, _
+ BYVAL index AS LONG, _
+ BYVAL pwszNewText AS WSTRING PTR, _
+ BYVAL pNewData AS LONG_PTR = 0 _
+ ) AS LONG
+ ' Delete the string
+ DIM lRes AS LRESULT = SendMessage(hComboBox, CB_DELETESTRING, index, 0)
+ IF lRes = LB_ERR THEN RETURN lRes
+ ' Insert the new string
+ index = SendMessage(hComboBox, CB_INSERTSTRING, index, CAST(LPARAM, pwszNewText))
+ IF index = LB_ERR OR index = LB_ERRSPACE THEN Return index
+ lRes = SendMessage(hComboBox, CB_SETITEMDATA, index, CAST(LPARAM, pNewData))
+ IF lRes = LB_ERR THEN Return lRes
+ FUNCTION = SendMessage(hComboBox, CB_SETCURSEL, index, 0)
+END FUNCTION
+
+
+' ========================================================================================
+' Get the Scintilla value for a character sets
+' ========================================================================================
+Function GetFontCharSetID(ByREF wzCharsetName As CWSTR ) As Long
+
+ If Len(wzCharsetName) = 0 Then Return SC_CHARSET_DEFAULT
+
+ Select Case wzCharsetName
+ Case "Default" : Function = SC_CHARSET_DEFAULT
+ Case "Ansi" : Function = SC_CHARSET_ANSI
+ Case "Arabic" : Function = SC_CHARSET_ARABIC
+ Case "Baltic" : Function = SC_CHARSET_BALTIC
+ Case "Chinese Big 5" : Function = SC_CHARSET_CHINESEBIG5
+ Case "East Europe" : Function = SC_CHARSET_EASTEUROPE
+ Case "GB 2312" : Function = SC_CHARSET_GB2312
+ Case "Greek" : Function = SC_CHARSET_GREEK
+ Case "Hangul" : Function = SC_CHARSET_HANGUL
+ Case "Hebrew" : Function = SC_CHARSET_HEBREW
+ Case "Johab" : Function = SC_CHARSET_JOHAB
+ Case "Mac" : Function = SC_CHARSET_MAC
+ Case "OEM" : Function = SC_CHARSET_OEM
+ Case "Russian" : Function = SC_CHARSET_RUSSIAN
+ Case "Shiftjis" : Function = SC_CHARSET_SHIFTJIS
+ Case "Symbol" : Function = SC_CHARSET_SYMBOL
+ Case "Thai" : Function = SC_CHARSET_THAI
+ Case "Turkish" : Function = SC_CHARSET_TURKISH
+ Case "Vietnamese" : Function = SC_CHARSET_VIETNAMESE
+ End Select
+
+End Function
+
+
+' ========================================================================================
+' Remove duplicate spaces from the incoming line.
+' ========================================================================================
+function RemoveDuplicateSpaces( byref sText as const string) as string
+ dim as string st = sText
+ do until instr(st, " ") = 0
+ st = AfxStrReplace(st, " ", " ")
+ loop
+ function = st
+end function
+
+
+' ========================================================================================
+' Convert incoming text to proper case based on config setting. Used for autocomplete.
+' ========================================================================================
+function ConvertCase( byval sText as string) as string
+
+ Select Case gConfig.KeywordCase
+ Case 0: return lcase(sText)
+ Case 1: return ucase(sText)
+ Case 2 ' Mixed case
+ ' Loop through each character. If the previous character was an alphabet letter
+ ' then make the character lowercase otherwise make it uppercase.
+ Dim As String sChar, sPrevChar
+ For i As Long = 1 To Len(sText)
+ sChar = Mid(sText, i, 1)
+ sPrevChar = Mid(sText, i-1, 1)
+ If (sPrevChar = " ") OrElse (sPrevChar = "") Then
+ Mid(sText, i, 1) = Ucase(sChar)
+ Else
+ Mid(sText, i, 1) = LCase(sChar)
+ End If
+ Next
+ Return sText
+ End Select
+end function
+
+
+' ========================================================================================
+' Maps UTF-8 string to Ansi string.
+' ========================================================================================
+FUNCTION Utf8ToAscii(byref strUtf8 AS STRING) AS STRING
+
+ dim i AS LONG ' // Loop counter
+ dim strAscii AS STRING ' // Ascii string
+ dim idx AS LONG ' // Position in the string
+ dim c AS LONG ' // ASCII code
+ dim b2 AS LONG ' // Second byte
+ dim fSkipChar AS boolean ' // Flag
+
+ IF LEN(strUtf8) = 0 THEN EXIT FUNCTION
+
+ ' // The maximum length of the translated string will be
+ ' // the same as the length of the original string.
+ ' // We are pre-allocating the buffer for faster operation
+ ' // than concatenating each character one by one.
+ strAscii = SPACE(LEN(strUtf8))
+
+ ' // Intialize index position in the string buffer
+ ' // used to store the converted Ascii string
+ idx = 1
+
+ ' // Examine the contents of each character in the UTF-8 encoded string
+ FOR i = 1 TO LEN(strUtf8)
+ ' // If fSkipChar is set we have to skip this character
+ IF fSkipChar THEN
+ fSkipChar = 0
+ continue FOR
+ END IF
+ ' // Get the Ascii code of the character
+ c = ASC(MID(strUtf8, i, 1))
+ ' // If it is betwen 0 and 127...
+ IF c < 128 THEN
+ ' // ...we simply copy it to the string buffer...
+ MID(strAscii, idx, 1) = MID(strUtf8, idx, 1)
+ ' // ...and increase the position by 1.
+ idx = idx + 1
+ ELSEIF c < 224 THEN
+ ' // We need to join this byte and the next byte.
+ b2 = ASC(MID(strUtf8, i + 1, 1))
+ IF b2 > 127 THEN
+ c = (c - 192) * 64 + (b2 - 128)
+ MID(strAscii, idx, 1) = CHR(c)
+ ' // Set the flag to skip the next character
+ fSkipChar = TRUE
+ ' // Increase the position by 1.
+ idx = idx + 1
+ END IF
+ END IF
+ NEXT
+
+ ' // Return the string
+ FUNCTION = LEFT(strAscii, idx - 1)
+
+END FUNCTION
+
+
+' ========================================================================================
+' Maps Ansi character string to a UTF-8 string.
+' ========================================================================================
+FUNCTION AnsiToUtf8( BYREF sAnsi AS STRING ) AS STRING
+ dim sUnicode AS STRING
+ dim sUtf8 AS STRING
+
+ 'Maps Ansi character string to a UTF-8 string.
+
+ 'Step one, convert to UNICODE
+ sUnicode = string(LEN(sAnsi) * 2, 0)
+ MultiByteToWideChar(CP_ACP, _ 'System default Windows ANSI code page
+ MB_PRECOMPOSED, _ 'Conversion type
+ cast(LPCSTR, STRPTR(sAnsi)), _ 'ANSI string to convert
+ LEN(sAnsi), _ 'Lenght of ANSI string
+ cast(LPWSTR, STRPTR(sUnicode)), _ 'Unicode string
+ LEN(sUnicode)) 'Lenght of Unicode buffer
+
+ 'Step two, convert to UTF-8
+ sUtf8 = string(LEN(sAnsi), 0)
+ WideCharToMultiByte(CP_UTF8, _ 'Set to UTF-8
+ 0, _ 'Conversion type
+ cast(LPCWSTR, STRPTR(sUnicode)), _ 'Unicode string to convert
+ LEN(sUnicode) / 2, _ 'Lenght of Unicode string
+ cast(LPSTR, STRPTR(sUtf8)), _ 'UTF-8 string
+ LEN(sUtf8), _ 'Length of UTF-8 buffer
+ BYVAL 0, _ 'Invalid character replacement
+ BYVAL 0) 'Replacement was used flag
+ FUNCTION = sUtf8
+
+END FUNCTION
+
+
+' ========================================================================================
+' Maps UTF-8 string to Unicode character string
+' ========================================================================================
+FUNCTION Utf8ToUnicode( BYREF ansiStr AS CONST STRING ) AS STRING
+'*** This conversion does not appear to be reliable.
+'*** Better using the CWSTR.Utf8 method instead.
+ DIM dwLen AS DWORD = MultiByteToWideChar(CP_UTF8, 0, STRPTR(ansiStr), LEN(ansiStr), NULL, 0)
+ IF dwLen THEN
+ DIM s AS STRING = SPACE(dwLen * 2)
+ dwLen = MultiByteToWideChar(CP_UTF8, 0, STRPTR(ansiStr), LEN(ansiStr), CAST(WSTRING PTR, STRPTR(s)), dwLen * 2)
+ IF dwLen THEN RETURN s
+ END IF
+end function
+
+
+' ========================================================================================
+' Maps Unicode character string to a UTF-8 string.
+' ========================================================================================
+FUNCTION UnicodeToUtf8( byval wzUnicode as CWSTR ) AS STRING
+ dim sUtf8 AS STRING
+
+ ' Maps Unicode character string to a UTF-8 string.
+ sUtf8 = string(len(wzUnicode) * 2, 0)
+
+ dim as long bytesWritten = _
+ WideCharToMultiByte ( _
+ CP_UTF8, _ 'Set to UTF-8
+ 0, _ 'Conversion type
+ cast(LPCWSTR, wzUnicode.vptr), _ 'Unicode string to convert
+ LEN(wzUnicode), _ 'Length of Unicode string
+ cast(LPSTR, STRPTR(sUtf8)), _ 'UTF-8 string
+ LEN(sUtf8), _ 'Length of UTF-8 buffer
+ BYVAL 0, _ 'Invalid character replacement
+ BYVAL 0) 'Replacement was used flag
+
+ FUNCTION = left(sUtf8, bytesWritten)
+
+END FUNCTION
+
+' ========================================================================================
+' Parse a string to a string array and return the number of lines.
+' ========================================================================================
+function GetStringToArray( _
+ byref txtBuffer as string, _
+ txtArray() as string _
+ ) as long
+
+ ' Load the lines into the string array. This is MUCH faster than having
+ ' to use AfxStrParse to retrieve each line.
+ dim as string st
+ dim as long iLineStart = 1
+ dim as long iLineEnd, nNextLine
+ dim as Long nNextBufferArrayLine = 1
+
+ ' Convert the string into an array that can be parsed.
+ do until iLineStart >= len( txtBuffer )
+ iLineEnd = instr(iLineStart, txtBuffer, vbcrlf)
+ if iLineEnd = 0 then iLineEnd = len( txtBuffer ) ' cr/lf not found
+ st = mid( txtBuffer, iLineStart, iLineEnd - iLineStart )
+ iLineStart = iLineStart + len(st) + len(vbcrlf)
+ if nNextBufferArrayLine >= ubound(txtArray) THEN
+ redim preserve txtArray( ubound(txtArray) + 5000 )
+ END IF
+ txtArray(nNextBufferArrayLine) = st
+ nNextBufferArrayLine = nNextBufferArrayLine + 1
+ loop
+
+ function = nNextBufferArrayLine - 1
+end function
+
+
+' ========================================================================================
+' Open a disk file and read it into a string (ANSI or UTF8)
+' ========================================================================================
+function GetFileToString( _
+ byref wszFilename as const wstring, _
+ byref txtBuffer as string, _
+ byval pDoc as clsDocument ptr _
+ ) as boolean
+
+ if pDoc = 0 then return true
+ if AfxFileExists(wszFilename) = false then return true
+
+ ' Load the entire file into a string
+ DIM dwCount AS DWORD, dwFileSize AS DWORD, dwHighSize AS DWORD, dwBytesRead AS DWORD
+ DIM hFile AS HANDLE = CreateFileW(@wszFileName, GENERIC_READ, FILE_SHARE_READ, NULL, _
+ OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, NULL)
+ IF hFile = INVALID_HANDLE_VALUE THEN return true
+ dwFileSize = GetFileSize(hFile, @dwHighSize)
+ txtBuffer = String(dwFileSize, 0)
+ DIM bSuccess AS LONG = ReadFile(hFile, strptr(txtBuffer), dwFileSize, @dwBytesRead, NULL)
+ CloseHandle(hFile)
+ IF bSuccess = FALSE THEN return true
+
+ ' A JSON Design file will not have a BOM signature but it is UTF8
+ dim as CWSTR wst = wszFilename
+ if ucase(AfxStrPathName("EXTN", wst)) = ".DESIGN" then
+ pDoc->FileEncoding = FILE_ENCODING_UTF8_BOM
+ else
+ ' Check for BOM signatures
+ if left(txtBuffer, 3) = chr(&HEF, &HBB, &HBF) THEN
+ ' UTF8 BOM encoded
+ pDoc->FileEncoding = FILE_ENCODING_UTF8_BOM
+ txtBuffer = mid(txtBuffer, 4) ' bypass the BOM
+ elseif left(txtBuffer, 2) = chr(&HFF, &HFE) THEN
+ ' UTF16 BOM (little endian) encoded
+ pDoc->FileEncoding = FILE_ENCODING_UTF16_BOM
+ txtBuffer = mid(txtBuffer, 3) ' bypass the BOM
+ else
+ pDoc->FileEncoding = FILE_ENCODING_ANSI
+ end if
+ end if
+
+ select case pDoc->FileEncoding
+ case FILE_ENCODING_ANSI
+ ' No conversion needed. clsDocument ApplyProperties will *not*
+ ' set the editor to UTF8 code.
+
+ case FILE_ENCODING_UTF8_BOM
+ ' No conversion needed. clsDocument ApplyProperties will set
+ ' the editor to UTF8 code.
+
+ case FILE_ENCODING_UTF16_BOM
+ ' Convert the whole buffer to UTF-16 unicode string
+ dim as CWSTR wszText = string(len(txtBuffer),0)
+ MemCpy( CAST(any PTR, wszText.m_pBuffer), strptr(txtBuffer), len(txtBuffer))
+
+ ' Need to parse wszText to remove/process any possible visual designer code. Only
+ ' the non-VD text is returned. We also skip over any codegen code. This is only
+ ' used in pre-version 3.02 files. New 3.02+ files will call LoadFormJSONdata during
+ ' the codewindow creation.
+ wszText = pDoc->ParseFormMetaData(HWND_FRMMAIN, wszText)
+
+ ' Convert to UTF8 so it can display in the editor
+ txtBuffer = UnicodeToUtf8(wszText)
+
+ end select
+
+ function = false
+end function
+
+
+' ========================================================================================
+' Convert the current text buffer to the specified encoding and redisplay the text.
+' ========================================================================================
+function ConvertTextBuffer( _
+ byval pDoc as clsDocument ptr, _
+ byval FileEncoding as long _
+ ) as Long
+
+ if pDoc = 0 then exit function
+
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ ' Save the current file position and first visible line
+ dim nFirstLine as long = SciExec( hEdit, SCI_GETFIRSTVISIBLELINE, 0, 0)
+ Dim nPos As Long = SciExec(hEdit, SCI_GETCURRENTPOS, 0, 0)
+
+ pDoc->FileEncoding = FileEncoding
+ Dim As ZString Ptr psz = Cast( ZString Ptr, SciExec(hEdit, SCI_GETCHARACTERPOINTER, 0, 0) )
+ dim as long sciCodePage = SciExec(hEdit, SCI_GETCODEPAGE, 0, 0) ' 0 or SC_CP_UTF8
+ dim as string txtBuffer
+
+ ' Convert buffer to specified file encoding
+ select CASE FileEncoding
+ case FILE_ENCODING_ANSI
+ if sciCodePage = 0 THEN ' already in ANSI format
+ exit function
+ else
+ ' need to convert from UTF8 to ANSI
+ txtBuffer = Utf8ToAscii(*psz)
+ SciExec(hEdit, SCI_SETCODEPAGE, 0, 0 )
+ end if
+
+ case FILE_ENCODING_UTF8_BOM, FILE_ENCODING_UTF16_BOM
+ if sciCodePage = SC_CP_UTF8 THEN ' already in unicode format
+ exit function
+ else
+ ' need to convert from ANSI to UTF8
+ txtBuffer = AnsiToUtf8(*psz)
+ SciExec(hEdit, SCI_SETCODEPAGE, SC_CP_UTF8, 0 )
+ end if
+
+ END SELECT
+
+ ' Set the new buffer
+ pDoc->SetText(txtBuffer)
+
+ SciExec(hEdit, SCI_SETFIRSTVISIBLELINE, nFirstLine, 0)
+ SciExec(hEdit, SCI_GOTOPOS, nPos, 0)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Determine if current line is a valid #Include filename
+' ========================================================================================
+function IsCurrentLineIncludeFilename() as Boolean
+ ' Determine if the text under the current line is a valid #Include filename
+ ' and return TRUE if it is. If F6 was pressed then the calling program can
+ ' simply open/load the gApp.IncludeFilename. If the right click popup menu
+ ' is to be shown then simply add the option to open this file.
+
+ Dim pDoc As clsDocument Ptr = gTTabCtl.GetActiveDocumentPtr()
+ If pDoc = 0 Then Exit Function
+
+ Dim wszPath As WString * MAX_PATH
+ Dim wszCompilerPath As WString * MAX_PATH
+ Dim wszText As WString * MAX_PATH
+ Dim sFilename As String
+ Dim sLine As String
+ Dim nLine As Long
+ Dim i As Long
+
+ dim as long idxBuild = frmBuildConfig_getActiveBuildIndex()
+ if idxBuild = -1 then idxBuild = 0
+ if gConfig.Builds(idxBuild).Is32bit then wszCompilerPath = gConfig.FBWINcompiler32
+ if gConfig.Builds(idxBuild).Is64bit then wszCompilerPath = gConfig.FBWINcompiler64
+ wszCompilerPath = ProcessFromCurdriveApp(wszCompilerPath)
+ wszCompilerPath = AfxStrPathname( "PATH", wszCompilerPath ) & "inc"
+
+ ' Convert relative path to absolute path if needed.
+ if AfxPathIsRelative(wszCompilerPath) then
+ wszCompilerPath = AfxPathCombine(AfxGetExePathName, wszCompilerPath)
+ END IF
+
+ nLine = pDoc->GetCurrentLineNumber()
+ sLine = LTrim(pDoc->GetLine(nLine))
+
+ If Left(Ucase(sLine), 9) = "#INCLUDE " Then sFilename = Mid(sLine, 10)
+ If Left(Ucase(sLine), 14) = "#INCLUDE ONCE " Then sFilename = Mid(sLine, 15)
+
+ gApp.IncludeFilename = ""
+ If Len(sFilename) Then
+ ' remove any comments at the end of the line
+ i = Instr(sFilename, "'")
+ If i Then sFilename = Left(sFilename, i-1)
+ sFilename = Trim(sFilename, Any Chr(32,34)) ' remove spaces and double quotes
+ wszPath = AfxStrPathname( "PATH", pDoc->DiskFilename )
+
+ If AfxFileExists(wszPath & sFilename) Then
+ gApp.IncludeFilename = wszPath & sFilename
+ ElseIf AfxFileExists(sFilename) Then
+ gApp.IncludeFilename = sFilename
+ ElseIf AfxFileExists(AfxGetCurDir & "\" & sFilename) Then
+ gApp.IncludeFilename = AfxGetCurDir & "\" & sFilename
+ ElseIf AfxFileExists(AfxGetExePathName & sFilename) Then
+ gApp.IncludeFilename = AfxGetExePathName & sFilename
+ ElseIf AfxFileExists(Str(wszCompilerPath) & "\" & sFilename) Then
+ gApp.IncludeFilename = Str(wszCompilerPath) & "\" & sFilename
+ End If
+ gApp.IncludeFilename = AfxStrReplace(gApp.IncludeFilename, "/", "\")
+ gApp.IncludeFilename = AfxStrReplace(gApp.IncludeFilename, "\\", "\")
+ End If
+
+ function = AfxFileExists( gApp.IncludeFilename )
+
+end function
+
+
+' ========================================================================================
+' Generic open document handler for when Function ListBox item selected or Explorer Treeview
+' ========================================================================================
+function OpenSelectedDocument( _
+ byref wszFilename as wstring, _
+ byref wszFunctionName as WSTRING = "", _
+ byval nLineNumber as long = -1 _
+ ) as clsDocument ptr
+
+ ' This function is called in the following situations:
+ ' 1. When a selection is made in the Function List.
+ ' 2. When a selection is made through the Explorer treeview.
+ ' 3. When a Find In Files line is selected.
+ ' 4. When a Goto Definition word is clicked on.
+ ' 5. When OnActivateApp needs to reload a document.
+ ' 6. When a compile error occurs and need to position to the error line.
+ ' 7. When right-click select #Include file to open.
+
+ ' If incoming FunctionName then search for filename and line number.
+ dim pData as DB2_DATA ptr
+ if len( wszFunctionName ) AndAlso nLineNumber = -1 then
+ ' Search for function, sub, or property (get/set)
+ pData = gdb2.dbFindFunction( wszFunctionName, wszFilename)
+ if pData then
+ wszFilename = pData->fileName
+ nLineNumber = pData->nLineStart
+ end if
+ end if
+
+ ' Not all documents exist on disk file. For example, a QuickRun file will exist in
+ ' the editor but may never have a disk footprint. We need to search the project to
+ ' determine if the filename has a pDoc already associated with it. If it does, then
+ ' pass that pDoc rather than looking for a disk filename.
+ dim pDoc as clsDocument ptr
+ pDoc = gApp.GetDocumentPtrByFilename( wszFilename )
+
+ if pDoc then
+ pDoc = frmMain_OpenFileSafely( _
+ HWND_FRMMAIN, _
+ False, _ ' bIsNewFile
+ False, _ ' bIsTemplate
+ true, _ ' bShowInTab
+ false, _ ' bIsInclude
+ "", _ ' wszFileName
+ pDoc ) ' pDocIn
+ else
+ if AfxFileExists(wszFilename) = false THEN exit function
+ ' Display the document containing the selected sub/function
+ pDoc = frmMain_OpenFileSafely(HWND_FRMMAIN, _
+ False, _ ' bIsNewFile
+ False, _ ' bIsTemplate
+ true, _ ' bShowInTab
+ false, _ ' bIsInclude
+ wszFilename, _ ' wszFileName
+ 0 ) ' pDocIn
+ end if
+
+ ' Set the top line to display in the editor. I chose to start 3 lines before the
+ ' function just to make it visually more appealing.
+ if pDoc THEN
+ ' Make sure that the code editor is selected for visual designer forms
+ if (pDoc->IsDesigner = true) andalso (IsDesignerView(pDoc) = true) then
+ if nLineNumber <> -1 then
+ pDoc->DesignTabsCurSel = 1 ' 1 = code tab, 0 = Designer
+ frmMain_PositionWindows
+ end if
+ end if
+
+ ' Do not reposition if incoming LineNumber is -1 because that value represents
+ ' the caller specifically not wanting a repositioning.
+ if nLineNumber <> -1 then
+ dim as hwnd hEdit = pDoc->hWndActiveScintilla
+ ' ensure that the line is visible (not folded)
+ if SciExec( hEdit, SCI_GETLINEVISIBLE, nLineNumber, 0) = false then
+ ' unfold the block that contains this hidden line
+ pDoc->FoldToggle( nLineNumber )
+ end if
+ SciExec( hEdit, SCI_SETFIRSTVISIBLELINE, Max(nLineNumber - 3, 0), 0)
+ SciExec( hEdit, SCI_GOTOLINE, nLineNumber, 0)
+ pDoc->CenterCurrentLine
+ end if
+ END IF
+
+ function = pDoc
+end function
+
+
+' ========================================================================================
+' Process prefix {CURDRIVE} and convert to current drive letter.
+' ========================================================================================
+Function ProcessToCurdriveApp( Byval wszFilename As CWSTR ) As CWSTR
+ ' For each folder location determine if it resides on the same drive as
+ ' the WinFBE app. If it does then substitute the replaceable parameter
+ ' {CURDRIVE} for the drive letter. This allows you to easily run the editor
+ ' on different media (eg. thumb drive) that may be assigned a different
+ ' drive letter.
+ dim as CWSTR wszText = AfxGetExePathName
+
+ Dim wszCurDrive As CWSTR = LCase(Left(wszText, 3)) ' eg. D:\
+
+ ' If the incoming filename is a relative file name then the following test
+ ' will have no effect.
+ If LCase(Left(wszFilename, 3)) = wszCurDrive Then
+ wszFilename = WSTR("{CURDRIVE}") & Mid(wszFilename, 2)
+ End If
+
+ Return wszFilename
+End Function
+
+
+' ========================================================================================
+' Process current drive to prefix {CURDRIVE}
+' ========================================================================================
+Function ProcessFromCurdriveApp( Byval wszFilename As CWSTR ) As CWSTR
+ ' For each folder location determine if it resides on the same drive as
+ ' the WinFBE app. If it does then substitute the replaceable parameter
+ ' {CURDRIVE} for the drive letter. This allows you to easily run the editor
+ ' on different media (eg. thumb drive) that may be assigned a different
+ ' drive letter.
+ dim as CWSTR wszText = AfxGetExePathName
+
+ If Ucase(Left(wszFilename, 10)) = WSTR("{CURDRIVE}") Then
+ wszFilename = Left(wszText, 1) & Mid(wszFilename, 11)
+ End If
+
+ Return wszFilename
+End Function
+
+
+' ========================================================================================
+' Process prefix {CURDRIVE} and convert to current drive letter.
+' ========================================================================================
+Function ProcessToCurdriveProject( Byval wszFilename As CWSTR ) As CWSTR
+ ' For each folder location determine if it resides on the same drive as
+ ' the project file. If it does then substitute the replaceable parameter
+ ' {CURDRIVE} for the drive letter. This allows you to easily run the editor
+ ' on different media (eg. thumb drive) that may be assigned a different
+ ' drive letter.
+ dim wszText as CWSTR = gApp.ProjectFilename
+
+ Dim wszCurDrive As CWSTR = LCase(Left(wszText, 3)) ' eg. D:\
+
+ ' If the incoming filename is a relative file name then the following test
+ ' will have no effect.
+ If LCase(Left(wszFilename, 3)) = wszCurDrive Then
+ wszFilename = WSTR("{CURDRIVE}") & Mid(wszFilename, 2)
+ End If
+
+ Return wszFilename
+End Function
+
+
+' ========================================================================================
+' Process current drive to prefix {CURDRIVE}
+' ========================================================================================
+Function ProcessFromCurdriveProject( Byval wszFilename As CWSTR ) As CWSTR
+ ' For each folder location determine if it resides on the same drive as
+ ' the project file. If it does then substitute the replaceable parameter
+ ' {CURDRIVE} for the drive letter. This allows you to easily run the editor
+ ' on different media (eg. thumb drive) that may be assigned a different
+ ' drive letter.
+ dim wszText as CWSTR = gApp.ProjectFilename
+
+ If Ucase(Left(wszFilename, 10)) = WSTR("{CURDRIVE}") Then
+ wszFilename = Left(wszText, 1) & Mid(wszFilename, 11)
+ End If
+
+ Return wszFilename
+End Function
+
+
+' ========================================================================================
+' Displays the FileOpenDialog.
+' The returned pointer must be freed with CoTaskMemFree
+' ========================================================================================
+Function AfxIFileOpenDialogW( _
+ ByVal hwndOwner As HWnd, _
+ ByVal idButton As Long _
+ ) As WString Ptr
+
+ Dim hr As Long
+ Dim CLSID_FileOpenDialog As CLSID = (&hDC1C5A9C, &hE88A, &h4DDE, {&hA5, &hA1, &h60, &hF8, &h2A, &h20, &hAE, &hF7})
+ Dim IID_IFileOpenDialog As GUID = (&hD57C7288, &hD4AD, &h4768, {&hBE, &h02, &h9D, &h96, &h95, &h32, &hD9, &h60})
+
+ ' Create an instance of the FileOpenDialog object
+ Dim pofd As IFileOpenDialog Ptr
+ hr = CoCreateInstance(@CLSID_FileOpenDialog, Null, CLSCTX_INPROC_SERVER, @IID_IFileOpenDialog, @pofd)
+ If pofd = Null Then Return Null
+
+ ' Set the file types depending on the button pushed that calls this open dialog
+ Dim rgFileTypes(1 To 5) As COMDLG_FILTERSPEC
+
+ Select Case idButton
+ case IDM_LOADSESSION
+ rgFileTypes(1).pszName = @wstr("Session files")
+ rgFileTypes(1).pszSpec = @WSTR("*.session")
+ rgFileTypes(2).pszName = @L(79,"All files")
+ rgFileTypes(2).pszSpec = @WSTR("*.*")
+ pofd->lpVtbl->SetFileTypes(pofd, 2, @rgFileTypes(1))
+ ' Set the title of the dialog
+ hr = pofd->lpVtbl->SetTitle(pofd, L(426,"Load Session"))
+
+ case IDC_FRMUSERTOOLS_CMDBROWSEEXE
+ rgFileTypes(1).pszName = @L(79,"All files")
+ rgFileTypes(1).pszSpec = @WSTR("*.*")
+ pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes(1))
+ ' Set the title of the dialog
+ hr = pofd->lpVtbl->SetTitle(pofd, L(291,"Command:"))
+
+ Case IDM_PROJECTOPEN
+ rgFileTypes(1).pszName = @L(216,"Project files")
+ rgFileTypes(1).pszSpec = @WSTR("*.wfbe")
+ rgFileTypes(2).pszName = @L(79,"All files")
+ rgFileTypes(2).pszSpec = @WSTR("*.*")
+ pofd->lpVtbl->SetFileTypes(pofd, 2, @rgFileTypes(1))
+ ' Set the title of the dialog
+ hr = pofd->lpVtbl->SetTitle(pofd, L(216,"Project files"))
+
+ Case IDM_INSERTFILE
+ rgFileTypes(1).pszName = @L(106,"Open source file")
+ rgFileTypes(2).pszName = @L(77,"Code files")
+ rgFileTypes(3).pszName = @L(78,"Header files")
+ rgFileTypes(4).pszName = @L(209,"Resource files")
+ rgFileTypes(5).pszName = @L(79,"All files")
+ rgFileTypes(1).pszSpec = @WSTR("*.bas;*.bi;*.inc;*.rc")
+ rgFileTypes(2).pszSpec = @WSTR("*.bas;*.inc")
+ rgFileTypes(3).pszSpec = @WSTR("*.bi")
+ rgFileTypes(4).pszSpec = @WSTR("*.rc")
+ rgFileTypes(5).pszSpec = @WSTR("*.*")
+ pofd->lpVtbl->SetFileTypes(pofd, 5, @rgFileTypes(1))
+ ' Set the title of the dialog
+ hr = pofd->lpVtbl->SetTitle(pofd, L(80,"Insert File"))
+
+ Case IDC_FRMOPTIONSLOCAL_CMDLOCALIZATION '1012
+ rgFileTypes(1).pszName = @L(102,"Localization files")
+ rgFileTypes(1).pszSpec = @WSTR("*.lang")
+ rgFileTypes(2).pszName = @L(79,"All files")
+ rgFileTypes(2).pszSpec = @WSTR("*.*")
+ pofd->lpVtbl->SetFileTypes(pofd, 2, @rgFileTypes(1))
+ ' Set the title of the dialog
+ hr = pofd->lpVtbl->SetTitle(pofd, L(103,"Open Localization File"))
+
+ Case IDC_FRMOPTIONSCOMPILER_CMDFBHELPFILE
+ rgFileTypes(1).pszName = @L(104,"Help file")
+ rgFileTypes(1).pszSpec = @WSTR("*.chm")
+ rgFileTypes(2).pszName = @L(79,"All files")
+ rgFileTypes(2).pszSpec = @WSTR("*.*")
+ pofd->lpVtbl->SetFileTypes(pofd, 2, @rgFileTypes(1))
+ ' Set the title of the dialog
+ hr = pofd->lpVtbl->SetTitle(pofd, L(105,"Find Help File"))
+ End Select
+
+ ' Display the dialog
+ hr = pofd->lpVtbl->Show(pofd, hwndOwner)
+ hr = pofd->lpVtbl->SetOptions(pofd, FOS_NOCHANGEDIR)
+
+ ' Get the result
+ Dim pItem As IShellItem Ptr
+ Dim pwszName As WString Ptr
+ If SUCCEEDED(hr) Then
+ hr = pofd->lpVtbl->GetResult(pofd, @pItem)
+ If SUCCEEDED(hr) Then
+ hr = pItem->lpVtbl->GetDisplayName(pItem, SIGDN_FILESYSPATH, @pwszName)
+ Function = pwszName
+ End If
+ End If
+
+ ' Cleanup
+ If pItem Then pItem->lpVtbl->Release(pItem)
+ If pofd Then pofd->lpVtbl->Release(pofd)
+
+End Function
+
+
+' ========================================================================================
+' Displays the FileOpenDialog (multiple selection)
+' Returns a pointer to the IShellItemArray collection.
+' ========================================================================================
+Function AfxIFileOpenDialogMultiple( _
+ ByVal hwndOwner As HWnd, _
+ ByVal idButton As Long _
+ ) As IShellItemArray Ptr
+
+ ' Create an instance of the FileOpenDialog interface
+ Dim hr As Long
+ Dim pofd As IFileOpenDialog Ptr
+ hr = CoCreateInstance( @CLSID_FileOpenDialog, Null, CLSCTX_INPROC_SERVER, _
+ @IID_IFileOpenDialog, @pofd)
+ If pofd = Null Then Return Null
+
+ ' Set the file types
+ Dim rgFileTypes(1 To 5) As COMDLG_FILTERSPEC
+
+ select case idButton
+ case IDM_FILEOPEN
+ rgFileTypes(1).pszName = @L(106,"Open source file")
+ rgFileTypes(2).pszName = @L(77,"Code files")
+ rgFileTypes(3).pszName = @L(78,"Header files")
+ rgFileTypes(4).pszName = @L(209,"Resource files")
+ rgFileTypes(5).pszName = @L(79,"All files")
+ rgFileTypes(1).pszSpec = @WSTR("*.bas;*.bi;*.inc;*.rc")
+ rgFileTypes(2).pszSpec = @WSTR("*.bas;*.inc")
+ rgFileTypes(3).pszSpec = @WSTR("*.bi")
+ rgFileTypes(4).pszSpec = @WSTR("*.rc")
+ rgFileTypes(5).pszSpec = @WSTR("*.*")
+ pofd->lpVtbl->SetFileTypes(pofd, 5, @rgFileTypes(1))
+
+ case IDM_ADDIMAGE
+ rgFileTypes(1).pszName = @L(378,"Images")
+ rgFileTypes(2).pszName = @L(79,"All files")
+ rgFileTypes(1).pszSpec = @WSTR("*.ico;*.bmp;*.jpg;*.gif;*.wmf;*.png;*.tiff;*.cur")
+ rgFileTypes(2).pszSpec = @WSTR("*.*")
+ pofd->lpVtbl->SetFileTypes(pofd, 2, @rgFileTypes(1))
+
+ end select
+
+ ' Set the title of the dialog
+ hr = pofd->lpVtbl->SetTitle(pofd, L(248,"Open file"))
+
+ ' Set the default folder to display in the open dialog
+ dim wszDefaultFolder as wstring * MAX_PATH
+ if gApp.wszLastOpenFolder = "" then
+ if AfxFileExists( gApp.ProjectFilename ) then
+ wszDefaultFolder = AfxStrPathName( "PATH", gApp.ProjectFilename )
+ else
+ wszDefaultFolder = AfxGetCurDir
+ end if
+ else
+ wszDefaultFolder = gApp.wszLastOpenFolder
+ end if
+
+ Dim pFolder As IShellItem Ptr
+ SHCreateItemFromParsingName (wszDefaultFolder, Null, @IID_IShellItem, @pFolder)
+ If pFolder Then
+ hr = pofd->lpVtbl->SetFolder(pofd, pFolder)
+ If SUCCEEDED(hr) Then
+ pFolder->lpVtbl->Release(pFolder)
+ end if
+ End If
+
+ ' Allow multiselection
+ hr = pofd->lpVtbl->SetOptions(pofd, FOS_ALLOWMULTISELECT Or FOS_NOCHANGEDIR or FOS_FILEMUSTEXIST)
+ ' Display the dialog
+ hr = pofd->lpVtbl->Show(pofd, hwndOwner)
+
+ ' Get the result
+ Dim pItemArray As IShellItemArray Ptr
+ If SUCCEEDED(hr) Then
+ hr = pofd->lpVtbl->GetResults(pofd, @pItemArray)
+ Function = pItemArray
+ End If
+
+ If pofd Then pofd->lpVtbl->Release(pofd)
+
+End Function
+
+
+' ========================================================================================
+' Displays the FileSaveDialog
+' The returned pointer must be freed with CoTaskMemFree
+' ========================================================================================
+Function AfxIFileSaveDialog( _
+ ByVal hwndOwner As HWnd, _
+ ByVal pwszFileName As WString Ptr, _ ' full path and filename
+ ByVal pwszDefExt As WString Ptr, _
+ ByVal id As Long = 0, _
+ ByVal sigdnName As SIGDN = SIGDN_FILESYSPATH _
+ ) As WString Ptr
+
+ ' // Create an instance of the IFileSaveDialog interface
+ Dim rgFileTypes(1 To 4) As COMDLG_FILTERSPEC
+ Dim hr As Long
+ Dim psfd As IFileSaveDialog Ptr
+ hr = CoCreateInstance(@CLSID_FileSaveDialog, Null, CLSCTX_INPROC_SERVER, @IID_IFileSaveDialog, @psfd)
+ If psfd = Null Then Return Null
+
+ dim as CWSTR wszFilename, wszFilePath
+
+ ' Add extensions if it does not already exist as part of the filename
+ wszFilename = AfxStrPathname( "NAMEX", *pwszFileName )
+ if len(wszFilename) then
+ if AfxStrPathname( "EXTN", wszFilename ) = "" then
+ if len(*pwszDefExt) then
+ wszFilename = wszFilename & "." & *pwszDefExt
+ end if
+ end if
+ end if
+
+ if AfxFileExists( *pwszFileName ) then
+ wszFilePath = AfxStrPathName( "PATH", *pwszFileName )
+ else
+ ' Set the default folder to save the file
+ if gApp.wszLastOpenFolder then
+ wszFilePath = gApp.wszLastOpenFolder
+ else
+ ' New file being saved try to default to the project folder
+ if AfxFileExists( gApp.ProjectFilename ) then
+ wszFilePath = AfxStrPathname( "PATH", gApp.ProjectFilename )
+ end if
+ end if
+ gApp.wszLastOpenFolder = wszFilePath
+ end if
+
+ ' Set the file types
+ Select Case id
+ Case IDM_SAVESESSION
+ rgFileTypes(1).pszName = @wstr("Session files")
+ rgFileTypes(1).pszSpec = @WSTR("*.session")
+ rgFileTypes(2).pszName = @L(79,"All files")
+ rgFileTypes(2).pszSpec = @WSTR("*.*")
+ psfd->lpVtbl->SetFileTypes(psfd, 2, @rgFileTypes(1))
+ ' // Set the title of the dialog
+ hr = psfd->lpVtbl->SetTitle(psfd, L(425,"Save Session"))
+
+ Case IDC_FRMPROJECTOPTIONS_CMDSELECT, IDM_PROJECTSAVE, IDM_PROJECTSAVEAS
+ rgFileTypes(1).pszName = @L(216,"Project files")
+ rgFileTypes(1).pszSpec = @WSTR("*.wfbe")
+ rgFileTypes(2).pszName = @L(79,"All files")
+ rgFileTypes(2).pszSpec = @WSTR("*.*")
+ psfd->lpVtbl->SetFileTypes(psfd, 2, @rgFileTypes(1))
+ ' // Set the title of the dialog
+ hr = psfd->lpVtbl->SetTitle(psfd, L(185,"Save Project As..."))
+
+ Case IDC_FRMOPTIONSLOCAL_CMDNEW
+ rgFileTypes(1).pszName = @L(102,"Localization files")
+ rgFileTypes(1).pszSpec = @WSTR("*.lang")
+ rgFileTypes(2).pszName = @L(79,"All files")
+ rgFileTypes(2).pszSpec = @WSTR("*.*")
+ psfd->lpVtbl->SetFileTypes(psfd, 2, @rgFileTypes(1))
+ psfd->lpVtbl->SetTitle(psfd, L(8,"Save As..."))
+
+ Case Else
+ rgFileTypes(1).pszName = @L(77,"FB code files")
+ rgFileTypes(1).pszSpec = @WSTR("*.bas")
+ rgFileTypes(2).pszName = @L(78,"FB Include files")
+ rgFileTypes(2).pszSpec = @WSTR("*.bi;*.inc")
+ rgFileTypes(3).pszName = @L(209,"Resource files")
+ rgFileTypes(3).pszSpec = @WSTR("*.rc")
+ rgFileTypes(4).pszName = @L(79,"All files")
+ rgFileTypes(4).pszSpec = @WSTR("*.*")
+ psfd->lpVtbl->SetFileTypes(psfd, 4, @rgFileTypes(1))
+ psfd->lpVtbl->SetTitle(psfd, L(8,"Save As..."))
+ if pwszDefExt then
+ if *pwszDefExt = "inc" then
+ psfd->lpVtbl->SetFileTypeIndex(psfd, 2)
+ end if
+ end if
+ End Select
+
+ ' // Set the file name
+ hr = psfd->lpVtbl->SetFileName(psfd, wszFileName)
+ ' // Set the extension
+ hr = psfd->lpVtbl->SetDefaultExtension(psfd, pwszDefExt)
+
+ ' // Set the default folder to display in the save dialog
+ if len(wszFilePath ) then
+ Dim pFolder As IShellItem Ptr
+ SHCreateItemFromParsingName (wszFilePath, Null, @IID_IShellItem, @pFolder)
+ If pFolder Then
+ hr = psfd->lpVtbl->SetFolder(psfd, pFolder)
+ If SUCCEEDED(hr) Then
+ pFolder->lpVtbl->Release(pFolder)
+ end if
+ End If
+ end if
+
+ ' // Display the dialog
+ hr = psfd->lpVtbl->Show(psfd, hwndOwner)
+
+ ' // Get the result
+ Dim pItem As IShellItem Ptr
+ Dim pwszName As WString Ptr
+ If SUCCEEDED(hr) Then
+ hr = psfd->lpVtbl->GetResult(psfd, @pItem)
+ If SUCCEEDED(hr) Then
+ hr = pItem->lpVtbl->GetDisplayName(pItem, sigdnName, @pwszName)
+ Function = pwszName
+ End If
+ End If
+ ' // Cleanup
+ If pItem Then pItem->lpVtbl->Release(pItem)
+ If psfd Then psfd->lpVtbl->Release(psfd)
+
+End Function
+
+
+' ========================================================================================
+' Inserts an item at a specific location in the ListView.
+' ========================================================================================
+Function FF_ListView_InsertItem( _
+ ByVal hWndControl As HWnd, _
+ ByVal iRow As Long, _
+ ByVal iColumn As Long, _
+ ByVal pwszText As WString Ptr, _
+ ByVal lParam As LPARAM = 0 _
+ ) As BOOLEAN
+
+ Dim lvi As LVITEMW
+ lvi.iItem = iRow
+ lvi.iSubItem = iColumn
+ lvi.pszText = pwszText
+ lvi.lParam = lParam
+ If iColumn = 0 Then
+ lvi.mask = LVIF_TEXT Or LVIF_PARAM Or LVIF_IMAGE
+ Function = SendMessage( hWndControl, LVM_INSERTITEM, 0, Cast(LPARAM, @lvi) )
+ Else
+ lvi.mask = LVIF_TEXT Or LVIF_IMAGE
+ Function = SendMessage( hWndControl, LVM_SETITEM, 0, Cast(LPARAM, @lvi) )
+ End If
+End Function
+
+
+' ========================================================================================
+' Retrieves the text of a ListView item.
+' ========================================================================================
+Function FF_ListView_GetItemText( _
+ ByVal hWndControl As HWnd, _
+ ByVal iRow As Long, _
+ ByVal iColumn As Long, _
+ ByVal pwszText As WString Ptr, _
+ ByVal nTextMax As Long _
+ ) As BOOLEAN
+
+ If pwszText = 0 Then Return False
+ If nTextMax = 0 Then Return False
+ Dim lvi As LVITEMW
+
+ lvi.mask = LVIF_TEXT
+ lvi.iItem = iRow
+ lvi.iSubItem = iColumn
+ lvi.pszText = pwszText
+ lvi.cchTextMax = nTextMax
+
+ Function = SendMessage( hWndControl, LVM_GETITEM, 0, Cast(LPARAM, @lvi) )
+End Function
+
+
+' ========================================================================================
+' Set the text for the specified row and col item
+' ========================================================================================
+Function FF_ListView_SetItemText( _
+ ByVal hWndControl As HWnd, _
+ ByVal iRow As Long, _
+ ByVal iColumn As Long, _
+ ByVal pwszText As WString Ptr, _
+ ByVal nTextMax As Long _
+ ) As Long
+
+ Dim li As LV_ITEM
+ li.mask = LVIF_TEXT
+ li.iItem = iRow
+ li.iSubItem = iColumn
+ li.pszText = pwszText
+ li.cchTextMax = nTextMax
+ Function = SendMessage( hWndControl, LVM_SETITEM, 0, Cast(LPARAM, @li) )
+End Function
+
+
+' ========================================================================================
+' Retrieve the lParam value from a Listview line
+' ========================================================================================
+Function FF_ListView_GetlParam( _
+ ByVal hWndControl As HWnd, _
+ ByVal iRow As Long _
+ ) As LPARAM
+
+ Dim li As LV_ITEM
+ li.mask = LVIF_PARAM
+ li.iItem = iRow
+ li.iSubItem = 0
+ If SendMessage( hWndControl, LVM_GETITEM, 0, Cast(LPARAM, @li) ) Then
+ Function = li.lParam
+ End If
+End Function
+
+
+' ========================================================================================
+' Set the lParam value for a Listview line
+' ========================================================================================
+Function FF_ListView_SetlParam( _
+ ByVal hWndControl As HWnd, _
+ ByVal iRow As Long, _
+ ByVal ilParam As LPARAM _
+ ) As long
+ Dim li As LV_ITEM
+ li.mask = LVIF_PARAM
+ li.iItem = iRow
+ li.iSubItem = 0
+ li.lParam = ilParam
+ function = SendMessage( hWndControl, LVM_SETITEM, 0, Cast(LPARAM, @li) )
+End Function
+
+
+' ========================================================================================
+' Load a .lang localization file from disk and populate the localization array
+' The IsEnglish parameter is used when we want to populate the gLangEnglish global
+' array that is used in the WinFBE.bas startup code.
+' ========================================================================================
+Function LoadLocalizationFile( _
+ Byref wszFileName As CWSTR, _
+ byval IsEnglish as boolean = false _
+ ) As BOOLEAN
+
+ ' default that the file failed to load
+ Function = False
+ If AfxFileExists( wszFileName ) = 0 Then Exit Function
+
+ Dim as CBSTR wst, wKey, wData
+ Dim nKey As Long
+ Dim nData As Long
+ Dim i As Long
+
+ dim pStream AS CTextStream
+ if pStream.OpenUnicode( wszFileName ) <> S_OK then exit function
+
+ do until pStream.EOS
+ wst = pStream.ReadLine
+
+ If Len(wst) = 0 Then Continue Do
+ If Left(wst, 1) = "'" Then Continue Do
+
+ i = Instr(wst, ":")
+ If i = 0 Then Continue Do
+
+ wKey = "": wData = "": nData = 0
+
+ wKey = Left(wst, i-1)
+ wData = Mid(**wst, i+1) ' MID causes problems with Chinese data so ** is used.
+
+ nKey = Val(wKey)
+ nData = Val(wData)
+
+ If Ucase(wKey) = "MAXIMUM" Then
+ ' resize the global dynamic array
+ if IsEnglish then
+ ReDim gLangEnglish(nData) As WString * MAX_PATH
+ else
+ ReDim LL(nData) As WString * MAX_PATH
+ end if
+ Else
+ ' this should be a key/value pair line in the format:
+ ' 00001:value
+ ' Ensure that we add the value to the array within the valid
+ ' boundaries of the array.
+ if IsEnglish then
+ If (nKey >= LBound(gLangEnglish)) AndAlso (nKey <= Ubound(gLangEnglish)) Then
+ ' Use ** to ensure that cyrillic langauge gets converted correctly. FB intrinsic
+ ' functions (RTRIM) automatically convert those incorrectly when using CBSTR or CWSTR.
+ gLangEnglish(nKey) = rtrim(**AfxStrParse(wData, 1, ";"), any chr(9,32))
+ end if
+ else
+ If (nKey >= LBound(LL)) AndAlso (nKey <= Ubound(LL)) Then
+ ' Remove any comments from end of the line. Comments begin with
+ ' a semicolon character.
+ ' Use ** to ensure that cyrillic langauge gets converted correctly. FB intrinsic
+ ' functions (RTRIM) automatically convert those incorrectly when using CBSTR or CWSTR.
+ LL(nKey) = rtrim(**AfxStrParse(wData, 1, ";"), any chr(9,32))
+ ' If the local phrase is empty then fill it using the English version.
+ if len(LL(nKey)) = 0 then
+ If (nKey >= LBound(gLangEnglish)) AndAlso (nKey <= Ubound(gLangEnglish)) Then
+ LL(nKey) = gLangEnglish(nKey)
+ end if
+ end if
+ End If
+ end if
+ End If
+
+ Loop
+ pStream.Close
+
+ Function = True
+End Function
+
+
+' ========================================================================================
+' Get the full process image name
+' ========================================================================================
+Function GetProcessImageName( _
+ ByVal pe32w As PROCESSENTRY32W Ptr, _
+ ByVal pwszExeName As WString Ptr _
+ ) As Long
+
+ Dim dwSize As Long
+ Dim hProcess As HANDLE
+ hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 1, pe32w->th32ProcessID)
+ If hProcess Then
+ dwSize = MAX_PATH
+
+' Without using dynamic loading...
+' QueryFullProcessImageNameW( hProcess, 0, pwszExeName, @dwSize )
+' CloseHandle hProcess
+
+ ' QueryFullProcessImageNameW is only available in Vista or higher. Try to dynamically load the
+ ' function because statically linking to it will cause a runtime error if WinFBE is run using WinXP.
+ Dim As Any Ptr hLib = DyLibLoad("Kernel32")
+ If hLib then
+ dim MyQueryFullProcessImageName as function( byval hProcess as HANDLE, byval dwFlags as DWORD, byval lpExeName as LPWSTR, byval lpdwSize as PDWORD) as WINBOOL
+ MyQueryFullProcessImageName = DyLibSymbol( hLib, "QueryFullProcessImageNameW" )
+ If MyQueryFullProcessImageName Then
+ MyQueryFullProcessImageName( hProcess, 0, pwszExeName, @dwSize )
+ CloseHandle hProcess
+ end if
+ DyLibFree(hLib)
+ End If
+
+ End If
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Checks if the program that we are going to compile is already running
+' ========================================================================================
+Function IsProcessRunning( ByVal pwszExeFileName As WString Ptr ) As BOOLEAN
+
+ Dim hSnapShot As HANDLE
+ Dim pe32w As PROCESSENTRY32W
+
+ Dim wszExeFileName As WString * MAX_PATH = Ucase(*pwszExeFileName)
+ Dim wszExeProcessName As WString * MAX_PATH
+
+ pe32w.dwSize = Sizeof(pe32w)
+ hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
+
+ If hSnapShot <> INVALID_HANDLE_VALUE Then
+ If Process32First(hSnapShot, @pe32w) Then
+ GetProcessImageName( @pe32w, @wszExeProcessName )
+ If Ucase(wszExeProcessName) = wszExeFileName Then
+ Function = True
+ Else
+ Do While Process32Next(hSnapShot, @pe32w) > 0
+ GetProcessImageName( @pe32w, @wszExeProcessName )
+ If Ucase(wszExeProcessName) = wszExeFileName Then
+ Function = True
+ Exit Do
+ End If
+ Loop
+ End If
+ End If
+ CloseHandle hSnapShot
+ End If
+
+End Function
+
+
+' ========================================================================================
+' Determine the EXE name of the currently active document or project.
+' ========================================================================================
+function GetRunExecutableFilename() as CWSTR
+ ' Used by the top menu to determine if the Run Executable option is available
+ dim wszFilename as CWSTR
+ dim wszOptions as CWSTR
+ Dim pDocMain As clsDocument Ptr
+
+ dim as long idxBuild = frmBuildConfig_getActiveBuildIndex()
+ dim as Boolean bInString = false
+
+ pDocMain = iIf( gApp.IsProjectActive, gApp.GetMainDocumentPtr, gTTabCtl.GetActiveDocumentPtr)
+ If pDocMain = 0 Then return ""
+
+ if idxBuild > -1 then
+ wszOptions = gConfig.Builds(idxBuild).wszOptions
+
+ if gApp.IsProjectActive THEN
+ if gConfig.Builds(idxBuild).Is32bit then
+ wszOptions = wszOptions + " " + gApp.ProjectOther32
+ end if
+ if gConfig.Builds(idxBuild).Is64bit then
+ wszOptions = wszOptions + " " + gApp.ProjectOther64
+ end if
+ else
+ wszOptions = wszOptions + " " + gConfig.CompilerSwitches
+ END IF
+ wszOptions = " " + ucase(wszOptions) + " "
+
+ If Instr(wszOptions, wstr(" -DLL ")) Then return ""
+ If Instr(wszOptions, wstr(" -DYLIB ")) Then return ""
+ If Instr(wszOptions, wstr(" -LIB ")) then return ""
+
+ end if
+
+ ' Need to check the compiler options to see if the -x switch is used. That switch specifically
+ ' names the output file.
+ dim y as long = Instr(wszOptions, wstr(" -X "))
+ if y THEN
+ y = y + 4 ' skip over the switch itself
+ for i as long = y to len(wszOptions)
+ ' iterate to the beginning of the next switch or end of the string
+ ' skip over spaces that are part of a filename string
+ if wszOptions[i-1] = 34 THEN bInString = not bInString ' double quotes
+ if bInString THEN continue for
+ if wszOptions[i-1] = 45 then ' dash
+ wszFilename = mid(wszOptions, y, i-y-1)
+ exit for
+ end if
+ NEXT
+ ' There was no other switch so we made it to the end of the string
+ if len(wszFilename) = 0 then wszFilename = mid(wszOptions, y)
+ END IF
+
+ ' Has a filename been determined yet? If it has then it possibly does not have
+ ' a path assigned to it so we should add one.
+ if len(wszFilename) THEN
+ if len(AfxStrPathname("PATH", wszFilename)) = 0 THEN
+ wszFilename = AfxStrPathname("PATH", pDocMain->DiskFilename) + wszFilename
+ END IF
+ else
+ ' Default
+ wszFilename = AfxStrPathname("PATH", pDocMain->DiskFilename) + _
+ AfxStrPathname("NAME", pDocMain->DiskFilename) + _
+ wstr(".exe")
+ END IF
+
+ return wszFilename
+
+END FUNCTION
+
+
+
+' ========================================================================================
+' Loads an image from a resource, converts it to an icon or bitmap and returns a pointer
+' to the raw PNG pixels. This is needed by the scintilla autocomplete popup.
+' Memory is ALLOCATE so it needs to be DEALLOCATE.
+' Parameters:
+' - hInstance = [in] A handle to the module whose portable executable file or an accompanying
+' MUI file contains the resource. If this parameter is NULL, the function searches
+' the module used to create the current process.
+' - wszImageName = [in] Name of the image in the resource file (.RES). If the image resource uses
+' an integral identifier, wszImage should begin with a number symbol (#)
+' followed by the identifier in an ASCII format, e.g., "#998". Otherwise,
+' use the text identifier name for the image. Only images embedded as raw data
+' (type RCDATA) are valid. These must be icons in format .png, .jpg, .gif, .tiff.
+' ========================================================================================
+TYPE MYBITMAPINFO
+ bmiHeader AS BITMAPINFOHEADER
+ bmiColors(256) AS RGBQUAD
+END TYPE
+
+
+' ========================================================================================
+' Get a raw PNG from the Resource - needed to load images into Scintilla popup list.
+' ========================================================================================
+FUNCTION LoadPNGfromRes( _
+ BYVAL hInstance AS HINSTANCE, _
+ BYREF wszImageName AS WSTRING _
+ ) as any ptr
+
+ dim as HBITMAP hBitmap = AfxGdipImageFromRes(hInstance, wszImageName, 0, false, IMAGE_BITMAP)
+
+ dim bi AS MYBITMAPINFO
+ dim bm AS BITMAP
+ dim dwp AS DWORD PTR
+ dim as HDC hIC, hDC
+ dim as any ptr pPixel
+
+ IF hBitmap THEN
+ hIC = GetWindowDC(0)
+ hDC = CreateCompatibleDC(hIC)
+ SelectObject(hDC, hBitmap)
+
+ GetObject(hBitmap, SIZEOF(bm), @bm)
+ bi.bmiHeader.biSize = SIZEOF(bi.bmiHeader)
+ bi.bmiHeader.biWidth = bm.bmWidth
+ bi.bmiHeader.biHeight = -bm.bmHeight ' Put top in TOP instead on bottom!
+ bi.bmiHeader.biPlanes = 1
+ bi.bmiHeader.biBitCount = 32
+ bi.bmiHeader.biCompression = BI_RGB
+
+ pPixel = ALLOCATE((bm.bmWidth * bm.bmHeight) * sizeof(DWORD))
+ dwp = cast(dword ptr, pPixel)
+ GetDIBits( hDC, hBitmap, 0, bm.bmHeight, _
+ BYVAL dwp, cast(LPBITMAPINFO, @bi), DIB_RGB_COLORS)
+
+ DeleteDC(hIC)
+ DeleteDC(hDC)
+ end if
+
+ ' // Return the handle to the PNG raw pixels
+ DeleteObject(hBitmap)
+ return pPixel
+END FUNCTION
+
+
+' ========================================================================================
+' Check PlanetSquires server for latest WinFBE version.
+' ========================================================================================
+function DoCheckForUpdates( _
+ byval hWndParent as hwnd, _
+ byval bSilentCheck as Boolean = false _
+ ) as long
+
+ ' Check safeguard for when Beta versions are issued.
+ if PREVENT_UPDATE_CHECK then exit function
+
+ '' Contact the PlanetSquires server and download the text file containing
+ '' the latest WinFBE version number. If an update exists then ask the user
+ '' if they wish to navigate to the Releases page on GitHub.
+ ''
+ dim as CWSTR wszServerFile = "winfbe_version.txt"
+ dim as CWSTR wszFilename
+ dim as CWSTR wszLatestVersion
+ dim as CWSTR wszMsg
+ dim as string st
+ dim as boolean bFailedCheck = false
+
+ if AfxWinHttpCheckPlatform() = false then
+ ' This platform does not support the Windows HTTP Services (WinHTTP)
+ 'print "Windows HTTP Services (WinHTTP) not supported on this platform"
+ exit function
+ end if
+
+ DIM pWHttp AS CWinHttpRequest
+
+ wszFilename = AfxGetExePathName & wszServerFile
+
+ ' Open an HTTP connection to an HTTP resource (synchronous mode)
+ if pWHttp.Open( "GET", "https://www.planetsquires.com/" & wszServerFile ) = S_OK then
+
+ ' Send HTTP request and wait 5 seconds for response
+ pWHttp.Send
+
+ if pWHttp.WaitForResponse(5) then
+ st = pWHttp.GetResponseBody
+ ' Open a file stream and save the downloaded file
+ DIM pFileStream AS CFileStream
+ IF pFileStream.Open(wszFilename, STGM_CREATE OR STGM_WRITE) = S_OK then
+ pFileStream.WriteTextA(st)
+ pFileStream.Close
+ else
+ bFailedCheck = true
+ END IF
+ end if
+
+ else
+ bFailedCheck = true
+ 'print "Error GET update version file: "; pWHttp.GetErrorInfo()
+ end if
+
+ ' Open the downloaded file and check for the version number. It is possible that the socket
+ ' will open but fail and send request but security parameters of the system will prevent data
+ ' from being received resulting in a zero byte file.
+ if bFailedCheck = false then
+ if AfxFileExists( wszFilename ) then
+ dim pStream AS CTextStream
+ if pStream.Open(wszFilename, IOMODE_FORREADING) = S_OK then
+ Do Until pStream.EOS
+ st = pStream.ReadLine
+ if left( st, 15 ) = "latest_version=" then
+ wszLatestVersion = trim(mid( st, 16 ))
+ if len(wszLatestVersion) = 0 then
+ bFailedCheck = true
+ end if
+ exit do
+ end if
+ loop
+ pStream.Close
+ end if
+ end if
+ end if
+
+ ' Check the installed vs. available version numbers
+ dim as long latestVersion = ConvertWinFBEversion(wszLatestVersion)
+ dim as long installedVersion = ConvertWinFBEversion(APPVERSION)
+
+ if (bFailedCheck = true) or (latestVersion = 0) then
+ if bSilentCheck = false then
+ MessageBox( hWndParent, _
+ L(92,"Failed to retrieve update information"), _
+ L(94,"Software Update"), _
+ MB_ICONINFORMATION Or MB_OK )
+ end if
+ AfxDeleteFile( wszFilename )
+ exit function
+ end if
+
+
+ ' Save the config file so that other editor instances will not also do update checks again
+ gConfig.LastUpdateCheck = JulianDateNow
+ gConfig.SaveConfigFile
+
+ AfxDeleteFile( wszFilename )
+
+ if bSilentCheck = false then
+ if installedVersion >= latestVersion then
+ wszMsg = L(96,"You are up to date!") & vbcrlf & _
+ "WinFBE v" & APPVERSION & " " & L(97,"is currently the newest version available.")
+ MessageBox( hWndParent, wszMsg,L(94,"Software Update"), MB_ICONINFORMATION Or MB_OK )
+
+ elseif installedVersion < latestVersion then
+ wszMsg = APPNAME & vbcrlf & _
+ L(98,"A new version is available.") & vbcrlf & vbcrlf & _
+ L(99,"Current") & ": " & APPVERSION & vbcrlf & _
+ L(107,"Available") & ": " & wszLatestVersion & vbcrlf & vbcrlf & _
+ L(137,"Do you wish to visit the download website?")
+ If MessageBox( hWndParent, wszMsg, L(94,"Software Update"), MB_ICONQUESTION Or MB_YESNOCANCEL ) = IDYES Then
+ ShellExecute( NULL, "open", "https://github.com/PaulSquires/WinFBE/releases", Null, Null, SW_SHOWNORMAL )
+ end if
+ end if
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Calcluate the client area at bottom of Listbox not covered by a row (needed to manually
+' paint the unused area in WM_ERASEBKGRD messages to avoid flicker.
+' ========================================================================================
+function GetListBoxEmptyClientArea( _
+ byval hListBox as HWND, _
+ byval nLineHeight as long _
+ ) as RECT
+
+ dim as RECT rc: GetClientRect( hListBox, @rc )
+ ' If the number of lines in the listbox is less than the number per page then
+ ' calculate from last item to bottom of listbox, otherwise calculate based on
+ ' the mod of the lineheight to listbox height so we can color the partial line
+ ' that won't be displayed at the bottom of the list.
+ dim as RECT rcItem
+ SendMessage( hListBox, LB_GETITEMRECT, 0, cast(LPARAM, @rcItem) )
+ dim as long itemHeight = rcItem.bottom - rcItem.top
+ dim as long NumItems = ListBox_GetCount(hListBox)
+ dim as long ItemsPerPage = ( rc.bottom \ itemHeight )
+ dim as long nTopIndex = SendMessage( hListBox, LB_GETTOPINDEX, 0, 0 )
+ dim as long visible_rows = 0
+
+ if NumItems > 0 then
+ ItemsPerPage = (rc.bottom - rc.top) / itemHeight
+ dim as long bottom_index = (nTopIndex + ItemsPerPage)
+ if bottom_index >= NumItems then bottom_index = NumItems - 1
+ visible_rows = (bottom_index - nTopIndex) + 1
+ end if
+
+ rc.top = visible_rows * itemHeight
+ if rc.top > rc.bottom then rc.top = rc.bottom
+
+ return rc
+end function
\ No newline at end of file
diff --git a/src/modScintilla.bi b/src/modScintilla.bi
index 235c0a5e..5984dce4 100644
--- a/src/modScintilla.bi
+++ b/src/modScintilla.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modScintilla.bi.bak b/src/modScintilla.bi.bak
new file mode 100644
index 00000000..235c0a5e
--- /dev/null
+++ b/src/modScintilla.bi.bak
@@ -0,0 +1,1187 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+'' Scintilla source code edit control v. 3.0.3
+'' @file Scintilla.h
+'' Interface to the edit control.
+''
+'' Copyright 1998-2003 by Neil Hodgson
+'' The License.txt file describes the conditions under which this software may be distributed.
+
+'' THIS FILE CONTAINS ALL OF THE SCINTILLA INTERFACE CONSTANTS AND STRUCTURES
+'' Scintilla.h
+'' SciLexer.h
+'' Lexilla.h
+
+
+#Pragma Once
+
+#Include Once "Windows.bi"
+
+#Define SCLEX_VB 8 ' // Visual Basic lexer
+#Define SCE_B_DEFAULT 0
+#Define SCE_B_COMMENT 1
+#Define SCE_B_NUMBER 2
+#Define SCE_B_KEYWORD 3
+#Define SCE_B_STRING 4
+#Define SCE_B_PREPROCESSOR 5
+#Define SCE_B_OPERATOR 6
+#Define SCE_B_IDENTIFIER 7
+#Define SCE_B_DATE 8
+#Define SCE_B_STRINGEOL 9
+#Define SCE_B_KEYWORD2 10
+#Define SCE_B_KEYWORD3 11
+#Define SCE_B_KEYWORD4 12
+#Define SCE_B_CONSTANT 13
+#Define SCE_B_ASM 14
+#Define SCE_B_LABEL 15
+#Define SCE_B_ERROR 16
+#Define SCE_B_HEXNUMBER 17
+#Define SCE_B_BINNUMBER 18
+#Define SCE_B_MULTILINECOMMENT 19
+
+'// Define the default Lexilla shared library name for each platform
+#define LEXILLA_LIB "lexilla"
+#define LEXILLA_EXTENSION ".dll"
+
+'// On Win32 use the stdcall calling convention otherwise use the standard calling convention
+#define LEXILLA_CALL __stdcall
+
+'// MSVC __declspec(deprecated) has different positioning rules to GCC so define to nothing
+#define DEPRECATE_DEFINITION
+
+type ILexer5 as any
+type LexerFactoryFunction as function cdecl() as ILexer5 ptr
+
+type GetLexerCountFn as function() as long
+type GetLexerNameFn as sub(byval Index as ulong, byval name as zstring ptr, byval buflength as long)
+type GetLexerFactoryFn as function(byval Index as ulong) as LexerFactoryFunction
+type CreateLexerFn as function (byval name as const zstring ptr) as ILexer5 ptr
+type LexerNameFromIDFn as function(byval identifier as long) as const zstring ptr
+type GetLibraryPropertyNamesFn as function() as const zstring ptr
+type SetLibraryPropertyFn as sub(byval key as const zstring ptr, byval value as const zstring ptr)
+type GetNameSpaceFn as function() as const zstring ptr
+
+#define LEXILLA_NAMESPACE_SEPARATOR asc('.')
+
+#define LEXILLA_GETLEXERCOUNT "GetLexerCount"
+#define LEXILLA_GETLEXERNAME "GetLexerName"
+#define LEXILLA_GETLEXERFACTORY "GetLexerFactory"
+#define LEXILLA_CREATELEXER "CreateLexer"
+#define LEXILLA_LEXERNAMEFROMID "LexerNameFromID"
+#define LEXILLA_GETLIBRARYPROPERTYNAMES "GetLibraryPropertyNames"
+#define LEXILLA_SETLIBRARYPROPERTY "SetLibraryProperty"
+#define LEXILLA_GETNAMESPACE "GetNameSpace"
+
+' ========================================================================================
+' Declaration of the only function exported by SciLexer.dll.
+' All the comunication with the control is done sending messages.
+' Note: Since no function is provided to register the classes, the only way is to load the
+' library with LoadLibrary (the attach process automatically register the classes) and free
+' it with FreeLibrary (the detach process unregisters the classes).
+' ========================================================================================
+Type Scintilla_DirectFunction As _
+ Function CDECL( ByVal As Any Ptr, _
+ ByVal As UINT, _
+ ByVal As WPARAM, _
+ ByVal As LPARAM ) As LRESULT
+
+Dim Shared SciMsg As Scintilla_DirectFunction
+'Dim pSci As Any Ptr
+'
+'SciMsg = Cast( Scintilla_DirectFunction, SendMessage( HWnd, SCI_GETDIRECTFUNCTION, 0, 0 ) )
+'pSci = SendMessage( HWnd, SCI_GETDIRECTPOINTER, 0, 0 )
+'
+'canundo = SciMsg( pSci, SCI_CANUNDO, 0, 0)
+
+
+'' ++Autogenerated -- start of section automatically generated from Scintilla.iface
+#Define SCI_TARGETWHOLEDOCUMENT 2690
+
+#Define INVALID_POSITION -1
+#Define SCI_START 2000
+#Define SCI_OPTIONAL_START 3000
+#Define SCI_LEXER_START 4000
+#define SCI_SETILEXER 4033
+#Define SCI_ADDTEXT 2001
+#Define SCI_ADDSTYLEDTEXT 2002
+#Define SCI_INSERTTEXT 2003
+#Define SCI_CLEARALL 2004
+#Define SCI_DELETERANGE 2645
+#Define SCI_CLEARDOCUMENTSTYLE 2005
+#Define SCI_GETLENGTH 2006
+#Define SCI_GETCHARAT 2007
+#Define SCI_GETCURRENTPOS 2008
+#Define SCI_GETANCHOR 2009
+#Define SCI_GETSTYLEAT 2010
+#Define SCI_REDO 2011
+#Define SCI_SETUNDOCOLLECTION 2012
+#Define SCI_SELECTALL 2013
+#Define SCI_SETSAVEPOINT 2014
+#Define SCI_GETSTYLEDTEXT 2015
+#Define SCI_CANREDO 2016
+#Define SCI_MARKERLINEFROMHANDLE 2017
+#Define SCI_MARKERDELETEHANDLE 2018
+#Define SCI_GETUNDOCOLLECTION 2019
+#Define SCWS_INVISIBLE 0
+#Define SCWS_VISIBLEALWAYS 1
+#Define SCWS_VISIBLEAFTERINDENT 2
+#Define SCI_GETVIEWWS 2020
+#Define SCI_SETVIEWWS 2021
+#Define SCI_POSITIONFROMPOINT 2022
+#Define SCI_POSITIONFROMPOINTCLOSE 2023
+#Define SCI_GOTOLINE 2024
+#Define SCI_GOTOPOS 2025
+#Define SCI_SETANCHOR 2026
+#Define SCI_GETCURLINE 2027
+#Define SCI_GETENDSTYLED 2028
+#Define SC_EOL_CRLF 0
+#Define SC_EOL_CR 1
+#Define SC_EOL_LF 2
+#Define SCI_CONVERTEOLS 2029
+#Define SCI_GETEOLMODE 2030
+#Define SCI_SETEOLMODE 2031
+#Define SCI_STARTSTYLING 2032
+#Define SCI_SETSTYLING 2033
+#Define SCI_GETBUFFEREDDRAW 2034
+#Define SCI_SETBUFFEREDDRAW 2035
+#Define SCI_SETTABWIDTH 2036
+#Define SCI_GETTABWIDTH 2121
+#Define SC_CP_UTF8 65001
+#Define SCI_SETCODEPAGE 2037
+#Define MARKER_MAX 31
+#Define SC_MARK_CIRCLE 0
+#Define SC_MARK_ROUNDRECT 1
+#Define SC_MARK_ARROW 2
+#Define SC_MARK_SMALLRECT 3
+#Define SC_MARK_SHORTARROW 4
+#Define SC_MARK_EMPTY 5
+#Define SC_MARK_ARROWDOWN 6
+#Define SC_MARK_MINUS 7
+#Define SC_MARK_PLUS 8
+#Define SC_MARK_VLINE 9
+#Define SC_MARK_LCORNER 10
+#Define SC_MARK_TCORNER 11
+#Define SC_MARK_BOXPLUS 12
+#Define SC_MARK_BOXPLUSCONNECTED 13
+#Define SC_MARK_BOXMINUS 14
+#Define SC_MARK_BOXMINUSCONNECTED 15
+#Define SC_MARK_LCORNERCURVE 16
+#Define SC_MARK_TCORNERCURVE 17
+#Define SC_MARK_CIRCLEPLUS 18
+#Define SC_MARK_CIRCLEPLUSCONNECTED 19
+#Define SC_MARK_CIRCLEMINUS 20
+#Define SC_MARK_CIRCLEMINUSCONNECTED 21
+#Define SC_MARK_BACKGROUND 22
+#Define SC_MARK_DOTDOTDOT 23
+#Define SC_MARK_ARROWS 24
+#Define SC_MARK_PIXMAP 25
+#Define SC_MARK_FULLRECT 26
+#Define SC_MARK_LEFTRECT 27
+#Define SC_MARK_AVAILABLE 28
+#Define SC_MARK_UNDERLINE 29
+#Define SC_MARK_RGBAIMAGE 30
+#define SC_MARK_BOOKMARK 31
+#define SC_MARK_VERTICALBOOKMARK 32
+#Define SC_MARK_CHARACTER 10000
+#Define SC_MARKNUM_FOLDEREND 25
+#Define SC_MARKNUM_FOLDEROPENMID 26
+#Define SC_MARKNUM_FOLDERMIDTAIL 27
+#Define SC_MARKNUM_FOLDERTAIL 28
+#Define SC_MARKNUM_FOLDERSUB 29
+#Define SC_MARKNUM_FOLDER 30
+#Define SC_MARKNUM_FOLDEROPEN 31
+#Define SC_MASK_FOLDERS &HFE000000
+#Define SCI_MARKERDEFINE 2040
+#Define SCI_MARKERSETFORE 2041
+#Define SCI_MARKERSETBACK 2042
+#Define SCI_MARKERSETBACKSELECTED 2292
+#Define SCI_MARKERENABLEHIGHLIGHT 2293
+#Define SCI_MARKERADD 2043
+#Define SCI_MARKERDELETE 2044
+#Define SCI_MARKERDELETEALL 2045
+#Define SCI_MARKERGET 2046
+#Define SCI_MARKERNEXT 2047
+#Define SCI_MARKERPREVIOUS 2048
+#Define SCI_MARKERDEFINEPIXMAP 2049
+#Define SCI_MARKERADDSET 2466
+#Define SCI_MARKERSETALPHA 2476
+#Define SC_MAX_MARGIN 4
+#Define SC_MARGIN_SYMBOL 0
+#Define SC_MARGIN_NUMBER 1
+#Define SC_MARGIN_BACK 2
+#Define SC_MARGIN_FORE 3
+#Define SC_MARGIN_TEXT 4
+#Define SC_MARGIN_RTEXT 5
+#Define SCI_SETMARGINTYPEN 2240
+#Define SCI_GETMARGINTYPEN 2241
+#Define SCI_SETMARGINWIDTHN 2242
+#Define SCI_GETMARGINWIDTHN 2243
+#Define SCI_SETMARGINMASKN 2244
+#Define SCI_GETMARGINMASKN 2245
+#Define SCI_SETMARGINSENSITIVEN 2246
+#Define SCI_GETMARGINSENSITIVEN 2247
+#Define SCI_SETMARGINCURSORN 2248
+#Define SCI_GETMARGINCURSORN 2249
+#Define STYLE_AUTOCOMPLETE 255 ' Added by Paul / WinFBE
+#define STYLE_DEFAULT 32
+#Define STYLE_LINENUMBER 33
+#Define STYLE_BRACELIGHT 34
+#Define STYLE_BRACEBAD 35
+#Define STYLE_CONTROLCHAR 36
+#Define STYLE_INDENTGUIDE 37
+#Define STYLE_CALLTIP 38
+#Define STYLE_FOLDDISPLAYTEXT 39
+#Define STYLE_LASTPREDEFINED 39
+#Define STYLE_MAX 255
+#Define SC_CHARSET_ANSI 0
+#Define SC_CHARSET_DEFAULT 1
+#Define SC_CHARSET_BALTIC 186
+#Define SC_CHARSET_CHINESEBIG5 136
+#Define SC_CHARSET_EASTEUROPE 238
+#Define SC_CHARSET_GB2312 134
+#Define SC_CHARSET_GREEK 161
+#Define SC_CHARSET_HANGUL 129
+#Define SC_CHARSET_MAC 77
+#Define SC_CHARSET_OEM 255
+#Define SC_CHARSET_RUSSIAN 204
+#Define SC_CHARSET_CYRILLIC 1251
+#Define SC_CHARSET_SHIFTJIS 128
+#Define SC_CHARSET_SYMBOL 2
+#Define SC_CHARSET_TURKISH 162
+#Define SC_CHARSET_JOHAB 130
+#Define SC_CHARSET_HEBREW 177
+#Define SC_CHARSET_ARABIC 178
+#Define SC_CHARSET_VIETNAMESE 163
+#Define SC_CHARSET_THAI 222
+#Define SC_CHARSET_8859_15 1000
+#Define SCI_STYLECLEARALL 2050
+#Define SCI_STYLESETFORE 2051
+#Define SCI_STYLESETBACK 2052
+#Define SCI_STYLESETBOLD 2053
+#Define SCI_STYLESETITALIC 2054
+#Define SCI_STYLESETSIZE 2055
+#Define SCI_STYLESETFONT 2056
+#Define SCI_STYLESETEOLFILLED 2057
+#Define SCI_STYLERESETDEFAULT 2058
+#Define SCI_STYLESETUNDERLINE 2059
+#Define SC_CASE_MIXED 0
+#Define SC_CASE_UPPER 1
+#Define SC_CASE_LOWER 2
+#Define SC_CASE_CAMEL 3
+#Define SCI_STYLEGETFORE 2481
+#Define SCI_STYLEGETBACK 2482
+#Define SCI_STYLEGETBOLD 2483
+#Define SCI_STYLEGETITALIC 2484
+#Define SCI_STYLEGETSIZE 2485
+#Define SCI_STYLEGETFONT 2486
+#Define SCI_STYLEGETEOLFILLED 2487
+#Define SCI_STYLEGETUNDERLINE 2488
+#Define SCI_STYLEGETCASE 2489
+#Define SCI_STYLEGETCHARACTERSET 2490
+#Define SCI_STYLEGETVISIBLE 2491
+#Define SCI_STYLEGETCHANGEABLE 2492
+#Define SCI_STYLEGETHOTSPOT 2493
+#Define SCI_STYLESETCASE 2060
+#Define SC_FONT_SIZE_MULTIPLIER 100
+#Define SCI_STYLESETSIZEFRACTIONAL 2061
+#Define SCI_STYLEGETSIZEFRACTIONAL 2062
+#Define SC_WEIGHT_NORMAL 400
+#Define SC_WEIGHT_SEMIBOLD 600
+#Define SC_WEIGHT_BOLD 700
+#Define SCI_STYLESETWEIGHT 2063
+#Define SCI_STYLEGETWEIGHT 2064
+#Define SCI_STYLESETCHARACTERSET 2066
+#Define SCI_STYLESETHOTSPOT 2409
+#Define SCI_SETSELFORE 2067
+#Define SCI_SETSELBACK 2068
+#Define SCI_GETSELALPHA 2477
+#Define SCI_SETSELALPHA 2478
+#Define SCI_GETSELEOLFILLED 2479
+#Define SCI_SETSELEOLFILLED 2480
+#Define SCI_SETCARETFORE 2069
+#Define SCI_ASSIGNCMDKEY 2070
+#Define SCI_CLEARCMDKEY 2071
+#Define SCI_CLEARALLCMDKEYS 2072
+#Define SCI_SETSTYLINGEX 2073
+#Define SCI_STYLESETVISIBLE 2074
+#Define SCI_GETCARETPERIOD 2075
+#Define SCI_SETCARETPERIOD 2076
+#Define SCI_SETWORDCHARS 2077
+#Define SCI_GETWORDCHARS 2646
+#Define SCI_BEGINUNDOACTION 2078
+#Define SCI_ENDUNDOACTION 2079
+#Define INDIC_PLAIN 0
+#Define INDIC_SQUIGGLE 1
+#Define INDIC_TT 2
+#Define INDIC_DIAGONAL 3
+#Define INDIC_STRIKE 4
+#Define INDIC_HIDDEN 5
+#Define INDIC_BOX 6
+#Define INDIC_ROUNDBOX 7
+#Define INDIC_STRAIGHTBOX 8
+#Define INDIC_DASH 9
+#Define INDIC_DOTS 10
+#Define INDIC_SQUIGGLELOW 11
+#Define INDIC_DOTBOX 12
+#Define INDIC_SQUIGGLEPIXMAP 13
+#Define INDIC_COMPOSITIONTHICK 14
+#define INDIC_COMPOSITIONTHIN 15
+#define INDIC_FULLBOX 16
+#define INDIC_TEXTFORE 17
+#define INDIC_POINT 18
+#define INDIC_POINTCHARACTER 19
+#define INDIC_GRADIENT 20
+#define INDIC_GRADIENTCENTRE 21
+#Define INDIC_MAX 31
+#Define INDIC_CONTAINER 8
+#Define INDIC0_MASK &H20
+#Define INDIC1_MASK &H40
+#Define INDIC2_MASK &H80
+#Define INDICS_MASK &HE0
+#Define SCI_INDICSETSTYLE 2080
+#Define SCI_INDICGETSTYLE 2081
+#Define SCI_INDICSETFORE 2082
+#Define SCI_INDICGETFORE 2083
+#Define SCI_INDICSETUNDER 2510
+#Define SCI_INDICGETUNDER 2511
+#Define SCI_SETWHITESPACEFORE 2084
+#Define SCI_SETWHITESPACEBACK 2085
+#Define SCI_SETWHITESPACESIZE 2086
+#Define SCI_GETWHITESPACESIZE 2087
+#Define SCI_SETSTYLEBITS 2090
+#Define SCI_GETSTYLEBITS 2091
+#Define SCI_SETLINESTATE 2092
+#Define SCI_GETLINESTATE 2093
+#Define SCI_GETMAXLINESTATE 2094
+#Define SCI_GETCARETLINEVISIBLE 2095
+#Define SCI_SETCARETLINEVISIBLE 2096
+#Define SCI_GETCARETLINEBACK 2097
+#Define SCI_SETCARETLINEBACK 2098
+#Define SCI_STYLESETCHANGEABLE 2099
+#define SCN_AUTOCSELECTIONCHANGE 2032
+#Define SCI_AUTOCSHOW 2100
+#Define SCI_AUTOCCANCEL 2101
+#Define SCI_AUTOCACTIVE 2102
+#Define SCI_AUTOCPOSSTART 2103
+#Define SCI_AUTOCCOMPLETE 2104
+#Define SCI_AUTOCSTOPS 2105
+#Define SCI_AUTOCSETSEPARATOR 2106
+#Define SCI_AUTOCGETSEPARATOR 2107
+#Define SCI_AUTOCSELECT 2108
+#Define SCI_AUTOCSETCANCELATSTART 2110
+#Define SCI_AUTOCGETCANCELATSTART 2111
+#Define SCI_AUTOCSETFILLUPS 2112
+#Define SCI_AUTOCSETCHOOSESINGLE 2113
+#Define SCI_AUTOCGETCHOOSESINGLE 2114
+#Define SCI_AUTOCSETIGNORECASE 2115
+#Define SCI_AUTOCGETIGNORECASE 2116
+#Define SCI_USERLISTSHOW 2117
+#Define SCI_AUTOCSETAUTOHIDE 2118
+#Define SCI_AUTOCGETAUTOHIDE 2119
+#Define SCI_AUTOCSETDROPRESTOFWORD 2270
+#Define SCI_AUTOCGETDROPRESTOFWORD 2271
+#Define SCI_REGISTERIMAGE 2405
+#Define SCI_CLEARREGISTEREDIMAGES 2408
+#Define SCI_AUTOCGETTYPESEPARATOR 2285
+#Define SCI_AUTOCSETTYPESEPARATOR 2286
+#Define SCI_AUTOCSETMAXWIDTH 2208
+#Define SCI_AUTOCGETMAXWIDTH 2209
+#Define SCI_AUTOCSETMAXHEIGHT 2210
+#Define SCI_AUTOCGETMAXHEIGHT 2211
+#Define SCI_SETINDENT 2122
+#Define SCI_GETINDENT 2123
+#Define SCI_SETUSETABS 2124
+#Define SCI_GETUSETABS 2125
+#Define SCI_SETLINEINDENTATION 2126
+#Define SCI_GETLINEINDENTATION 2127
+#Define SCI_GETLINEINDENTPOSITION 2128
+#Define SCI_GETCOLUMN 2129
+#Define SCI_COUNTCHARACTERS 2633
+#Define SCI_SETHSCROLLBAR 2130
+#Define SCI_GETHSCROLLBAR 2131
+#Define SC_IV_NONE 0
+#Define SC_IV_REAL 1
+#Define SC_IV_LOOKFORWARD 2
+#Define SC_IV_LOOKBOTH 3
+#Define SCI_SETINDENTATIONGUIDES 2132
+#Define SCI_GETINDENTATIONGUIDES 2133
+#Define SCI_SETHIGHLIGHTGUIDE 2134
+#Define SCI_GETHIGHLIGHTGUIDE 2135
+#Define SCI_GETLINEENDPOSITION 2136
+#Define SCI_GETCODEPAGE 2137
+#Define SCI_GETCARETFORE 2138
+#Define SCI_GETREADONLY 2140
+#Define SCI_SETCURRENTPOS 2141
+#Define SCI_SETSELECTIONSTART 2142
+#Define SCI_GETSELECTIONSTART 2143
+#Define SCI_SETSELECTIONEND 2144
+#Define SCI_GETSELECTIONEND 2145
+#Define SCI_SETEMPTYSELECTION 2556
+#Define SCI_SETPRINTMAGNIFICATION 2146
+#Define SCI_GETPRINTMAGNIFICATION 2147
+#Define SC_PRINT_NORMAL 0
+#Define SC_PRINT_INVERTLIGHT 1
+#Define SC_PRINT_BLACKONWHITE 2
+#Define SC_PRINT_COLOURONWHITE 3
+#Define SC_PRINT_COLOURONWHITEDEFAULTBG 4
+#Define SCI_SETPRINTCOLOURMODE 2148
+#Define SCI_GETPRINTCOLOURMODE 2149
+#Define SCFIND_WHOLEWORD 2
+#Define SCFIND_MATCHCASE 4
+#Define SCFIND_WORDSTART &H00100000
+#Define SCFIND_REGEXP &H00200000
+#Define SCFIND_POSIX &H00400000
+#Define SCI_FINDTEXT 2150
+#Define SCI_FORMATRANGE 2151
+#Define SCI_GETFIRSTVISIBLELINE 2152
+#Define SCI_GETLINE 2153
+#Define SCI_GETLINECOUNT 2154
+#Define SCI_SETMARGINLEFT 2155
+#Define SCI_GETMARGINLEFT 2156
+#Define SCI_SETMARGINRIGHT 2157
+#Define SCI_GETMARGINRIGHT 2158
+#Define SCI_GETMODIFY 2159
+#Define SCI_SETSEL 2160
+#Define SCI_GETSELTEXT 2161
+#Define SCI_GETTEXTRANGE 2162
+#Define SCI_HIDESELECTION 2163
+#Define SCI_POINTXFROMPOSITION 2164
+#Define SCI_POINTYFROMPOSITION 2165
+#Define SCI_LINEFROMPOSITION 2166
+#Define SCI_POSITIONFROMLINE 2167
+#Define SCI_LINESCROLL 2168
+#Define SCI_SCROLLCARET 2169
+#Define SCI_SCROLLRANGE 2569
+#Define SCI_REPLACESEL 2170
+#Define SCI_SETREADONLY 2171
+#Define SCI_NULL 2172
+#Define SCI_CANPASTE 2173
+#Define SCI_CANUNDO 2174
+#Define SCI_EMPTYUNDOBUFFER 2175
+#Define SCI_UNDO 2176
+#Define SCI_CUT 2177
+#Define SCI_COPY 2178
+#Define SCI_PASTE 2179
+#Define SCI_CLEAR 2180
+#Define SCI_SETTEXT 2181
+#Define SCI_GETTEXT 2182
+#Define SCI_GETTEXTLENGTH 2183
+#Define SCI_GETDIRECTFUNCTION 2184
+#Define SCI_GETDIRECTPOINTER 2185
+#Define SCI_SETOVERTYPE 2186
+#Define SCI_GETOVERTYPE 2187
+#Define SCI_SETCARETWIDTH 2188
+#Define SCI_GETCARETWIDTH 2189
+#Define SCI_SETTARGETSTART 2190
+#Define SCI_GETTARGETSTART 2191
+#Define SCI_SETTARGETEND 2192
+#Define SCI_GETTARGETEND 2193
+#Define SCI_REPLACETARGET 2194
+#Define SCI_REPLACETARGETRE 2195
+#Define SCI_SEARCHINTARGET 2197
+#define SCI_GETTARGETTEXT 2687
+#Define SCI_SETSEARCHFLAGS 2198
+#Define SCI_GETSEARCHFLAGS 2199
+#Define SCI_CALLTIPSHOW 2200
+#Define SCI_CALLTIPCANCEL 2201
+#Define SCI_CALLTIPACTIVE 2202
+#Define SCI_CALLTIPPOSSTART 2203
+#Define SCI_CALLTIPSETHLT 2204
+#Define SCI_CALLTIPSETBACK 2205
+#Define SCI_CALLTIPSETFORE 2206
+#Define SCI_CALLTIPSETFOREHLT 2207
+#Define SCI_CALLTIPUSESTYLE 2212
+#Define SCI_CALLTIPSETPOSITION 2213
+#Define SCI_CALLTIPSETPOSSTART 2214
+#Define SCI_VISIBLEFROMDOCLINE 2220
+#Define SCI_DOCLINEFROMVISIBLE 2221
+#Define SCI_WRAPCOUNT 2235
+#Define SC_FOLDLEVELBASE &H400
+#Define SC_FOLDLEVELWHITEFLAG &H1000
+#Define SC_FOLDLEVELHEADERFLAG &H2000
+#Define SC_FOLDLEVELNUMBERMASK &H0FFF
+#Define SCI_SETFOLDLEVEL 2222
+#Define SCI_GETFOLDLEVEL 2223
+#Define SCI_GETLASTCHILD 2224
+#Define SCI_GETFOLDPARENT 2225
+#Define SCI_SHOWLINES 2226
+#Define SCI_HIDELINES 2227
+#Define SCI_GETLINEVISIBLE 2228
+#Define SCI_GETALLLINESVISIBLE 2236
+#Define SCI_SETFOLDEXPANDED 2229
+#Define SCI_GETFOLDEXPANDED 2230
+#Define SCI_TOGGLEFOLD 2231
+#Define SC_FOLDACTION_CONTRACT 0
+#Define SC_FOLDACTION_EXPAND 1
+#Define SC_FOLDACTION_TOGGLE 2
+#Define SCI_FOLDLINE 2237
+#Define SCI_FOLDCHILDREN 2238
+#Define SCI_EXPANDCHILDREN 2239
+#Define SCI_FOLDALL 2662
+#Define SCI_ENSUREVISIBLE 2232
+#Define SC_AUTOMATICFOLD_SHOW &H0001
+#Define SC_AUTOMATICFOLD_CLICK &H0002
+#Define SC_AUTOMATICFOLD_CHANGE &H0004
+#Define SCI_SETAUTOMATICFOLD 2663
+#Define SCI_GETAUTOMATICFOLD 2664
+#Define SC_FOLDFLAG_LINEBEFORE_EXPANDED &H0002
+#Define SC_FOLDFLAG_LINEBEFORE_CONTRACTED &H0004
+#Define SC_FOLDFLAG_LINEAFTER_EXPANDED &H0008
+#Define SC_FOLDFLAG_LINEAFTER_CONTRACTED &H0010
+#Define SC_FOLDFLAG_LEVELNUMBERS &H0040
+#Define SCI_SETFOLDFLAGS 2233
+#Define SCI_ENSUREVISIBLEENFORCEPOLICY 2234
+#Define SCI_SETTABINDENTS 2260
+#Define SCI_GETTABINDENTS 2261
+#Define SCI_SETBACKSPACEUNINDENTS 2262
+#Define SCI_GETBACKSPACEUNINDENTS 2263
+#Define SC_TIME_FOREVER 10000000
+#Define SCI_SETMOUSEDWELLTIME 2264
+#Define SCI_GETMOUSEDWELLTIME 2265
+#Define SCI_WORDSTARTPOSITION 2266
+#Define SCI_WORDENDPOSITION 2267
+#Define SC_WRAP_NONE 0
+#Define SC_WRAP_WORD 1
+#Define SC_WRAP_CHAR 2
+#Define SCI_SETWRAPMODE 2268
+#Define SCI_GETWRAPMODE 2269
+#Define SC_WRAPVISUALFLAG_NONE &H0000
+#Define SC_WRAPVISUALFLAG_END &H0001
+#Define SC_WRAPVISUALFLAG_START &H0002
+#Define SC_WRAPVISUALFLAG_MARGIN &H0004
+#Define SCI_SETWRAPVISUALFLAGS 2460
+#Define SCI_GETWRAPVISUALFLAGS 2461
+#Define SC_WRAPVISUALFLAGLOC_DEFAULT &H0000
+#Define SC_WRAPVISUALFLAGLOC_END_BY_TEXT &H0001
+#Define SC_WRAPVISUALFLAGLOC_START_BY_TEXT &H0002
+#Define SCI_SETWRAPVISUALFLAGSLOCATION 2462
+#Define SCI_GETWRAPVISUALFLAGSLOCATION 2463
+#Define SCI_SETWRAPSTARTINDENT 2464
+#Define SCI_GETWRAPSTARTINDENT 2465
+#Define SC_WRAPINDENT_FIXED 0
+#Define SC_WRAPINDENT_SAME 1
+#Define SC_WRAPINDENT_INDENT 2
+#Define SCI_SETWRAPINDENTMODE 2472
+#Define SCI_GETWRAPINDENTMODE 2473
+#Define SC_CACHE_NONE 0
+#Define SC_CACHE_CARET 1
+#Define SC_CACHE_PAGE 2
+#Define SC_CACHE_DOCUMENT 3
+#Define SCI_SETLAYOUTCACHE 2272
+#Define SCI_GETLAYOUTCACHE 2273
+#Define SCI_SETSCROLLWIDTH 2274
+#Define SCI_GETSCROLLWIDTH 2275
+#Define SCI_SETSCROLLWIDTHTRACKING 2516
+#Define SCI_GETSCROLLWIDTHTRACKING 2517
+#Define SCI_TEXTWIDTH 2276
+#Define SCI_SETENDATLASTLINE 2277
+#Define SCI_GETENDATLASTLINE 2278
+#Define SCI_TEXTHEIGHT 2279
+#Define SCI_SETVSCROLLBAR 2280
+#Define SCI_GETVSCROLLBAR 2281
+#Define SCI_APPENDTEXT 2282
+#Define SCI_GETTWOPHASEDRAW 2283
+#Define SCI_SETTWOPHASEDRAW 2284
+#Define SC_EFF_QUALITY_MASK &HF
+#Define SC_EFF_QUALITY_DEFAULT 0
+#Define SC_EFF_QUALITY_NON_ANTIALIASED 1
+#Define SC_EFF_QUALITY_ANTIALIASED 2
+#Define SC_EFF_QUALITY_LCD_OPTIMIZED 3
+#Define SCI_SETFONTQUALITY 2611
+#Define SCI_GETFONTQUALITY 2612
+#Define SCI_SETFIRSTVISIBLELINE 2613
+#Define SC_MULTIPASTE_ONCE 0
+#Define SC_MULTIPASTE_EACH 1
+#Define SCI_SETMULTIPASTE 2614
+#Define SCI_GETMULTIPASTE 2615
+#Define SCI_GETTAG 2616
+#Define SCI_TARGETFROMSELECTION 2287
+#Define SCI_LINESJOIN 2288
+#Define SCI_LINESSPLIT 2289
+#Define SCI_SETFOLDMARGINCOLOUR 2290
+#Define SCI_SETFOLDMARGINHICOLOUR 2291
+#Define SCI_LINEDOWN 2300
+#Define SCI_LINEDOWNEXTEND 2301
+#Define SCI_LINEUP 2302
+#Define SCI_LINEUPEXTEND 2303
+#Define SCI_CHARLEFT 2304
+#Define SCI_CHARLEFTEXTEND 2305
+#Define SCI_CHARRIGHT 2306
+#Define SCI_CHARRIGHTEXTEND 2307
+#Define SCI_WORDLEFT 2308
+#Define SCI_WORDLEFTEXTEND 2309
+#Define SCI_WORDRIGHT 2310
+#Define SCI_WORDRIGHTEXTEND 2311
+#Define SCI_HOME 2312
+#Define SCI_HOMEEXTEND 2313
+#Define SCI_LINEEND 2314
+#Define SCI_LINEENDEXTEND 2315
+#Define SCI_DOCUMENTSTART 2316
+#Define SCI_DOCUMENTSTARTEXTEND 2317
+#Define SCI_DOCUMENTEND 2318
+#Define SCI_DOCUMENTENDEXTEND 2319
+#Define SCI_PAGEUP 2320
+#Define SCI_PAGEUPEXTEND 2321
+#Define SCI_PAGEDOWN 2322
+#Define SCI_PAGEDOWNEXTEND 2323
+#Define SCI_EDITTOGGLEOVERTYPE 2324
+#Define SCI_CANCEL 2325
+#Define SCI_DELETEBACK 2326
+#Define SCI_TAB 2327
+#Define SCI_BACKTAB 2328
+#Define SCI_NEWLINE 2329
+#Define SCI_FORMFEED 2330
+#Define SCI_VCHOME 2331
+#Define SCI_VCHOMEEXTEND 2332
+#Define SCI_ZOOMIN 2333
+#Define SCI_ZOOMOUT 2334
+#Define SCI_DELWORDLEFT 2335
+#Define SCI_DELWORDRIGHT 2336
+#Define SCI_DELWORDRIGHTEND 2518
+#Define SCI_LINECUT 2337
+#Define SCI_LINEDELETE 2338
+#Define SCI_LINETRANSPOSE 2339
+#Define SCI_LINEDUPLICATE 2404
+#Define SCI_LOWERCASE 2340
+#Define SCI_UPPERCASE 2341
+#Define SCI_LINESCROLLDOWN 2342
+#Define SCI_LINESCROLLUP 2343
+#Define SCI_DELETEBACKNOTLINE 2344
+#Define SCI_HOMEDISPLAY 2345
+#Define SCI_HOMEDISPLAYEXTEND 2346
+#Define SCI_LINEENDDISPLAY 2347
+#Define SCI_LINEENDDISPLAYEXTEND 2348
+#Define SCI_HOMEWRAP 2349
+#Define SCI_HOMEWRAPEXTEND 2450
+#Define SCI_LINEENDWRAP 2451
+#Define SCI_LINEENDWRAPEXTEND 2452
+#Define SCI_VCHOMEWRAP 2453
+#Define SCI_VCHOMEWRAPEXTEND 2454
+#Define SCI_LINECOPY 2455
+#Define SCI_MOVECARETINSIDEVIEW 2401
+#Define SCI_LINELENGTH 2350
+#Define SCI_BRACEHIGHLIGHT 2351
+#Define SCI_BRACEHIGHLIGHTINDICATOR 2498
+#Define SCI_BRACEBADLIGHT 2352
+#Define SCI_BRACEBADLIGHTINDICATOR 2499
+#Define SCI_BRACEMATCH 2353
+#Define SCI_GETVIEWEOL 2355
+#Define SCI_SETVIEWEOL 2356
+#Define SCI_GETDOCPOINTER 2357
+#Define SCI_SETDOCPOINTER 2358
+#Define SCI_SETMODEVENTMASK 2359
+#Define EDGE_NONE 0
+#Define EDGE_LINE 1
+#Define EDGE_BACKGROUND 2
+#Define SCI_GETEDGECOLUMN 2360
+#Define SCI_SETEDGECOLUMN 2361
+#Define SCI_GETEDGEMODE 2362
+#Define SCI_SETEDGEMODE 2363
+#Define SCI_GETEDGECOLOUR 2364
+#Define SCI_SETEDGECOLOUR 2365
+#Define SCI_SEARCHANCHOR 2366
+#Define SCI_SEARCHNEXT 2367
+#Define SCI_SEARCHPREV 2368
+#Define SCI_LINESONSCREEN 2370
+#Define SCI_USEPOPUP 2371
+#Define SCI_SELECTIONISRECTANGLE 2372
+#Define SCI_SETZOOM 2373
+#Define SCI_GETZOOM 2374
+#Define SCI_CREATEDOCUMENT 2375
+#Define SCI_ADDREFDOCUMENT 2376
+#Define SCI_RELEASEDOCUMENT 2377
+#Define SCI_GETMODEVENTMASK 2378
+#Define SCI_SETFOCUS 2380
+#Define SCI_GETFOCUS 2381
+#Define SC_STATUS_OK 0
+#Define SC_STATUS_FAILURE 1
+#Define SC_STATUS_BADALLOC 2
+#Define SCI_SETSTATUS 2382
+#Define SCI_GETSTATUS 2383
+#Define SCI_SETMOUSEDOWNCAPTURES 2384
+#Define SCI_GETMOUSEDOWNCAPTURES 2385
+#Define SC_CURSORNORMAL -1
+#Define SC_CURSORARROW 2
+#Define SC_CURSORWAIT 4
+#Define SC_CURSORREVERSEARROW 7
+#Define SCI_SETCURSOR 2386
+#Define SCI_GETCURSOR 2387
+#Define SCI_SETCONTROLCHARSYMBOL 2388
+#Define SCI_GETCONTROLCHARSYMBOL 2389
+#Define SCI_WORDPARTLEFT 2390
+#Define SCI_WORDPARTLEFTEXTEND 2391
+#Define SCI_WORDPARTRIGHT 2392
+#Define SCI_WORDPARTRIGHTEXTEND 2393
+#Define VISIBLE_SLOP &H01
+#Define VISIBLE_STRICT &H04
+#Define SCI_SETVISIBLEPOLICY 2394
+#Define SCI_DELLINELEFT 2395
+#Define SCI_DELLINERIGHT 2396
+#Define SCI_SETXOFFSET 2397
+#Define SCI_GETXOFFSET 2398
+#Define SCI_CHOOSECARETX 2399
+#Define SCI_GRABFOCUS 2400
+#Define CARET_SLOP &H01
+#Define CARET_STRICT &H04
+#Define CARET_JUMPS &H10
+#Define CARET_EVEN &H08
+#Define SCI_SETXCARETPOLICY 2402
+#Define SCI_SETYCARETPOLICY 2403
+#Define SCI_SETPRINTWRAPMODE 2406
+#Define SCI_GETPRINTWRAPMODE 2407
+#Define SCI_SETHOTSPOTACTIVEFORE 2410
+#Define SCI_GETHOTSPOTACTIVEFORE 2494
+#Define SCI_SETHOTSPOTACTIVEBACK 2411
+#Define SCI_GETHOTSPOTACTIVEBACK 2495
+#Define SCI_SETHOTSPOTACTIVEUNDERLINE 2412
+#Define SCI_GETHOTSPOTACTIVEUNDERLINE 2496
+#Define SCI_SETHOTSPOTSINGLELINE 2421
+#Define SCI_GETHOTSPOTSINGLELINE 2497
+#Define SCI_PARADOWN 2413
+#Define SCI_PARADOWNEXTEND 2414
+#Define SCI_PARAUP 2415
+#Define SCI_PARAUPEXTEND 2416
+#Define SCI_POSITIONBEFORE 2417
+#Define SCI_POSITIONAFTER 2418
+#Define SCI_POSITIONRELATIVE 2670
+#Define SCI_COPYRANGE 2419
+#Define SCI_COPYTEXT 2420
+#Define SC_SEL_STREAM 0
+#Define SC_SEL_RECTANGLE 1
+#Define SC_SEL_LINES 2
+#Define SCI_SETSELECTIONMODE 2422
+#Define SCI_GETSELECTIONMODE 2423
+#Define SCI_GETLINESELSTARTPOSITION 2424
+#Define SCI_GETLINESELENDPOSITION 2425
+#Define SCI_LINEDOWNRECTEXTEND 2426
+#Define SCI_LINEUPRECTEXTEND 2427
+#Define SCI_CHARLEFTRECTEXTEND 2428
+#Define SCI_CHARRIGHTRECTEXTEND 2429
+#Define SCI_HOMERECTEXTEND 2430
+#Define SCI_VCHOMERECTEXTEND 2431
+#Define SCI_LINEENDRECTEXTEND 2432
+#Define SCI_PAGEUPRECTEXTEND 2433
+#Define SCI_PAGEDOWNRECTEXTEND 2434
+#Define SCI_STUTTEREDPAGEUP 2435
+#Define SCI_STUTTEREDPAGEUPEXTEND 2436
+#Define SCI_STUTTEREDPAGEDOWN 2437
+#Define SCI_STUTTEREDPAGEDOWNEXTEND 2438
+#Define SCI_WORDLEFTEND 2439
+#Define SCI_WORDLEFTENDEXTEND 2440
+#Define SCI_WORDRIGHTEND 2441
+#Define SCI_WORDRIGHTENDEXTEND 2442
+#Define SCI_SETWHITESPACECHARS 2443
+#Define SCI_GETWHITESPACECHARS 2647
+#Define SCI_SETPUNCTUATIONCHARS 2648
+#Define SCI_GETPUNCTUATIONCHARS 2649
+#Define SCI_SETCHARSDEFAULT 2444
+#Define SCI_AUTOCGETCURRENT 2445
+#Define SCI_AUTOCGETCURRENTTEXT 2610
+#Define SC_CASEINSENSITIVEBEHAVIOUR_RESPECTCASE 0
+#Define SC_CASEINSENSITIVEBEHAVIOUR_IGNORECASE 1
+#Define SCI_AUTOCSETCASEINSENSITIVEBEHAVIOUR 2634
+#Define SCI_AUTOCGETCASEINSENSITIVEBEHAVIOUR 2635
+#Define SC_ORDER_PRESORTED 0
+#Define SC_ORDER_PERFORMSORT 1
+#Define SC_ORDER_CUSTOM 2
+#Define SCI_AUTOCSETORDER 2660
+#Define SCI_AUTOCGETORDER 2661
+#Define SCI_ALLOCATE 2446
+#Define SCI_TARGETASUTF8 2447
+#Define SCI_SETLENGTHFORENCODE 2448
+#Define SCI_ENCODEDFROMUTF8 2449
+#Define SCI_FINDCOLUMN 2456
+#Define SCI_GETCARETSTICKY 2457
+#Define SCI_SETCARETSTICKY 2458
+#Define SC_CARETSTICKY_OFF 0
+#Define SC_CARETSTICKY_ON 1
+#Define SC_CARETSTICKY_WHITESPACE 2
+#Define SCI_TOGGLECARETSTICKY 2459
+#Define SCI_SETPASTECONVERTENDINGS 2467
+#Define SCI_GETPASTECONVERTENDINGS 2468
+#Define SCI_SELECTIONDUPLICATE 2469
+#Define SC_ALPHA_TRANSPARENT 0
+#Define SC_ALPHA_OPAQUE 255
+#Define SC_ALPHA_NOALPHA 256
+#Define SCI_SETCARETLINEBACKALPHA 2470
+#Define SCI_GETCARETLINEBACKALPHA 2471
+#Define CARETSTYLE_INVISIBLE 0
+#Define CARETSTYLE_LINE 1
+#Define CARETSTYLE_BLOCK 2
+#Define SCI_SETCARETSTYLE 2512
+#Define SCI_GETCARETSTYLE 2513
+#Define SCI_SETINDICATORCURRENT 2500
+#Define SCI_GETINDICATORCURRENT 2501
+#Define SCI_SETINDICATORVALUE 2502
+#Define SCI_GETINDICATORVALUE 2503
+#Define SCI_INDICATORFILLRANGE 2504
+#Define SCI_INDICATORCLEARRANGE 2505
+#Define SCI_INDICATORALLONFOR 2506
+#Define SCI_INDICATORVALUEAT 2507
+#Define SCI_INDICATORSTART 2508
+#Define SCI_INDICATOREND 2509
+#Define SCI_SETPOSITIONCACHE 2514
+#Define SCI_GETPOSITIONCACHE 2515
+#Define SCI_COPYALLOWLINE 2519
+#Define SCI_GETCHARACTERPOINTER 2520
+#Define SCI_GETRANGEPOINTER 2643
+#Define SCI_GETGAPPOSITION 2644
+#Define SCI_SETKEYSUNICODE 2521
+#Define SCI_GETKEYSUNICODE 2522
+#Define SCI_INDICSETALPHA 2523
+#Define SCI_INDICGETALPHA 2524
+#Define SCI_INDICSETOUTLINEALPHA 2558
+#Define SCI_INDICGETOUTLINEALPHA 2559
+#Define SCI_SETEXTRAASCENT 2525
+#Define SCI_GETEXTRAASCENT 2526
+#Define SCI_SETEXTRADESCENT 2527
+#Define SCI_GETEXTRADESCENT 2528
+#Define SCI_MARKERSYMBOLDEFINED 2529
+#Define SCI_MARGINSETTEXT 2530
+#Define SCI_MARGINGETTEXT 2531
+#Define SCI_MARGINSETSTYLE 2532
+#Define SCI_MARGINGETSTYLE 2533
+#Define SCI_MARGINSETSTYLES 2534
+#Define SCI_MARGINGETSTYLES 2535
+#Define SCI_MARGINTEXTCLEARALL 2536
+#Define SCI_MARGINSETSTYLEOFFSET 2537
+#Define SCI_MARGINGETSTYLEOFFSET 2538
+#Define SC_MARGINOPTION_NONE 0
+#Define SC_MARGINOPTION_SUBLINESELECT 1
+#Define SCI_SETMARGINOPTIONS 2539
+#Define SCI_GETMARGINOPTIONS 2557
+#Define SCI_ANNOTATIONSETTEXT 2540
+#Define SCI_ANNOTATIONGETTEXT 2541
+#Define SCI_ANNOTATIONSETSTYLE 2542
+#Define SCI_ANNOTATIONGETSTYLE 2543
+#Define SCI_ANNOTATIONSETSTYLES 2544
+#Define SCI_ANNOTATIONGETSTYLES 2545
+#Define SCI_ANNOTATIONGETLINES 2546
+#Define SCI_ANNOTATIONCLEARALL 2547
+#Define ANNOTATION_HIDDEN 0
+#Define ANNOTATION_STANDARD 1
+#Define ANNOTATION_BOXED 2
+#Define SCI_ANNOTATIONSETVISIBLE 2548
+#Define SCI_ANNOTATIONGETVISIBLE 2549
+#Define SCI_ANNOTATIONSETSTYLEOFFSET 2550
+#Define SCI_ANNOTATIONGETSTYLEOFFSET 2551
+#Define SCI_RELEASEALLEXTENDEDSTYLES 2552
+#Define SCI_ALLOCATEEXTENDEDSTYLES 2553
+#Define UNDO_MAY_COALESCE 1
+#Define SCI_ADDUNDOACTION 2560
+#Define SCI_CHARPOSITIONFROMPOINT 2561
+#Define SCI_CHARPOSITIONFROMPOINTCLOSE 2562
+#Define SCI_SETMOUSESELECTIONRECTANGULARSWITCH 2668
+#Define SCI_GETMOUSESELECTIONRECTANGULARSWITCH 2669
+#Define SCI_SETMULTIPLESELECTION 2563
+#Define SCI_GETMULTIPLESELECTION 2564
+#Define SCI_SETADDITIONALSELECTIONTYPING 2565
+#Define SCI_GETADDITIONALSELECTIONTYPING 2566
+#Define SCI_SETADDITIONALCARETSBLINK 2567
+#Define SCI_GETADDITIONALCARETSBLINK 2568
+#Define SCI_SETADDITIONALCARETSVISIBLE 2608
+#Define SCI_GETADDITIONALCARETSVISIBLE 2609
+#Define SCI_GETSELECTIONS 2570
+#Define SCI_GETSELECTIONEMPTY 2650
+#define SCI_DROPSELECTIONN 2671
+#Define SCI_CLEARSELECTIONS 2571
+#Define SCI_SETSELECTION 2572
+#Define SCI_ADDSELECTION 2573
+#Define SCI_SETMAINSELECTION 2574
+#Define SCI_GETMAINSELECTION 2575
+#Define SCI_SETSELECTIONNCARET 2576
+#Define SCI_GETSELECTIONNCARET 2577
+#Define SCI_SETSELECTIONNANCHOR 2578
+#Define SCI_GETSELECTIONNANCHOR 2579
+#Define SCI_SETSELECTIONNCARETVIRTUALSPACE 2580
+#Define SCI_GETSELECTIONNCARETVIRTUALSPACE 2581
+#Define SCI_SETSELECTIONNANCHORVIRTUALSPACE 2582
+#Define SCI_GETSELECTIONNANCHORVIRTUALSPACE 2583
+#Define SCI_SETSELECTIONNSTART 2584
+#Define SCI_GETSELECTIONNSTART 2585
+#Define SCI_SETSELECTIONNEND 2586
+#Define SCI_GETSELECTIONNEND 2587
+#Define SCI_SETRECTANGULARSELECTIONCARET 2588
+#Define SCI_GETRECTANGULARSELECTIONCARET 2589
+#Define SCI_SETRECTANGULARSELECTIONANCHOR 2590
+#Define SCI_GETRECTANGULARSELECTIONANCHOR 2591
+#Define SCI_SETRECTANGULARSELECTIONCARETVIRTUALSPACE 2592
+#Define SCI_GETRECTANGULARSELECTIONCARETVIRTUALSPACE 2593
+#Define SCI_SETRECTANGULARSELECTIONANCHORVIRTUALSPACE 2594
+#Define SCI_GETRECTANGULARSELECTIONANCHORVIRTUALSPACE 2595
+#Define SCVS_NONE 0
+#Define SCVS_RECTANGULARSELECTION 1
+#Define SCVS_USERACCESSIBLE 2
+#Define SCI_SETVIRTUALSPACEOPTIONS 2596
+#Define SCI_GETVIRTUALSPACEOPTIONS 2597
+#Define SCI_SETRECTANGULARSELECTIONMODIFIER 2598
+#Define SCI_GETRECTANGULARSELECTIONMODIFIER 2599
+#Define SCI_SETADDITIONALSELFORE 2600
+#Define SCI_SETADDITIONALSELBACK 2601
+#Define SCI_SETADDITIONALSELALPHA 2602
+#Define SCI_GETADDITIONALSELALPHA 2603
+#Define SCI_SETADDITIONALCARETFORE 2604
+#Define SCI_GETADDITIONALCARETFORE 2605
+#Define SCI_ROTATESELECTION 2606
+#Define SCI_SWAPMAINANCHORCARET 2607
+#Define SCI_CHANGELEXERSTATE 2617
+#Define SCI_CONTRACTEDFOLDNEXT 2618
+#Define SCI_VERTICALCENTRECARET 2619
+#Define SCI_MOVESELECTEDLINESUP 2620
+#Define SCI_MOVESELECTEDLINESDOWN 2621
+#Define SCI_SETIDENTIFIER 2622
+#Define SCI_GETIDENTIFIER 2623
+#Define SCI_RGBAIMAGESETWIDTH 2624
+#Define SCI_RGBAIMAGESETHEIGHT 2625
+#Define SCI_MARKERDEFINERGBAIMAGE 2626
+#Define SCI_RGBAIMAGESETSCALE 2651
+#Define SCI_REGISTERRGBAIMAGE 2627
+#Define SCI_SCROLLTOSTART 2628
+#Define SCI_SCROLLTOEND 2629
+#Define SC_TECHNOLOGY_DEFAULT 0
+#Define SC_TECHNOLOGY_DIRECTWRITE 1
+#Define SCI_SETTECHNOLOGY 2630
+#Define SCI_GETTECHNOLOGY 2631
+#Define SCI_CREATELOADER 2632
+#Define SCI_FINDINDICATORSHOW 2640
+#Define SCI_FINDINDICATORFLASH 2641
+#Define SCI_FINDINDICATORHIDE 2642
+#Define SCI_VCHOMEDISPLAY 2652
+#Define SCI_VCHOMEDISPLAYEXTEND 2653
+#Define SCI_GETCARETLINEVISIBLEALWAYS 2654
+#Define SCI_SETCARETLINEVISIBLEALWAYS 2655
+#Define SCI_SETREPRESENTATION 2665
+#Define SCI_GETREPRESENTATION 2666
+#Define SCI_CLEARREPRESENTATION 2667
+#Define SCI_STARTRECORD 3001
+#Define SCI_STOPRECORD 3002
+#Define SCI_SETLEXER 4001
+#Define SCI_GETLEXER 4002
+#Define SCI_COLOURISE 4003
+#Define SCI_SETPROPERTY 4004
+#Define KEYWORDSET_MAX 8
+#Define SCI_SETKEYWORDS 4005
+#Define SCI_SETLEXERLANGUAGE 4006
+#Define SCI_LOADLEXERLIBRARY 4007
+#Define SCI_GETPROPERTY 4008
+#Define SCI_GETPROPERTYEXPANDED 4009
+#Define SCI_GETPROPERTYINT 4010
+#Define SCI_GETSTYLEBITSNEEDED 4011
+#Define SCI_GETLEXERLANGUAGE 4012
+#Define SCI_PRIVATELEXERCALL 4013
+#Define SCI_PROPERTYNAMES 4014
+#Define SC_TYPE_BOOLEAN 0
+#Define SC_TYPE_INTEGER 1
+#Define SC_TYPE_STRING 2
+#Define SCI_PROPERTYTYPE 4015
+#Define SCI_DESCRIBEPROPERTY 4016
+#Define SCI_DESCRIBEKEYWORDSETS 4017
+#Define SC_MOD_INSERTTEXT &H1
+#Define SC_MOD_DELETETEXT &H2
+#Define SC_MOD_CHANGESTYLE &H4
+#Define SC_MOD_CHANGEFOLD &H8
+#Define SC_PERFORMED_USER &H10
+#Define SC_PERFORMED_UNDO &H20
+#Define SC_PERFORMED_REDO &H40
+#Define SC_MULTISTEPUNDOREDO &H80
+#Define SC_LASTSTEPINUNDOREDO &H100
+#Define SC_MOD_CHANGEMARKER &H200
+#Define SC_MOD_BEFOREINSERT &H400
+#Define SC_MOD_BEFOREDELETE &H800
+#Define SC_MULTILINEUNDOREDO &H1000
+#Define SC_STARTACTION &H2000
+#Define SC_MOD_CHANGEINDICATOR &H4000
+#Define SC_MOD_CHANGELINESTATE &H8000
+#Define SC_MOD_CHANGEMARGIN &H10000
+#Define SC_MOD_CHANGEANNOTATION &H20000
+#Define SC_MOD_CONTAINER &H40000
+#Define SC_MOD_LEXERSTATE &H80000
+#Define SC_MODEVENTMASKALL &HFFFF
+#Define SC_UPDATE_CONTENT &H1
+#Define SC_UPDATE_SELECTION &H2
+#Define SC_UPDATE_V_SCROLL &H4
+#Define SC_UPDATE_H_SCROLL &H8
+#Define SCEN_CHANGE 768
+#Define SCEN_SETFOCUS 512
+#Define SCEN_KILLFOCUS 256
+#Define SCK_DOWN 300
+#Define SCK_UP 301
+#Define SCK_LEFT 302
+#Define SCK_RIGHT 303
+#Define SCK_HOME 304
+#Define SCK_END 305
+#Define SCK_PRIOR 306
+#Define SCK_NEXT 307
+#Define SCK_DELETE 308
+#Define SCK_INSERT 309
+#Define SCK_ESCAPE 7
+#Define SCK_BACK 8
+#Define SCK_TAB 9
+#Define SCK_RETURN 13
+#Define SCK_ADD 310
+#Define SCK_SUBTRACT 311
+#Define SCK_DIVIDE 312
+#Define SCK_WIN 313
+#Define SCK_RWIN 314
+#Define SCK_MENU 315
+#Define SCMOD_NORM 0
+#Define SCMOD_SHIFT 1
+#Define SCMOD_CTRL 2
+#Define SCMOD_ALT 4
+#Define SCMOD_SUPER 8
+#Define SCMOD_META 16
+#Define SCN_STYLENEEDED 2000
+#Define SCN_CHARADDED 2001
+#Define SCN_SAVEPOINTREACHED 2002
+#Define SCN_SAVEPOINTLEFT 2003
+#Define SCN_MODIFYATTEMPTRO 2004
+#Define SCN_KEY 2005
+#Define SCN_DOUBLECLICK 2006
+#Define SCN_UPDATEUI 2007
+#Define SCN_MODIFIED 2008
+#Define SCN_MACRORECORD 2009
+#Define SCN_MARGINCLICK 2010
+#Define SCN_NEEDSHOWN 2011
+#Define SCN_PAINTED 2013
+#Define SCN_USERLISTSELECTION 2014
+#Define SCN_URIDROPPED 2015
+#Define SCN_DWELLSTART 2016
+#Define SCN_DWELLEND 2017
+#Define SCN_ZOOM 2018
+#Define SCN_HOTSPOTCLICK 2019
+#Define SCN_HOTSPOTDOUBLECLICK 2020
+#Define SCN_CALLTIPCLICK 2021
+#Define SCN_AUTOCSELECTION 2022
+#Define SCN_INDICATORCLICK 2023
+#Define SCN_INDICATORRELEASE 2024
+#Define SCN_AUTOCCANCELLED 2025
+#Define SCN_AUTOCCHARDELETED 2026
+#Define SCN_HOTSPOTRELEASECLICK 2027
+#Define SCN_FOCUSIN 2028
+#Define SCN_FOCUSOUT 2029
+#Define SCN_AUTOCCOMPLETED 2030
+#define SC_AUTOCOMPLETE_NORMAL 0
+#define SC_AUTOCOMPLETE_FIXED_SIZE 1
+#define SCI_AUTOCSETOPTIONS 2638
+#define SCI_AUTOCGETOPTIONS 2639
+
+#IfnDef SCI_DISABLE_PROVISIONAL
+ #Define SC_LINE_END_TYPE_DEFAULT 0
+ #Define SC_LINE_END_TYPE_UNICODE 1
+ #Define SCI_SETLINEENDTYPESALLOWED 2656
+ #Define SCI_GETLINEENDTYPESALLOWED 2657
+ #Define SCI_GETLINEENDTYPESACTIVE 2658
+ #Define SCI_GETLINEENDTYPESSUPPORTED 4018
+ #Define SCI_ALLOCATESUBSTYLES 4020
+ #Define SCI_GETSUBSTYLESSTART 4021
+ #Define SCI_GETSUBSTYLESLENGTH 4022
+ #Define SCI_FREESUBSTYLES 4023
+ #Define SCI_SETIDENTIFIERS 4024
+ #Define SCI_DISTANCETOSECONDARYSTYLES 4025
+ #Define SCI_GETSUBSTYLEBASES 4026
+#EndIf
+
+''--Autogenerated -- end of section automatically generated from Scintilla.iface
+
+'' These structures are defined to be exactly the same shape as the Win32
+'' CHARRANGE, TEXTRANGE, FINDTEXTEX, FORMATRANGE, and NMHDR structs.
+'' So older code that treats Scintilla as a RichEdit will work.
+
+type uptr_t as uinteger
+type sptr_t as integer
+
+
+' // Size = 8 bytes
+Type Sci_CharacterRange Field = 4
+ cpMin As Long ' long cpMin
+ cpMax As Long ' long cpMax
+End Type
+
+' // Size = 12 bytes
+Type Sci_TextRange Field = 4
+ chrg As Sci_CharacterRange ' struct Sci_CharacterRange chrg
+ lpstrText As ZString Ptr ' char *lpstrText
+End Type
+
+' // Size = 20 bytes
+Type Sci_TextToFind Field = 4
+ chrg As Sci_CharacterRange ' struct Sci_CharacterRange chrg
+ lpstrText As ZString Ptr ' char *lpstrText
+ chrgText As Sci_CharacterRange ' struct Sci_CharacterRange chrgText
+End Type
+
+
+' // Size = 16 bytes
+Type Sci_Rectangle
+ Left As Long ' int
+ top As Long ' int
+ Right As Long ' int
+ bottom As Long ' int
+End Type
+
+'' This structure is used in printing and requires some of the graphics types
+'' from Platform.h. Not needed by most client code.
+
+' // Size = 48 bytes
+Type Sci_RangeToFormat Field = 4
+ hdc As HDC ' Sci_SurfaceID hdc
+ hdcTarget As HDC ' Sci_SurfaceID hdcTarget
+ rc As Sci_Rectangle ' struct Sci_Rectangle rc
+ rcPage As Sci_Rectangle ' struct Sci_Rectangle rcPage
+ chrg As Sci_CharacterRange ' struct Sci_CharacterRange chrg
+End Type
+
+
+type Sci_Position as integer
+type Sci_PositionU as uinteger
+type Sci_PositionCR as clong
+
+type Sci_NotifyHeader
+ hwndFrom as any ptr
+ idFrom as uptr_t
+ code as ulong
+end type
+
+type SCNotification
+ hdr as Sci_NotifyHeader
+ position as Sci_Position
+ ch as long
+ modifiers as long
+ modificationType as long
+ lptext as const zstring ptr
+ length as Sci_Position
+ linesAdded as Sci_Position
+ message as long
+ wParam as uptr_t
+ lParam as sptr_t
+ line as Sci_Position
+ foldLevelNow as long
+ foldLevelPrev as long
+ margin as long
+ listType as long
+ x as long
+ y as long
+ token as long
+ annotationLinesAdded as Sci_Position
+ updated as long
+ listCompletionMethod as long
+end type
+
+
+
+#IfDef INCLUDE_DEPRECATED_FEATURES
+ #Define SC_CP_DBCS 1
+ #Define SCI_SETUSEPALETTE 2039
+ #Define SCI_GETUSEPALETTE 2139
+#EndIf
diff --git a/src/modThemes.inc b/src/modThemes.inc
index 7e59b1cb..5c521d7a 100644
--- a/src/modThemes.inc
+++ b/src/modThemes.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modThemes.inc.bak b/src/modThemes.inc.bak
new file mode 100644
index 00000000..7e59b1cb
--- /dev/null
+++ b/src/modThemes.inc.bak
@@ -0,0 +1,657 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+type THEME_TYPE
+ keyValue as CWSTR
+ keyData as CWSTR
+ foreground as COLORREF
+ background as COLORREF
+ bold as long
+ italic as long
+ underline as long
+end type
+dim shared gTheme(any) as THEME_TYPE
+dim shared gThemeFilenames(any) as CWSTR
+
+type GENERAL_HANDLES_TYPE
+ description as CWSTR
+ version as CWSTR
+ iconfail as COLORREF
+ iconsuccess as COLORREF
+end type
+dim shared ghGeneral as GENERAL_HANDLES_TYPE
+
+type EDITOR_HANDLES_TYPE
+ ForeColorCaret as COLORREF
+ BackColorCurrentLine as COLORREF
+ ForeColorText as COLORREF
+ BackColorText as COLORREF
+ TextBold as boolean
+ TextItalic as boolean
+ TextUnderline as boolean
+ ForeColorNumbers as COLORREF
+ BackColorNumbers as COLORREF
+ NumbersBold as boolean
+ NumbersItalic as boolean
+ NumbersUnderLine as boolean
+ ForeColorComments as COLORREF
+ BackColorComments as COLORREF
+ CommentsBold as boolean
+ CommentsItalic as boolean
+ CommentsUnderline as boolean
+ ForeColorKeyword as COLORREF
+ BackColorKeyword as COLORREF
+ KeywordBold as boolean
+ KeywordItalic as boolean
+ KeywordUnderline as boolean
+ ForeColorKeyword2 as COLORREF
+ BackColorKeyword2 as COLORREF
+ KeywordBold2 as boolean
+ KeywordItalic2 as boolean
+ KeywordUnderline2 as boolean
+ ForeColorFoldmargin as COLORREF
+ ForeColorFoldsymbol as COLORREF
+ BackColorFoldsymbol as COLORREF
+ ForeColorLinenumbers as COLORREF
+ BackColorLinenumbers as COLORREF
+ LinenumbersBold as boolean
+ LinenumbersItalic as boolean
+ LinenumbersUnderline as boolean
+ ForeColorOperators as COLORREF
+ BackColorOperators as COLORREF
+ OperatorsBold as boolean
+ OperatorsItalic as boolean
+ OperatorsUnderline as boolean
+ ForeColorIndentguides as COLORREF
+ BackColorIndentguides as COLORREF
+ ForeColorPreprocessor as COLORREF
+ BackColorPreprocessor as COLORREF
+ PreprocessorBold as boolean
+ PreprocessorItalic as boolean
+ PreprocessorUnderline as boolean
+ ForeColorSelection as COLORREF
+ BackColorSelection as COLORREF
+ ForeColorStrings as COLORREF
+ BackColorStrings as COLORREF
+ StringsBold as boolean
+ StringsItalic as boolean
+ StringsUnderline as boolean
+ ForeColorBracegood as COLORREF
+ ForeColorBracebad as COLORREF
+ ForeColorOccurrence as COLORREF
+ hBackBrushScrollBar as HBRUSH
+ BackColorScrollBar as COLORREF
+ ForeColorScrollBar as COLORREF
+ hBackBrushThumb as HBRUSH
+ Divider as COLORREF
+end type
+dim shared ghEditor as EDITOR_HANDLES_TYPE
+
+type PANEL_HANDLES_TYPE
+ hPanelBrush as HBRUSH
+ hBackBrushScrollBar as HBRUSH
+ BackColorScrollBar as COLORREF
+ ForeColorScrollBar as COLORREF
+ hBackBrushThumb as HBRUSH
+ hBackBrush as HBRUSH
+ BackColor as COLORREF
+ ForeColor as COLORREF
+ hBackBrushHot as HBRUSH
+ BackColorHot as COLORREF
+ ForeColorHot as COLORREF
+ hBackBrushButton as HBRUSH
+ BackColorButton as COLORREF
+ ForeColorButton as COLORREF
+ hBackBrushButtonHot as HBRUSH
+ BackColorButtonHot as COLORREF
+ ForeColorButtonHot as COLORREF
+end type
+dim shared ghPanel as PANEL_HANDLES_TYPE
+
+type MENUBAR_HANDLES_TYPE
+ hPanelBrush as HBRUSH
+ hBackBrush as HBRUSH
+ hBackBrushHot as HBRUSH
+ BackColor as COLORREF
+ BackColorHot as COLORREF
+ ForeColor as COLORREF
+ ForeColorHot as COLORREF
+ hFontMenuBar as HFONT
+ hFontSymbol as HFONT
+ hFontSymbolSmall as HFONT
+ hFontSymbolLargeBold as HFONT
+end type
+dim shared ghMenuBar as MENUBAR_HANDLES_TYPE
+
+type POPUPMENU_HANDLES_TYPE
+ PanelColor as COLORREF
+ hPanelBrush as HBRUSH
+ hBackBrush as HBRUSH
+ hBackBrushHot as HBRUSH
+ hBackBrushDisabled as HBRUSH
+ BackColor as COLORREF
+ BackColorHot as COLORREF
+ BackColorDisabled as COLORREF
+ ForeColor as COLORREF
+ ForeColorHot as COLORREF
+ ForeColorDisabled as COLORREF
+end type
+dim shared ghPopup as POPUPMENU_HANDLES_TYPE
+
+type TOPTABS_HANDLES_TYPE
+ hPanelBrush as HBRUSH
+ hBackBrush as HBRUSH
+ hBackBrushHot as HBRUSH
+ BackColor as COLORREF
+ BackColorHot as COLORREF
+ ForeColor as COLORREF
+ ForeColorHot as COLORREF
+ Divider as COLORREF
+ hCloseBrushHot as HBRUSH
+ CloseBackColorHot as COLORREF
+end type
+dim shared ghTopTabs as TOPTABS_HANDLES_TYPE
+
+type STATUSBAR_HANDLES_TYPE
+ hPanelBrush as HBRUSH
+ hBackBrush as HBRUSH
+ hBackBrushHot as HBRUSH
+ BackColor as COLORREF
+ BackColorHot as COLORREF
+ ForeColor as COLORREF
+ ForeColorHot as COLORREF
+ hFontStatusBar as HFONT
+ hFontStatusBarBold as HFONT
+end type
+dim shared ghStatusBar as STATUSBAR_HANDLES_TYPE
+
+type FINDREPLACE_HANDLES_TYPE
+ hPanelBrush as HBRUSH
+ hBackBrush as HBRUSH
+ hBackBrushHot as HBRUSH
+ BackColor as COLORREF
+ BackColorHot as COLORREF
+ ForeColor as COLORREF
+ ForeColorHot as COLORREF
+ leftedge as COLORREF
+ hIconBrushHot as HBRUSH
+ IconBackColorHot as COLORREF
+ NotFoundForeColor as COLORREF
+ hBackBrushTextBox as HBRUSH
+ TextBoxForeColor as COLORREF
+ TextBoxBackColor as COLORREF
+ hBackBrushIconSelected as HBRUSH
+ IconSelectedBackColor as COLORREF
+ CueBannerForeColor as COLORREF
+end type
+dim shared ghFindReplace as FINDREPLACE_HANDLES_TYPE
+
+type OUTPUT_HANDLES_TYPE
+ hPanelBrush as HBRUSH
+ hBackBrush as HBRUSH
+ hBackBrushHot as HBRUSH
+ BackColor as COLORREF
+ BackColorHot as COLORREF
+ ForeColor as COLORREF
+ ForeColorHot as COLORREF
+ Divider as COLORREF
+ hCloseBrushHot as HBRUSH
+ CloseBackColorHot as COLORREF
+end type
+dim shared ghOutput as OUTPUT_HANDLES_TYPE
+
+type DESIGNER_HANDLES_TYPE
+ hPanelBrush as HBRUSH
+end type
+dim shared ghDesigner as DESIGNER_HANDLES_TYPE
+
+''
+'' RETRIEVE THEME ITEM FROM ARRAY
+''
+function getThemePtr( byval lookupKey as string ) as THEME_TYPE ptr
+ ' we do a simple linear search for the theme because there will be a small
+ ' number of theme elements. maybe in the future put this in a hash array for
+ ' faster lookups should we need the performance boost.
+ ' in case search fails return pointer to this dummy type to avoid null ptr
+ static dummy as THEME_TYPE
+ for i as long = lbound(gTheme) to ubound(gTheme)
+ if gTheme(i).keyValue = lookupKey then
+ return @gTheme(i)
+ end if
+ next
+ return @dummy
+end function
+
+
+''
+'' LOAD THEME DISK FILE
+''
+function LoadThemeFile() as boolean
+
+ dim as CWSTR wszFilename = AfxGetExePathName & "themes\" & gConfig.ThemeFilename
+ if AfxFileExists(wszFilename) = 0 then
+ ' default to the visual studio dark theme
+ wszFilename = AfxGetExePathName & "themes\winfbe_default_dark.theme"
+ if AfxFileExists(wszFilename) = 0 then
+ ' If the theme still does not exist then most likely the Themes folder is
+ ' missing or the theme was renamed. Use the backup version in the settings folder.
+ wszFilename = AfxGetExePathName & "settings\backup_winfbe_default_dark.theme"
+ ' Attempt to copy the file for next time
+ dim as CWSTR wszThemeDirFilename = AfxGetExePathName & "themes\winfbe_default_dark.theme"
+ if AfxCopyFile( wszFilename, wszThemeDirFilename ) then
+ gConfig.ThemeFilename = "winfbe_default_dark.theme"
+ end if
+ end if
+ end if
+
+ dim pStream AS CTextStream
+ if pStream.Open(wszFilename) <> S_OK then return true ' error
+
+ ' Ensure to delete any existing gTheme data
+ erase gTheme
+
+ dim param(100) as CWSTR
+ dim param_value(100) as CWSTR
+ dim as long nextParam = 0
+
+ dim as CWSTR wst, keyValue, keyData
+
+ Do Until pStream.EOS
+ wst = pStream.ReadLine
+
+ wst = trim(AfxStrExtract( 1, wst, "#")) ' remove comments
+ If Len(wst) = 0 Then Continue Do
+
+ keyValue = trim(AfxStrParse(wst, 1, ":"))
+ keyData = trim(AfxStrParse(wst, 2, ":"))
+
+ ' is this a replaceable parameter
+ if left(wst, 1) = "%" then
+ param(nextParam) = keyValue
+ param_value(nextParam) = keyData
+ nextParam += 1
+ continue do
+ end if
+
+ ' if keyData is a replaceable parameter then substitute it now
+ if left(keyData, 1) = "%" then
+ for i as long = lbound(param) to ubound(param)
+ if param(i) = keyData then
+ keyData = param_value(i)
+ exit for
+ end if
+ next
+ end if
+
+ ' is the KeyData a true or false value
+ if keyData = "true" then keyData = "1"
+ if keyData = "false" then keyData = "0"
+
+ ' determine number of keys in the keyvalue. There can be 2 or 3.
+ ' if 2 then simply store the data in keyData. if 3 then break the
+ ' data into the component properties.
+ dim keys(3) as string ' always have maximum of 3 keys
+ dim as long numKeys = AfxStrParseCount(keyValue, ".") ' actual number of keys retrieved
+ for i as long = 1 to numKeys
+ keys(i) = AfxStrParse(keyValue, i, ".")
+ next
+ ' there will always be at least 2 elements to the key and
+ ' we use that to lookup the theme type structure.
+ keyValue = keys(1) & "." & keys(2)
+
+ ' generate the color value
+ dim as long r, g, b, clr
+ r = val(AfxStrParse(keyData, 1, ","))
+ g = val(AfxStrParse(keyData, 2, ","))
+ b = val(AfxStrParse(keyData, 3, ","))
+ clr = BGR(r, g, b)
+
+ ' determine if the key already exists and just needs
+ ' the properties added to it, or if the structure needs
+ ' to be created.
+ dim nFound as long = -1
+ for i as long = lbound(gTheme) to ubound(gTheme)
+ if gTheme(i).keyValue = keyValue then
+ nFound = i: exit for
+ end if
+ next
+
+ ' add the new key/value pair if not found
+ if nFound = -1 then
+ nFound = ubound(gTheme) + 1
+ redim preserve gTheme(nFound) as THEME_TYPE
+ end if
+
+ gTheme(nFound).keyValue = keyValue
+ gTheme(nFound).keyData = keyData
+ select case keys(3)
+ case "foreground": gTheme(nFound).foreground = clr
+ case "background": gTheme(nFound).background = clr
+ case "bold": gTheme(nFound).bold = val(keyData)
+ case "italic": gTheme(nFound).italic = val(keyData)
+ case "underline": gTheme(nFound).underline = val(keyData)
+ end select
+ loop
+
+ pStream.Close
+
+ ' Load the TYPE's for each of the forms that require theme data
+ DIM pWindow AS CWindow PTR = AfxCWindowPtr(HWND_FRMMAIN)
+
+ dim as THEME_TYPE ptr pTheme
+
+ pTheme = getThemePtr("general.description")
+ ghGeneral.description = pTheme->keyData
+ pTheme = getThemePtr("general.version")
+ ghGeneral.version = pTheme->keyData
+ pTheme = getThemePtr("compile.iconsuccess")
+ ghGeneral.iconsuccess = pTheme->foreground
+ pTheme = getThemePtr("compile.iconfail")
+ ghGeneral.iconfail = pTheme->foreground
+
+ pTheme = getThemePtr("editor.text")
+ ghEditor.BackColorText = pTheme->background
+ ghEditor.ForeColorText = pTheme->foreground
+ ghEditor.TextBold = pTheme->bold
+ ghEditor.TextItalic = pTheme->italic
+ ghEditor.TextUnderline = pTheme->underline
+ pTheme = getThemePtr("editor.linenumbers")
+ ghEditor.BackColorLinenumbers = pTheme->background
+ ghEditor.ForeColorLinenumbers = pTheme->foreground
+ ghEditor.LinenumbersBold = pTheme->bold
+ ghEditor.LinenumbersItalic = pTheme->italic
+ ghEditor.LinenumbersUnderline = pTheme->underline
+ pTheme = getThemePtr("editor.foldmargin")
+ ghEditor.ForeColorFoldmargin = pTheme->foreground
+ pTheme = getThemePtr("editor.indentguides")
+ ghEditor.BackColorIndentguides = pTheme->background
+ ghEditor.ForeColorIndentguides = pTheme->foreground
+ pTheme = getThemePtr("editor.caret")
+ ghEditor.ForeColorCaret = pTheme->foreground
+ pTheme = getThemePtr("editor.currentline")
+ ghEditor.BackColorCurrentline = pTheme->background
+ pTheme = getThemePtr("editor.selection")
+ ghEditor.BackColorSelection = pTheme->background
+ ghEditor.ForeColorSelection = pTheme->foreground
+ pTheme = getThemePtr("editor.comments")
+ ghEditor.BackColorComments = pTheme->background
+ ghEditor.ForeColorComments = pTheme->foreground
+ ghEditor.CommentsBold = pTheme->bold
+ ghEditor.CommentsItalic = pTheme->italic
+ ghEditor.CommentsUnderline = pTheme->underline
+ pTheme = getThemePtr("editor.keyword")
+ ghEditor.BackColorKeyword = pTheme->background
+ ghEditor.ForeColorKeyword = pTheme->foreground
+ ghEditor.KeywordBold = pTheme->bold
+ ghEditor.KeywordItalic = pTheme->italic
+ ghEditor.KeywordUnderline = pTheme->underline
+ pTheme = getThemePtr("editor.keyword2")
+ ghEditor.BackColorKeyword2 = pTheme->background
+ ghEditor.ForeColorKeyword2 = pTheme->foreground
+ ghEditor.KeywordBold2 = pTheme->bold
+ ghEditor.KeywordItalic2 = pTheme->italic
+ ghEditor.KeywordUnderline2 = pTheme->underline
+ pTheme = getThemePtr("editor.numbers")
+ ghEditor.BackColorNumbers = pTheme->background
+ ghEditor.ForeColorNumbers = pTheme->foreground
+ ghEditor.NumbersBold = pTheme->bold
+ ghEditor.NumbersItalic = pTheme->italic
+ ghEditor.NumbersUnderline = pTheme->underline
+ pTheme = getThemePtr("editor.operators")
+ ghEditor.BackColorOperators = pTheme->background
+ ghEditor.ForeColorOperators = pTheme->foreground
+ ghEditor.OperatorsBold = pTheme->bold
+ ghEditor.OperatorsItalic = pTheme->italic
+ ghEditor.OperatorsUnderline = pTheme->underline
+ pTheme = getThemePtr("editor.preprocessor")
+ ghEditor.BackColorPreprocessor = pTheme->background
+ ghEditor.ForeColorPreprocessor = pTheme->foreground
+ ghEditor.PreprocessorBold = pTheme->bold
+ ghEditor.PreprocessorItalic = pTheme->italic
+ ghEditor.PreprocessorUnderline = pTheme->underline
+ pTheme = getThemePtr("editor.strings")
+ ghEditor.BackColorStrings = pTheme->background
+ ghEditor.ForeColorStrings = pTheme->foreground
+ ghEditor.StringsBold = pTheme->bold
+ ghEditor.StringsItalic = pTheme->italic
+ ghEditor.StringsUnderline = pTheme->underline
+ pTheme = getThemePtr("editor.foldsymbol")
+ ghEditor.BackColorFoldsymbol = pTheme->background
+ ghEditor.ForeColorFoldsymbol = pTheme->foreground
+ pTheme = getThemePtr("editor.scrollbar")
+ if ghEditor.hBackBrushScrollBar then DeleteObject(ghEditor.hBackBrushScrollBar)
+ ghEditor.hBackBrushScrollBar = CreateSolidBrush(pTheme->background)
+ if ghEditor.hBackBrushThumb then DeleteObject(ghEditor.hBackBrushThumb)
+ ghEditor.hBackBrushThumb = CreateSolidBrush(pTheme->foreground)
+ ghEditor.ForeColorScrollBar = pTheme->foreground
+ ghEditor.BackColorScrollBar = pTheme->background
+ pTheme = getThemePtr("editor.bracegood")
+ ghEditor.ForeColorBracegood = pTheme->foreground
+ pTheme = getThemePtr("editor.bracebad")
+ ghEditor.ForeColorBracebad = pTheme->foreground
+ pTheme = getThemePtr("editor.occurrence")
+ ghEditor.ForeColorOccurrence = pTheme->foreground
+ pTheme = getThemePtr("editor.divider")
+ ghEditor.Divider = pTheme->foreground
+
+ pTheme = getThemePtr("panel.panel")
+ if ghPanel.hPanelBrush then DeleteObject(ghPanel.hPanelBrush)
+ ghPanel.hPanelBrush = CreateSolidBrush(pTheme->background)
+ pTheme = getThemePtr("panel.text")
+ if ghPanel.hBackBrush then DeleteObject(ghPanel.hBackBrush)
+ ghPanel.hBackBrush = CreateSolidBrush(pTheme->background)
+ ghPanel.BackColor = pTheme->background
+ ghPanel.ForeColor = pTheme->foreground
+ pTheme = getThemePtr("panel.texthot")
+ if ghPanel.hBackBrushHot then DeleteObject(ghPanel.hBackBrushHot)
+ ghPanel.hBackBrushHot = CreateSolidBrush(pTheme->background)
+ ghPanel.BackColorHot = pTheme->background
+ ghPanel.ForeColorHot = pTheme->foreground
+ pTheme = getThemePtr("panel.scrollbar")
+ if ghPanel.hBackBrushScrollBar then DeleteObject(ghPanel.hBackBrushScrollBar)
+ ghPanel.hBackBrushScrollBar = CreateSolidBrush(pTheme->background)
+ if ghPanel.hBackBrushThumb then DeleteObject(ghPanel.hBackBrushThumb)
+ ghPanel.hBackBrushThumb = CreateSolidBrush(pTheme->foreground)
+ ghPanel.BackColorScrollBar = pTheme->background
+ ghPanel.ForeColorScrollBar = pTheme->foreground
+ pTheme = getThemePtr("panel.button")
+ if ghPanel.hBackBrushButton then DeleteObject(ghPanel.hBackBrushButton)
+ ghPanel.hBackBrushButton = CreateSolidBrush(pTheme->background)
+ ghPanel.BackColorButton = pTheme->background
+ ghPanel.ForeColorButton = pTheme->foreground
+ pTheme = getThemePtr("panel.buttonhot")
+ if ghPanel.hBackBrushButtonHot then DeleteObject(ghPanel.hBackBrushButtonHot)
+ ghPanel.hBackBrushButtonHot = CreateSolidBrush(pTheme->background)
+ ghPanel.BackColorButtonHot = pTheme->background
+ ghPanel.ForeColorButtonHot = pTheme->foreground
+
+ pTheme = getThemePtr("topmenu.panel")
+ ghPopup.PanelColor = pTheme->background
+ if ghPopup.hPanelBrush then DeleteObject(ghPopup.hPanelBrush)
+ ghPopup.hPanelBrush = CreateSolidBrush(ghPopup.PanelColor)
+ pTheme = getThemePtr("topmenu.text")
+ if ghPopup.hBackBrush then DeleteObject(ghPopup.hBackBrush)
+ ghPopup.hBackBrush = CreateSolidBrush(pTheme->background)
+ ghPopup.BackColor = pTheme->background
+ ghPopup.ForeColor = pTheme->foreground
+ pTheme = getThemePtr("topmenu.texthot")
+ if ghPopup.hBackBrushHot then DeleteObject(ghPopup.hBackBrushHot)
+ ghPopup.hBackBrushHot = CreateSolidBrush(pTheme->background)
+ ghPopup.BackColorHot = pTheme->background
+ ghPopup.ForeColorHot = pTheme->foreground
+ pTheme = getThemePtr("topmenu.textdisabled")
+ if ghPopup.hBackBrushDisabled then DeleteObject(ghPopup.hBackBrushDisabled)
+ ghPopup.hBackBrushDisabled = CreateSolidBrush(pTheme->background)
+ ghPopup.BackColorDisabled = pTheme->background
+ ghPopup.ForeColorDisabled = pTheme->foreground
+
+ pTheme = getThemePtr("menubar.panel")
+ if ghMenuBar.hPanelBrush then DeleteObject(ghMenuBar.hPanelBrush)
+ ghMenuBar.hPanelBrush = CreateSolidBrush(pTheme->background)
+ pTheme = getThemePtr("menubar.text")
+ if ghMenuBar.hBackBrush then DeleteObject(ghMenuBar.hBackBrush)
+ ghMenuBar.hBackBrush = CreateSolidBrush(pTheme->background)
+ ghMenuBar.BackColor = pTheme->background
+ ghMenuBar.ForeColor = pTheme->foreground
+ pTheme = getThemePtr("menubar.texthot")
+ if ghMenuBar.hBackBrushHot then DeleteObject(ghMenuBar.hBackBrushHot)
+ ghMenuBar.hBackBrushHot = CreateSolidBrush(pTheme->background)
+ ghMenuBar.BackColorHot = pTheme->background
+ ghMenuBar.ForeColorHot = pTheme->foreground
+
+ pTheme = getThemePtr("toptabs.panel")
+ if ghTopTabs.hPanelBrush then DeleteObject(ghTopTabs.hPanelBrush)
+ ghTopTabs.hPanelBrush = CreateSolidBrush(pTheme->background)
+ pTheme = getThemePtr("toptabs.text")
+ if ghTopTabs.hBackBrush then DeleteObject(ghTopTabs.hBackBrush)
+ ghTopTabs.hBackBrush = CreateSolidBrush(pTheme->background)
+ ghTopTabs.BackColor = pTheme->background
+ ghTopTabs.ForeColor = pTheme->foreground
+ pTheme = getThemePtr("toptabs.texthot")
+ if ghTopTabs.hBackBrushHot then DeleteObject(ghTopTabs.hBackBrushHot)
+ ghTopTabs.hBackBrushHot = CreateSolidBrush(pTheme->background)
+ ghTopTabs.BackColorHot = pTheme->background
+ ghTopTabs.ForeColorHot = pTheme->foreground
+ pTheme = getThemePtr("toptabs.divider")
+ ghTopTabs.Divider = pTheme->foreground
+ pTheme = getThemePtr("toptabs.closehot")
+ if ghTopTabs.hCloseBrushHot then DeleteObject(ghTopTabs.hCloseBrushHot)
+ ghTopTabs.hCloseBrushHot = CreateSolidBrush(pTheme->background)
+ ghTopTabs.CloseBackColorHot = pTheme->background
+
+ pTheme = getThemePtr("statusbar.panel")
+ if ghStatusBar.hPanelBrush then DeleteObject(ghStatusBar.hPanelBrush)
+ ghStatusBar.hPanelBrush = CreateSolidBrush(pTheme->background)
+ pTheme = getThemePtr("statusbar.text")
+ if ghStatusBar.hBackBrush then DeleteObject(ghStatusBar.hBackBrush)
+ ghStatusBar.hBackBrush = CreateSolidBrush(pTheme->background)
+ ghStatusBar.BackColor = pTheme->background
+ ghStatusBar.ForeColor = pTheme->foreground
+ pTheme = getThemePtr("statusbar.texthot")
+ if ghStatusBar.hBackBrushHot then DeleteObject(ghStatusBar.hBackBrushHot)
+ ghStatusBar.hBackBrushHot = CreateSolidBrush(pTheme->background)
+ ghStatusBar.BackColorHot = pTheme->background
+ ghStatusBar.ForeColorHot = pTheme->foreground
+
+ pTheme = getThemePtr("findreplace.panel")
+ if ghFindReplace.hPanelBrush then DeleteObject(ghFindReplace.hPanelBrush)
+ ghFindReplace.hPanelBrush = CreateSolidBrush(pTheme->background)
+ pTheme = getThemePtr("findreplace.text")
+ if ghFindReplace.hBackBrush then DeleteObject(ghFindReplace.hBackBrush)
+ ghFindReplace.hBackBrush = CreateSolidBrush(pTheme->background)
+ ghFindReplace.BackColor = pTheme->background
+ ghFindReplace.ForeColor = pTheme->foreground
+ pTheme = getThemePtr("findreplace.texthot")
+ if ghFindReplace.hBackBrushHot then DeleteObject(ghFindReplace.hBackBrushHot)
+ ghFindReplace.hBackBrushHot = CreateSolidBrush(pTheme->background)
+ ghFindReplace.BackColorHot = pTheme->background
+ ghFindReplace.ForeColorHot = pTheme->foreground
+ pTheme = getThemePtr("findreplace.leftedge")
+ ghFindReplace.LeftEdge = pTheme->foreground
+ pTheme = getThemePtr("findreplace.iconhot")
+ if ghFindReplace.hIconBrushHot then DeleteObject(ghFindReplace.hIconBrushHot)
+ ghFindReplace.hIconBrushHot = CreateSolidBrush(pTheme->background)
+ ghFindReplace.IconBackColorHot = pTheme->background
+ pTheme = getThemePtr("findreplace.textnotfound")
+ ghFindReplace.NotFoundForeColor = pTheme->foreground
+ pTheme = getThemePtr("findreplace.textbox")
+ if ghFindReplace.hBackBrushTextBox then DeleteObject(ghFindReplace.hBackBrushTextBox)
+ ghFindReplace.hBackBrushTextBox = CreateSolidBrush(pTheme->background)
+ ghFindReplace.TextBoxBackColor = pTheme->background
+ ghFindReplace.TextBoxForeColor = pTheme->foreground
+ pTheme = getThemePtr("findreplace.iconselected")
+ if ghFindReplace.hBackBrushIconSelected then DeleteObject(ghFindReplace.hBackBrushIconSelected)
+ ghFindReplace.hBackBrushIconSelected = CreateSolidBrush(pTheme->background)
+ ghFindReplace.IconSelectedBackColor = pTheme->background
+ pTheme = getThemePtr("findreplace.cuebanner")
+ ghFindReplace.CueBannerForeColor = pTheme->foreground
+
+ pTheme = getThemePtr("output.panel")
+ if ghOutput.hPanelBrush then DeleteObject(ghOutput.hPanelBrush)
+ ghOutput.hPanelBrush = CreateSolidBrush(pTheme->background)
+ pTheme = getThemePtr("output.text")
+ if ghOutput.hBackBrush then DeleteObject(ghOutput.hBackBrush)
+ ghOutput.hBackBrush = CreateSolidBrush(pTheme->background)
+ ghOutput.BackColor = pTheme->background
+ ghOutput.ForeColor = pTheme->foreground
+ pTheme = getThemePtr("output.texthot")
+ if ghOutput.hBackBrushHot then DeleteObject(ghOutput.hBackBrushHot)
+ ghOutput.hBackBrushHot = CreateSolidBrush(pTheme->background)
+ ghOutput.BackColorHot = pTheme->background
+ ghOutput.ForeColorHot = pTheme->foreground
+ pTheme = getThemePtr("output.divider")
+ ghOutput.Divider = pTheme->foreground
+ pTheme = getThemePtr("output.closehot")
+ if ghOutput.hCloseBrushHot then DeleteObject(ghOutput.hCloseBrushHot)
+ ghOutput.hCloseBrushHot = CreateSolidBrush(pTheme->background)
+ ghOutput.CloseBackColorHot = pTheme->background
+
+ pTheme = getThemePtr("designer.panel")
+ if ghDesigner.hPanelBrush then DeleteObject(ghDesigner.hPanelBrush)
+ ghDesigner.hPanelBrush = CreateSolidBrush(pTheme->background)
+
+ ' try to set the default GUI font the application depending on Windows/Wine
+ ' and use fallback options. Start with Windows options because sometimes
+ ' the user will have Windows fonts installed on their Linux system.
+ dim as CWSTR wszFontName, wszSymbolFontName
+
+ ' Segue UI *may* exist on Wine/Linux but most likely Segui UI Symbol
+ ' will not, so set the regular gui and symbol fonts separately.
+ if isFontNameExist("Segoe UI") then
+ wszFontName = "Segoe UI"
+ elseif isFontNameExist("Noto Sans") then
+ wszFontName = "Noto Sans"
+ elseif isFontNameExist("Open Sans") then
+ wszFontName = "Open Sans"
+ elseif isFontNameExist("Tahoma") then
+ wszFontName = "Tahoma"
+ else
+ wszFontName = "Arial"
+ end if
+
+ if isFontNameExist("Segoe UI Symbol") then
+ wszSymbolFontName = "Segoe UI Symbol"
+ elseif isFontNameExist("Noto Sans Symbols2") then
+ wszSymbolFontName = "Noto Sans Symbols2"
+ else
+ wszSymbolFontName = wszFontName
+ end if
+
+ if ghMenuBar.hFontMenuBar = 0 then
+ ghMenuBar.hFontMenuBar = pWindow->CreateFont(wszFontName, 10, FW_NORMAL, , , , DEFAULT_CHARSET)
+ end if
+ if ghStatusBar.hFontStatusBar = 0 then
+ ghStatusBar.hFontStatusBar = pWindow->CreateFont(wszFontName, 9, FW_NORMAL, , , , DEFAULT_CHARSET)
+ end if
+ if ghStatusBar.hFontStatusBarBold = 0 then
+ ghStatusBar.hFontStatusBarBold = pWindow->CreateFont(wszFontName, 9, FW_BOLD, , , , DEFAULT_CHARSET)
+ end if
+ if ghMenuBar.hFontSymbolLargeBold = 0 then
+ ghMenuBar.hFontSymbolLargeBold = pWindow->CreateFont(wszSymbolFontName, 12, FW_BOLD, , , , DEFAULT_CHARSET)
+ end if
+ if ghMenuBar.hFontSymbol = 0 then
+ ghMenuBar.hFontSymbol = pWindow->CreateFont(wszSymbolFontName, 10, FW_NORMAL, , , , DEFAULT_CHARSET)
+ end if
+ if ghMenuBar.hFontSymbolSmall = 0 then
+ ghMenuBar.hFontSymbolSmall = pWindow->CreateFont(wszSymbolFontName, 9, FW_NORMAL, , , , DEFAULT_CHARSET)
+ end if
+
+ ' set some global brush handles so that we don't always have to be
+ ' recreating them every time they are used.
+ pTheme = getThemePtr("main.panel")
+ if ghBrushMainBackground then DeleteObject(ghBrushMainBackground)
+ ghBrushMainBackground = CreateSolidBrush(pTheme->background)
+
+ function = false
+end function
+
diff --git a/src/modVDAnchors.bi b/src/modVDAnchors.bi
index f004f492..0a75f68b 100644
--- a/src/modVDAnchors.bi
+++ b/src/modVDAnchors.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDAnchors.bi.bak b/src/modVDAnchors.bi.bak
new file mode 100644
index 00000000..f004f492
--- /dev/null
+++ b/src/modVDAnchors.bi.bak
@@ -0,0 +1,16 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#define IDC_FRMVDANCHORS_LISTVIEW 1000
+
+declare function frmVDAnchors_Show( ByVal hWndParent As HWnd, byref wszPropValue as wstring ) as LRESULT
diff --git a/src/modVDAnchors.inc b/src/modVDAnchors.inc
index 6f095260..255c97b4 100644
--- a/src/modVDAnchors.inc
+++ b/src/modVDAnchors.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDAnchors.inc.bak b/src/modVDAnchors.inc.bak
new file mode 100644
index 00000000..6f095260
--- /dev/null
+++ b/src/modVDAnchors.inc.bak
@@ -0,0 +1,184 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modVDAnchors.bi"
+
+dim shared bPreventItemChanged as boolean
+
+' ========================================================================================
+' Process WM_NOTIFY message for window/dialog: frmVDAnchors
+' ========================================================================================
+function frmVDAnchors_OnNotify( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal pNMHDR As NMHDR Ptr _
+ ) As LRESULT
+
+ select case id
+ case IDC_FRMVDANCHORS_LISTVIEW
+ select case pNMHDR->code
+ case LVN_ITEMCHANGED
+ if bPreventItemChanged then exit function
+ dim as CWSTR wszValue
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ dim pProp as clsProperty ptr = GetActivePropertyPtr()
+ if pProp then
+ dim as HWND hLV = pNMHDR->hwndFrom
+ if ListView_GetCheckState(hLV, 0) then wszValue = wszValue & "Left,"
+ if ListView_GetCheckState(hLV, 1) then wszValue = wszValue & "Top,"
+ if ListView_GetCheckState(hLV, 2) then wszValue = wszValue & "Right,"
+ if ListView_GetCheckState(hLV, 3) then wszValue = wszValue & "Bottom,"
+ wszValue = rtrim(wszValue, ",")
+ pProp->wszPropValuePrev = pProp->wszPropValue
+ pProp->wszPropValue = wszValue
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+ end if
+ end select
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmVDAnchors
+' ========================================================================================
+function frmVDAnchors_OnClose( ByVal HWnd As HWnd ) As LRESULT
+ ' Never close the window; simply hide it.
+ ShowWindow( HWnd, SW_HIDE )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmVDAnchors
+' ========================================================================================
+function frmVDAnchors_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ HWND_FRMVDANCHORS = 0
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmVDAnchors Window procedure
+' ========================================================================================
+function frmVDAnchors_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_NOTIFY, frmVDAnchors_OnNotify)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmVDAnchors_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmVDAnchors_OnDestroy)
+
+ case WM_ACTIVATE
+ if wParam = WA_INACTIVE then
+ ShowWindow(HWND_FRMVDANCHORS, SW_HIDE)
+ end if
+
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmVDAnchors_SetListViewSelections
+' ========================================================================================
+function frmVDAnchors_SetListViewSelections( byval hLV as HWND, byref wszPropValue as wstring ) as Long
+
+ ' wszPropValue is a comma separated list of parts
+ ' eg. Left,Top
+ ' Right,Bottom
+
+ ' Clear any existing checkmarks
+ for i as long = 0 to 3
+ ListView_SetCheckState(hLV, i, FALSE)
+ next
+
+ dim as long numParts = AfxStrParseCount(wszPropValue, ",")
+ for i as long = 1 to numParts
+ dim as CWSTR wszPart = ucase(trim(AfxStrParse(wszPropValue, i, ",")))
+ select case wszPart
+ case "LEFT": ListView_SetCheckState(hLV, 0, CTRUE)
+ case "TOP": ListView_SetCheckState(hLV, 1, CTRUE)
+ case "RIGHT": ListView_SetCheckState(hLV, 2, CTRUE)
+ case "BOTTOM": ListView_SetCheckState(hLV, 3, CTRUE)
+ end select
+ next
+
+ bPreventItemChanged = FALSE
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmVDAnchors_Show
+' ========================================================================================
+function frmVDAnchors_Show( _
+ ByVal hWndParent As HWnd, _
+ byref wszPropValue as wstring _
+ ) as LRESULT
+
+ Dim As HWnd hLV
+
+ bPreventItemChanged = TRUE
+
+ ' If the Anchors popup already exists then no need to recreate it.
+ If IsWindow(HWND_FRMVDANCHORS) Then
+ hLV = GetDlgItem(HWND_FRMVDANCHORS, IDC_FRMVDANCHORS_LISTVIEW)
+ frmVDAnchors_SetListViewSelections(hLV, wszPropValue)
+ exit function
+ end if
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ HWND_FRMVDANCHORS = _
+ pWindow->Create( hWndParent, "", @frmVDAnchors_WndProc, 0, 0, 140, 78, _
+ WS_POPUP or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN or WS_BORDER, 0)
+
+ hLV = _
+ pWindow->AddControl("LISTVIEW", , IDC_FRMVDANCHORS_LISTVIEW, "", 0, 0, 140, 78, _
+ WS_CHILD or WS_VISIBLE OR WS_CLIPCHILDREN OR WS_TABSTOP OR LVS_SINGLESEL or LVS_REPORT OR LVS_ALIGNTOP or LVS_NOCOLUMNHEADER, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR)
+
+ ' Configure the ListView
+ dim as long dwExStyle = ListView_GetExtendedListViewStyle(hLV)
+ dwExStyle = dwExStyle Or LVS_EX_FULLROWSELECT Or LVS_EX_DOUBLEBUFFER Or LVS_EX_CHECKBOXES
+ ListView_SetExtendedListViewStyle(hLV, dwExStyle)
+ ListView_AddColumn( hLV, 0, "", pWindow->ScaleX(20) )
+ ListView_AddColumn( hLV, 1, "", pWindow->ScaleX(100) )
+
+ FF_ListView_InsertItem( hLV, 0, 0, "" )
+ FF_ListView_InsertItem( hLV, 0, 1, "Left")
+ FF_ListView_InsertItem( hLV, 1, 0, "" )
+ FF_ListView_InsertItem( hLV, 1, 1, "Top")
+ FF_ListView_InsertItem( hLV, 2, 0, "" )
+ FF_ListView_InsertItem( hLV, 2, 1, "Right")
+ FF_ListView_InsertItem( hLV, 3, 0, "" )
+ FF_ListView_InsertItem( hLV, 3, 1, "Bottom")
+
+ frmVDAnchors_SetListViewSelections(hLV, wszPropValue)
+
+ Function = 0
+End Function
+
+
diff --git a/src/modVDApplyProperties.bi b/src/modVDApplyProperties.bi
index 2f4e4240..7176a190 100644
--- a/src/modVDApplyProperties.bi
+++ b/src/modVDApplyProperties.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDApplyProperties.bi.bak b/src/modVDApplyProperties.bi.bak
new file mode 100644
index 00000000..2f4e4240
--- /dev/null
+++ b/src/modVDApplyProperties.bi.bak
@@ -0,0 +1,16 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+Declare Function ApplyControlProperties( byval pDoc as clsDocument ptr, byval pCtrl as clsControl ptr ) as long
diff --git a/src/modVDApplyProperties.inc b/src/modVDApplyProperties.inc
index 4d954dba..d656600a 100644
--- a/src/modVDApplyProperties.inc
+++ b/src/modVDApplyProperties.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDApplyProperties.inc.bak b/src/modVDApplyProperties.inc.bak
new file mode 100644
index 00000000..4d954dba
--- /dev/null
+++ b/src/modVDApplyProperties.inc.bak
@@ -0,0 +1,1161 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modVDApplyProperties.bi"
+#include once "modVDDesignForm.bi"
+#include once "frmVDTabChild.bi"
+
+
+' ========================================================================================
+' Apply properties to the form
+' ========================================================================================
+function Form_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ ' Determine if this is a regular form or a ChildForm
+ dim as Boolean bIsChildForm = iif( GetControlProperty( pCtrl, "CHILDFORM" ) = "True", True, false)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ pWindow->Brush = CreateSolidBrush( GetRGBColorFromProperty(wszPropValue) )
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "CHILDFORM"
+ Form_ApplyProperties(pDoc, pCtrl, GetControlPropertyPtr(pCtrl, "CONTROLBOX"))
+ Form_ApplyProperties(pDoc, pCtrl, GetControlPropertyPtr(pCtrl, "MAXIMIZEBOX"))
+ Form_ApplyProperties(pDoc, pCtrl, GetControlPropertyPtr(pCtrl, "MINIMIZEBOX"))
+ Form_ApplyProperties(pDoc, pCtrl, GetControlPropertyPtr(pCtrl, "BORDERSTYLE"))
+
+ case "CONTROLBOX"
+ if (wszPropValue = "True") andalso (bIsChildForm = false) then
+ AfxAddWindowStyle(pCtrl->hWindow, WS_SYSMENU)
+ else
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_SYSMENU)
+ end if
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ case "ICON"
+ dim pImageType as IMAGES_TYPE ptr = GetImagesTypePtr(wszPropValue)
+ dim hIcon as HICON
+ if pImageType then hIcon = AfxGdipIconFromFile(pImageType->wszFilename)
+ SendMessage( pCtrl->hWindow, WM_SETICON, CAST(WPARAM, ICON_BIG), CAST(LPARAM, hIcon))
+ SendMessage( pCtrl->hWindow, WM_SETICON, CAST(WPARAM, ICON_SMALL), CAST(LPARAM, hIcon))
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ case "MAXIMIZEBOX"
+ if (wszPropValue = "True") andalso (bIsChildForm = false) then
+ AfxAddWindowStyle(pCtrl->hWindow, WS_MAXIMIZEBOX)
+ else
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_MAXIMIZEBOX)
+ end if
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ case "MINIMIZEBOX"
+ if (wszPropValue = "True") andalso (bIsChildForm = false) then
+ AfxAddWindowStyle(pCtrl->hWindow, WS_MINIMIZEBOX)
+ else
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_MINIMIZEBOX)
+ end if
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ case "BORDERSTYLE"
+ ' Remove all existing styles before adding the new style
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_DLGFRAME)
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_THICKFRAME)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_TOOLWINDOW)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_WINDOWEDGE)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_DLGMODALFRAME)
+
+ if bIsChildForm = false then
+ select case wszPropValue
+ case "FormBorderStyle.None"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_CAPTION)
+ case "FormBorderStyle.SizableToolWindow", _
+ "FormBorderStyle.FixedToolWindow"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowStyle(pCtrl->hWindow, WS_DLGFRAME)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_TOOLWINDOW)
+ case "FormBorderStyle.Sizable"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_THICKFRAME)
+ AfxAddWindowStyle(pCtrl->hWindow, WS_DLGFRAME)
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_WINDOWEDGE)
+ case "FormBorderStyle.Fixed3D"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_DLGFRAME)
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_WINDOWEDGE)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "FormBorderStyle.FixedSingle"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_DLGFRAME)
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_WINDOWEDGE)
+ case "FormBorderStyle.FixedDialog"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_DLGFRAME)
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_DLGMODALFRAME)
+ end select
+ end if
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the button
+' ========================================================================================
+function Button_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select case ucase(wszPropName)
+
+ case "THEMESUPPORT"
+ if wszPropValue = "True" then
+ pCtrl->AfxButtonPtr->EnableTheming
+ else
+ pCtrl->AfxButtonPtr->DisableTheming
+ end if
+
+ case "IMAGE"
+ dim pImageType as IMAGES_TYPE ptr = GetImagesTypePtr(wszPropValue)
+ if pImageType then
+ pCtrl->AfxButtonPtr->SetImageFromFile( pImageType->wszFilename )
+ ' The button defaults to 16x16 so make sure that the image reflects this. The
+ ' button control would have loaded whatever size the default icon was in the
+ ' file and that may not necessarily be 16x16. Subsequent property calls to
+ ' ImageWidth, ImageHeight, and ImageHighDPI will resize the image accordingly if
+ ' the default values are different.
+ dim as long nWidth = val( GetControlProperty(pCtrl, "IMAGEWIDTH") )
+ dim as long nHeight = val( GetControlProperty(pCtrl, "IMAGEHEIGHT") )
+ if wszPropValue = "True" then
+ pCtrl->AfxButtonPtr->SetImageSize( pWindow->ScaleX(nWidth), pWindow->ScaleY(nHeight), true )
+ else
+ pCtrl->AfxButtonPtr->SetImageSize( nWidth, nHeight, true )
+ end if
+ end if
+
+ case "IMAGEALIGN"
+ dim as long wsStyle
+ select case wszPropValue
+ CASE "ImageAlignment.BottomCenter": wsStyle = &H20 OR &H4
+ CASE "ImageAlignment.BottomLeft": wsStyle = &H20 OR &H1
+ CASE "ImageAlignment.BottomRight": wsStyle = &H20 OR &H2
+ CASE "ImageAlignment.MiddleCenter": wsStyle = &H8 OR &H4 ' no text
+ CASE "ImageAlignment.MiddleLeft": wsStyle = &H8 OR &H1
+ CASE "ImageAlignment.MiddleRight": wsStyle = &H8 OR &H2
+ CASE "ImageAlignment.TopCenter": wsStyle = &H10 OR &H4
+ CASE "ImageAlignment.TopLeft": wsStyle = &H10 OR &H1
+ CASE "ImageAlignment.TopRight": wsStyle = &H10 OR &H2
+ end select
+ pCtrl->AfxButtonPtr->SetImagePos(wsStyle, true)
+
+ case "IMAGEMARGIN"
+ pCtrl->AfxButtonPtr->SetImageMargin( nPropValue, true )
+
+ case "IMAGEWIDTH"
+ pCtrl->AfxButtonPtr->SetImageWidth( nPropValue, true )
+
+ case "IMAGEHEIGHT"
+ pCtrl->AfxButtonPtr->SetImageHeight( nPropValue, true )
+
+ case "IMAGEHIGHDPI"
+ ' The default width/height is 16x16 so adjust that size accordingly.
+ dim as long nWidth = val( GetControlProperty(pCtrl, "IMAGEWIDTH") )
+ dim as long nHeight = val( GetControlProperty(pCtrl, "IMAGEHEIGHT") )
+ if wszPropValue = "True" then
+ pCtrl->AfxButtonPtr->SetImageSize( pWindow->ScaleX(nWidth), pWindow->ScaleY(nHeight), true )
+ end if
+
+ case "BACKCOLOR"
+ pCtrl->AfxButtonPtr->SetButtonBkColor( GetRGBColorFromProperty(wszPropValue), true )
+
+ case "TEXTFORECOLOR"
+ pCtrl->AfxButtonPtr->SetTextForeColor( GetRGBColorFromProperty(wszPropValue), true )
+
+ case "TEXTBACKCOLOR"
+ pCtrl->AfxButtonPtr->SetTextBkColor( GetRGBColorFromProperty(wszPropValue), true )
+
+ case "TEXTMARGIN"
+ pCtrl->AfxButtonPtr->SetTextMargin( nPropValue, true )
+
+ case "MULTILINE"
+ dim as long wsStyle
+ select case GetControlProperty(pCtrl, "TEXTALIGN")
+ CASE "ButtonAlignment.BottomCenter": wsStyle = DT_CENTER OR DT_BOTTOM
+ CASE "ButtonAlignment.BottomLeft": wsStyle = DT_LEFT OR DT_BOTTOM
+ CASE "ButtonAlignment.BottomRight": wsStyle = DT_RIGHT OR DT_BOTTOM
+ CASE "ButtonAlignment.MiddleCenter": wsStyle = DT_CENTER OR DT_VCENTER
+ CASE "ButtonAlignment.MiddleLeft": wsStyle = DT_LEFT OR DT_VCENTER
+ CASE "ButtonAlignment.MiddleRight": wsStyle = DT_RIGHT OR DT_VCENTER
+ CASE "ButtonAlignment.TopCenter": wsStyle = DT_CENTER OR DT_TOP
+ CASE "ButtonAlignment.TopLeft": wsStyle = DT_LEFT OR DT_TOP
+ CASE "ButtonAlignment.TopRight": wsStyle = DT_RIGHT OR DT_TOP
+ end select
+ dim as CWSTR wszText = GetControlProperty(pCtrl, "TEXT")
+ if wszPropValue = "True" then
+ pCtrl->AfxButtonPtr->SetTextFormat(wsStyle OR DT_WORDBREAK, true)
+ wszText = AfxStrReplace(wszText, "{br}", chr(10))
+ else
+ pCtrl->AfxButtonPtr->SetTextFormat(wsStyle OR DT_SINGLELINE, true)
+ end if
+ AfxSetWindowText(pCtrl->hWindow, wszText)
+
+ case "TEXTALIGN"
+ dim as long wsStyle
+ select case wszPropValue
+ CASE "ButtonAlignment.BottomCenter": wsStyle = DT_CENTER OR DT_BOTTOM
+ CASE "ButtonAlignment.BottomLeft": wsStyle = DT_LEFT OR DT_BOTTOM
+ CASE "ButtonAlignment.BottomRight": wsStyle = DT_RIGHT OR DT_BOTTOM
+ CASE "ButtonAlignment.MiddleCenter": wsStyle = DT_CENTER OR DT_VCENTER
+ CASE "ButtonAlignment.MiddleLeft": wsStyle = DT_LEFT OR DT_VCENTER
+ CASE "ButtonAlignment.MiddleRight": wsStyle = DT_RIGHT OR DT_VCENTER
+ CASE "ButtonAlignment.TopCenter": wsStyle = DT_CENTER OR DT_TOP
+ CASE "ButtonAlignment.TopLeft": wsStyle = DT_LEFT OR DT_TOP
+ CASE "ButtonAlignment.TopRight": wsStyle = DT_RIGHT OR DT_TOP
+ end select
+ if GetControlProperty(pCtrl, "MULTILINE") = "True" then
+ pCtrl->AfxButtonPtr->SetTextFormat(wsStyle OR DT_WORDBREAK, true)
+ else
+ pCtrl->AfxButtonPtr->SetTextFormat(wsStyle OR DT_SINGLELINE, true)
+ end if
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the label
+' ========================================================================================
+function Label_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ dim as COLORREF clrBack = GetRGBColorFromProperty(wszPropValue)
+ if pCtrl->hBackBrush then DeleteBrush(pCtrl->hBackBrush)
+ pCtrl->hBackBrush = CreateSolidBrush(clrBack)
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "BORDERSTYLE"
+ dim as long wsStyle
+ select case wszPropValue
+ case "ControlBorderStyle.None"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.Fixed3D"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.FixedSingle"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ end select
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the checkbox
+' ========================================================================================
+function CheckBox_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ dim as COLORREF clrBack = GetRGBColorFromProperty(wszPropValue)
+ if pCtrl->hBackBrush then DeleteBrush(pCtrl->hBackBrush)
+ pCtrl->hBackBrush = CreateSolidBrush(clrBack)
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "CHECKSTATE"
+ dim as long wsState
+ select case wszPropValue
+ Case "CheckBoxState.Checked": wsState = BST_CHECKED
+ Case "CheckBoxState.UnChecked": wsState = BST_UNCHECKED
+ Case "CheckBoxState.Indeterminate": wsState = BST_INDETERMINATE
+ End Select
+ SendMessage( pCtrl->hWindow, BM_SETCHECK, wsState, 0)
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "THREESTATE"
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_AUTO3STATE)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_AUTOCHECKBOX)
+ if wszPropValue = "True" then
+ AfxAddWindowStyle(pCtrl->hWindow, BS_AUTO3STATE)
+ else
+ AfxAddWindowStyle(pCtrl->hWindow, BS_AUTOCHECKBOX)
+ end if
+
+ case "TEXTALIGN"
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_CENTER)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_LEFT)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_RIGHT)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_TOP)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_BOTTOM)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_VCENTER)
+ dim as long wsStyle
+ select case wszPropValue
+ CASE "ButtonAlignment.BottomCenter": wsStyle = BS_CENTER OR BS_BOTTOM
+ CASE "ButtonAlignment.BottomLeft": wsStyle = BS_LEFT OR BS_BOTTOM
+ CASE "ButtonAlignment.BottomRight": wsStyle = BS_RIGHT OR BS_BOTTOM
+ CASE "ButtonAlignment.MiddleCenter": wsStyle = BS_CENTER OR BS_VCENTER
+ CASE "ButtonAlignment.MiddleLeft": wsStyle = BS_LEFT OR BS_VCENTER
+ CASE "ButtonAlignment.MiddleRight": wsStyle = BS_RIGHT OR BS_VCENTER
+ CASE "ButtonAlignment.TopCenter": wsStyle = BS_CENTER OR BS_TOP
+ CASE "ButtonAlignment.TopLeft": wsStyle = BS_LEFT OR BS_TOP
+ CASE "ButtonAlignment.TopRight": wsStyle = BS_RIGHT OR BS_TOP
+ END SELECT
+ AfxAddWindowStyle(pCtrl->hWindow, wsStyle)
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the optionbutton
+' ========================================================================================
+function OptionButton_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ dim as COLORREF clrBack = GetRGBColorFromProperty(wszPropValue)
+ if pCtrl->hBackBrush then DeleteBrush(pCtrl->hBackBrush)
+ pCtrl->hBackBrush = CreateSolidBrush(clrBack)
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "CHECKED"
+ ' If Checked is True then cycle through all of the other OptionButtons in
+ ' the same group and toggle their Checked property to False.
+ if wszPropValue = "True" then
+ dim pCtrl2 as clsControl ptr
+ dim as CWSTR wszOptionGroup = ucase(GetControlProperty(pCtrl, "GROUPNAME"))
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl2 = pDoc->Controls.ItemAt(i)
+ if pCtrl2->ControlType <> CTRL_OPTION then continue for
+ if pCtrl2 = pCtrl then continue for
+ if ucase(GetControlProperty(pCtrl2, "GROUPNAME")) = wszOptionGroup THEN
+ SetControlProperty(pCtrl2, "CHECKED", "False")
+ SendMessage( pCtrl2->hWindow, BM_SETCHECK, BST_UNCHECKED, 0)
+ AfxRedrawWindow(pCtrl2->hWindow)
+ end if
+ NEXT
+ SendMessage( pCtrl->hWindow, BM_SETCHECK, BST_CHECKED, 0)
+ AfxRedrawWindow(pCtrl->hWindow)
+ end if
+
+ case "TEXTALIGN"
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_CENTER)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_LEFT)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_RIGHT)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_TOP)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_BOTTOM)
+ AfxRemoveWindowStyle(pCtrl->hWindow, BS_VCENTER)
+ dim as long wsStyle
+ select case wszPropValue
+ CASE "ButtonAlignment.BottomCenter": wsStyle = BS_CENTER OR BS_BOTTOM
+ CASE "ButtonAlignment.BottomLeft": wsStyle = BS_LEFT OR BS_BOTTOM
+ CASE "ButtonAlignment.BottomRight": wsStyle = BS_RIGHT OR BS_BOTTOM
+ CASE "ButtonAlignment.MiddleCenter": wsStyle = BS_CENTER OR BS_VCENTER
+ CASE "ButtonAlignment.MiddleLeft": wsStyle = BS_LEFT OR BS_VCENTER
+ CASE "ButtonAlignment.MiddleRight": wsStyle = BS_RIGHT OR BS_VCENTER
+ CASE "ButtonAlignment.TopCenter": wsStyle = BS_CENTER OR BS_TOP
+ CASE "ButtonAlignment.TopLeft": wsStyle = BS_LEFT OR BS_TOP
+ CASE "ButtonAlignment.TopRight": wsStyle = BS_RIGHT OR BS_TOP
+ END SELECT
+ AfxAddWindowStyle(pCtrl->hWindow, wsStyle)
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the listbox
+' ========================================================================================
+function ListBox_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+ if pWindow = 0 then exit function
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ dim as COLORREF clrBack = GetRGBColorFromProperty(wszPropValue)
+ if pCtrl->hBackBrush then DeleteBrush(pCtrl->hBackBrush)
+ pCtrl->hBackBrush = CreateSolidBrush(clrBack)
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "BORDERSTYLE"
+ dim as long wsStyle
+ select case wszPropValue
+ case "ControlBorderStyle.None"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.Fixed3D"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.FixedSingle"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ end select
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ case "INTEGRALHEIGHT"
+ ' Do not do anything with the IntegralHeight property. Let the user size at whatever
+ ' size he wishes during runtime. If property is set to True then it will resize
+ ' appropriately at runtime. It appears that even though you can dynamically set the
+ ' NOINTEGRALHEIGHT flag, the control itself doesn't seem to respond to it correctly
+ ' once the original listview has been cfreated.
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the combobox
+' ========================================================================================
+function ComboBox_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+ if pWindow = 0 then exit function
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ dim as COLORREF clrBack = GetRGBColorFromProperty(wszPropValue)
+ if pCtrl->hBackBrush then DeleteBrush(pCtrl->hBackBrush)
+ pCtrl->hBackBrush = CreateSolidBrush(clrBack)
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "BORDERSTYLE"
+ dim as long wsStyle
+ select case wszPropValue
+ case "ControlBorderStyle.None"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.Fixed3D"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.FixedSingle"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ end select
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ case "DROPDOWNSTYLE"
+ dim as long nCtrlId, dwStyle, dwExStyle = -1
+ dwStyle = WS_CHILD or WS_VISIBLE OR WS_HSCROLL OR WS_VSCROLL OR WS_BORDER OR _
+ CBS_HASSTRINGS or CBS_NOINTEGRALHEIGHT
+ Select Case wszPropValue
+ Case "ComboBoxStyle.Simple": dwStyle = dwStyle OR CBS_SIMPLE
+ Case "ComboBoxStyle.DropDown": dwStyle = dwStyle OR CBS_DROPDOWN
+ Case "ComboBoxStyle.DropDownList": dwStyle = dwStyle OR CBS_DROPDOWNLIST
+ End Select
+ dim as CWSTR wszControlName = GetControlProperty(pCtrl, "NAME")
+ dim rcDraw as RECT = GetControlRect(pCtrl)
+ nCtrlId = GetDlgCtrlID(pCtrl->hWindow)
+ DestroyWindow(pCtrl->hWindow)
+ pCtrl->hWindow = pWindow->AddControl( "ComboBox", , nCtrlId, wszControlName, _
+ rcDraw.left, rcDraw.top, rcDraw.right-rcDraw.left, rcDraw.bottom-rcDraw.top, _
+ dwStyle, dwExStyle, , _
+ CAST(SUBCLASSPROC, @Control_SubclassProc), CTRL_COMBOBOX, CAST(DWORD_PTR, pDoc))
+ ' Also subclass the combobox edit control
+ dim as HWND hWndEditCtrl = ComboBox_GetEditBoxHandle(pCtrl->hWindow)
+ if IsWindow(hWndEditCtrl) then
+ SetWindowSubclass(hWndEditCtrl, CAST(SUBCLASSPROC, @Control_SubclassProc), CTRL_COMBOBOX, CAST(DWORD_PTR, pDoc))
+ end if
+ dim as HWND hWndListCtrl = ComboBox_GetListBoxHandle(pCtrl->hWindow)
+ if IsWindow(hWndListCtrl) then
+ SetWindowSubclass(hWndListCtrl, CAST(SUBCLASSPROC, @Control_SubclassProc), CTRL_COMBOBOX, CAST(DWORD_PTR, pDoc))
+ end if
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the textbox
+' ========================================================================================
+function TextBox_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ dim as COLORREF clrBack = GetRGBColorFromProperty(wszPropValue)
+ if pCtrl->hBackBrush then DeleteBrush(pCtrl->hBackBrush)
+ pCtrl->hBackBrush = CreateSolidBrush(clrBack)
+
+ case "BORDERSTYLE"
+ select case wszPropValue
+ case "ControlBorderStyle.None"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.Fixed3D"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.FixedSingle"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ end select
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ case "CHARACTERCASING"
+ AfxRemoveWindowStyle(pCtrl->hWindow, ES_LOWERCASE)
+ AfxRemoveWindowStyle(pCtrl->hWindow, ES_UPPERCASE)
+ select case wszPropValue
+ Case "CharacterCase.Normal"
+ Case "CharacterCase.Upper"
+ AfxAddWindowStyle(pCtrl->hWindow, ES_UPPERCASE)
+ Case "CharacterCase.Lower"
+ AfxAddWindowStyle(pCtrl->hWindow, ES_LOWERCASE)
+ End Select
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ CASE "MULTILINE"
+ if wszPropValue = "True" then
+ AfxAddWindowStyle(pCtrl->hWindow, ES_MULTILINE)
+ else
+ AfxRemoveWindowStyle(pCtrl->hWindow, ES_MULTILINE)
+ END IF
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "PASSWORDCHAR"
+ Dim As Long iChr = 0
+ If Len(wszPropValue) Then iChr = wszPropValue[0]
+ SendMessage(pCtrl->hWindow, EM_SETPASSWORDCHAR, iChr, 0)
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "TEXTSCROLLBARS"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_HSCROLL)
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_VSCROLL)
+ dim as long wsStyle
+ select case wszPropValue
+ case "ScrollBars.None"
+ case "ScrollBars.Horizontal"
+ wsStyle = WS_HSCROLL
+ case "ScrollBars.Vertical"
+ wsStyle = WS_VSCROLL
+ case "ScrollBars.Both"
+ wsStyle = (WS_HSCROLL or WS_VSCROLL)
+ end select
+ AfxAddWindowStyle(pCtrl->hWindow, wsStyle)
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ case "TEXTALIGN"
+ AfxRemoveWindowStyle(pCtrl->hWindow, ES_CENTER)
+ AfxRemoveWindowStyle(pCtrl->hWindow, ES_LEFT)
+ AfxRemoveWindowStyle(pCtrl->hWindow, ES_RIGHT)
+ dim as long wsStyle
+ select case wszPropValue
+ CASE "TextAlignment.Left": wsStyle = ES_LEFT
+ CASE "TextAlignment.Center": wsStyle = ES_CENTER
+ CASE "TextAlignment.Right": wsStyle = ES_RIGHT
+ END SELECT
+ AfxAddWindowStyle(pCtrl->hWindow, wsStyle)
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the MaskedEdit textbox
+' ========================================================================================
+function MaskedEdit_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ dim as COLORREF clrBack = GetRGBColorFromProperty(wszPropValue)
+ if pCtrl->hBackBrush then DeleteBrush(pCtrl->hBackBrush)
+ pCtrl->hBackBrush = CreateSolidBrush(clrBack)
+
+ case "BORDERSTYLE"
+ select case wszPropValue
+ case "ControlBorderStyle.None"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.Fixed3D"
+ AfxRemoveWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxAddWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ case "ControlBorderStyle.FixedSingle"
+ AfxAddWindowStyle(pCtrl->hWindow, WS_BORDER)
+ AfxRemoveWindowExStyle(pCtrl->hWindow, WS_EX_CLIENTEDGE)
+ end select
+ AfxRedrawNonClientArea(pCtrl->hWindow)
+
+ case "TEXT", "MASKSTRING", "INPUTSTRING", "DEFAULTCHARACTER"
+ dim as CWSTR wszMaskString = GetControlProperty(pCtrl, "MASKSTRING")
+ dim as CWSTR wszInputString = GetControlProperty(pCtrl, "INPUTSTRING")
+ dim as CWSTR wszDefaultCharacter = GetControlProperty(pCtrl, "DEFAULTCHARACTER")
+ dim as CWSTR wszValidCharacters = GetControlProperty(pCtrl, "VALIDCHARACTERS")
+ dim as CWSTR wszText = GetControlProperty(pCtrl, "TEXT")
+ pCtrl->AfxMaskedPtr->EnableMask(wszMaskString, wszInputString, wszDefaultCharacter, wszValidCharacters)
+ pCtrl->AfxMaskedPtr->SetText(wszText, false)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the frame
+' ========================================================================================
+function Frame_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ dim as COLORREF clrBack = GetRGBColorFromProperty(wszPropValue)
+ if pCtrl->hBackBrush then DeleteBrush(pCtrl->hBackBrush)
+ pCtrl->hBackBrush = CreateSolidBrush(clrBack)
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the PictureBox
+' ========================================================================================
+function PictureBox_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "IMAGE"
+ dim pImageType as IMAGES_TYPE ptr = GetImagesTypePtr(wszPropValue)
+ if pImageType then
+ pCtrl->AfxPicturePtr->LoadImageFromFile( pImageType->wszFilename )
+ else
+ pCtrl->AfxPicturePtr->Clear
+ end if
+
+ case "IMAGEWIDTH"
+ if nPropValue > 0 then
+ pCtrl->AfxPicturePtr->SetImageWidth( nPropValue )
+ end if
+
+ case "IMAGEHEIGHT"
+ if nPropValue > 0 then
+ pCtrl->AfxPicturePtr->SetImageHeight( nPropValue )
+ end if
+
+ case "IMAGESCALING"
+ select case wszPropValue
+ case "ImageScale.None"
+ pCtrl->AfxPicturePtr->SetImageAdjustment( GDIP_IMAGECTX_ACTUALSIZE, true )
+ case "ImageScale.AutoSize"
+ pCtrl->AfxPicturePtr->SetImageAdjustment( GDIP_IMAGECTX_AUTOSIZE, true )
+ case "ImageScale.FitWidth"
+ pCtrl->AfxPicturePtr->SetImageAdjustment( GDIP_IMAGECTX_FITTOWIDTH, true )
+ case "ImageScale.FitHeight"
+ pCtrl->AfxPicturePtr->SetImageAdjustment( GDIP_IMAGECTX_FITTOHEIGHT, true )
+ case "ImageScale.Stretch"
+ pCtrl->AfxPicturePtr->SetImageAdjustment( GDIP_IMAGECTX_STRETCH, true )
+ end select
+
+ case "BACKCOLOR"
+ pCtrl->AfxPicturePtr->SetBkColor( GetRGBColorFromProperty(wszPropValue), true )
+
+ case "BACKCOLORHOT"
+ pCtrl->AfxPicturePtr->SetBkColorHot( GetRGBColorFromProperty(wszPropValue), true )
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the ProgressBar
+' ========================================================================================
+function ProgressBar_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "MAXIMUM"
+ if nPropValue >= 0 then
+ dim as long nMinimum = ProgressBar_GetMinRange( pCtrl->hWindow )
+ ProgressBar_SetRange32( pCtrl->hWindow, nMinimum, nPropValue )
+ end if
+
+ case "MINIMUM"
+ if nPropValue >= 0 then
+ dim as long nMaximum = ProgressBar_GetMaxRange( pCtrl->hWindow )
+ ProgressBar_SetRange32( pCtrl->hWindow, nPropValue, nMaximum )
+ end if
+
+ case "VALUE"
+ if nPropValue >= 0 then
+ ProgressBar_SetPos( pCtrl->hWindow, nPropValue )
+ end if
+
+ case "VERTICAL"
+ if wszPropValue = "True" then
+ AfxAddWindowStyle(pCtrl->hWindow, PBS_VERTICAL)
+ else
+ AfxRemoveWindowStyle(pCtrl->hWindow, PBS_VERTICAL)
+ end if
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the Listview
+' ========================================================================================
+function ListView_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ case "CHECKBOXES"
+ case "GRIDLINES"
+ CASE "FULLROWSELECT"
+ CASE "HIDESELECTION"
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the MonthCalendar
+' ========================================================================================
+function MonthCalendar_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+
+ dim as long nPropValue
+ dim as CWSTR wszPropName, wszPropValue
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+
+ case "BACKCOLOR"
+ dim as COLORREF clrBack = GetRGBColorFromProperty(wszPropValue)
+ MonthCal_SetColor( pCtrl->hWindow, MCSC_BACKGROUND, clrBack )
+
+ case "WEEKNUMBERS"
+ if wszPropValue = "True" then
+ AfxAddWindowStyle(pCtrl->hWindow, MCS_WEEKNUMBERS)
+ else
+ AfxRemoveWindowStyle(pCtrl->hWindow, MCS_WEEKNUMBERS)
+ end if
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "TODAYCIRCLE"
+ if wszPropValue = "True" then
+ AfxRemoveWindowStyle(pCtrl->hWindow, MCS_NOTODAYCIRCLE)
+ else
+ AfxAddWindowStyle(pCtrl->hWindow, MCS_NOTODAYCIRCLE)
+ end if
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "TODAYDATE"
+ if len(trim(wszPropValue)) = 8 then
+ Dim As SYSTEMTIME pst
+ pst.wYear = val(left(wszPropValue, 4))
+ pst.wMonth = val(mid(wszPropValue, 5, 2))
+ pst.wDay = val(right(wszPropValue, 2))
+ MonthCal_SetCurSel( pCtrl->hWindow, @pst )
+ end if
+
+ case "TODAYSELECTOR"
+ if wszPropValue = "True" then
+ AfxRemoveWindowStyle(pCtrl->hWindow, MCS_NOTODAY)
+ else
+ AfxAddWindowStyle(pCtrl->hWindow, MCS_NOTODAY)
+ end if
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "TRAILINGDATES"
+ if wszPropValue = "True" then
+ AfxRemoveWindowStyle(pCtrl->hWindow, MCS_NOTRAILINGDATES)
+ else
+ AfxAddWindowStyle(pCtrl->hWindow, MCS_NOTRAILINGDATES)
+ end if
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ case "SHORTDAYNAMES"
+ if wszPropValue = "True" then
+ AfxAddWindowStyle(pCtrl->hWindow, MCS_SHORTDAYSOFWEEK)
+ else
+ AfxRemoveWindowStyle(pCtrl->hWindow, MCS_SHORTDAYSOFWEEK)
+ end if
+ AfxRedrawWindow(pCtrl->hWindow)
+
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the DateTimePicker
+' ========================================================================================
+function DateTimePicker_ApplyProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ ' This control gets recreated when properties change because visually some states
+ ' require a complete rebuilding of the control. No need to set properties here
+ ' if the control is going to be rebuilt anyway in ReCreateToolboxControl.
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Apply properties to the incoming control
+' ========================================================================================
+function ApplyControlProperties( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr _
+ ) as long
+
+ if pDoc = 0 then exit function
+ if pCtrl = 0 then exit function
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+ dim pProp as clsProperty ptr
+
+ dim as long lb = lbound(pCtrl->Properties)
+ dim as long ub = ubound(pCtrl->Properties)
+
+ dim as long nPropValue, nTemp, nLeft, nTop, nWidth, nHeight
+ dim as CWSTR wszPropName, wszPropValue
+
+
+ ' Loop through all properties and apply them
+ for i as long = lb to ub
+ pProp = @pCtrl->Properties(i)
+ if pProp = 0 then continue for
+
+ wszPropName = pProp->wszPropName
+ wszPropValue = pProp->wszPropValue
+ nPropValue = Val(pProp->wszPropValue)
+
+ select CASE ucase(wszPropName)
+ case "NAME"
+ if pCtrl->ControlType = CTRL_LISTBOX then
+ ListBox_ResetContent(pCtrl->hWindow)
+ ListBox_AddString(pCtrl->hWindow, wszPropValue.sptr)
+ END IF
+ CASE "LEFT"
+ nLeft = nPropValue
+ if pCtrl->SuspendLayout = false THEN
+ nTemp = val(GetControlProperty(pCtrl, "TOP"))
+ if pCtrl->ControlType = CTRL_FORM then
+ nLeft = 10: nTemp = 10
+ end if
+ pWindow->SetWindowPos(pCtrl->hWindow, 0, nLeft, nTemp, 0, 0, SWP_NOZORDER or SWP_NOSIZE)
+ end if
+ CASE "TOP"
+ nTop = nPropValue
+ if pCtrl->SuspendLayout = false THEN
+ nTemp = val(GetControlProperty(pCtrl, "LEFT"))
+ if pCtrl->ControlType = CTRL_FORM then
+ nTop = 10: nTemp = 10
+ end if
+ pWindow->SetWindowPos(pCtrl->hWindow, 0, nTemp, nTop, 0, 0, SWP_NOZORDER or SWP_NOSIZE)
+ end if
+ CASE "WIDTH"
+ nWidth = nPropValue
+ if pCtrl->SuspendLayout = false THEN
+ nTemp = val(GetControlProperty(pCtrl, "HEIGHT"))
+ pWindow->SetWindowPos(pCtrl->hWindow, 0, 0, 0, nWidth, nTemp, SWP_NOZORDER or SWP_NOMOVE)
+ end if
+ CASE "HEIGHT"
+ nHeight = nPropValue
+ if pCtrl->SuspendLayout = false THEN
+ nTemp = val(GetControlProperty(pCtrl, "WIDTH"))
+ pWindow->SetWindowPos(pCtrl->hWindow, 0, 0, 0, nTemp, nHeight, SWP_NOZORDER or SWP_NOMOVE)
+ end if
+ case "TEXT"
+ select case pCtrl->ControlType
+ case CTRL_MASKEDEDIT
+ ' skip these controls and set in special handlers below
+ case else
+ AfxSetWindowText(pCtrl->hWindow, wszPropValue)
+ end select
+ case "FONT"
+ dim as HFONT hFontOld = AfxGetWindowFont(pCtrl->hWindow)
+ dim as LOGFONT lf
+ lf = SetLogFontFromPropValue(wszPropValue)
+ dim as HFONT hFont = CreateFontIndirect(@lf)
+ AfxSetWindowFont(pCtrl->hWindow, hFont, true)
+ DeleteFont(hFontOld)
+ END SELECT
+
+
+ ' No need to apply non-positional properties if all we are doing is
+ ' resizing or moving.
+ if (pDoc->bSizing = true) or (pDoc->bMoving = true) then continue for
+
+ ' Handle control specific properties
+ ' Only act on properties where the value has changed.
+' Comment out next line because controls loaded from file will not change properties visually otherwise.
+' if pProp->wszPropValue = pProp->wszPropValuePrev then continue for
+ select CASE pCtrl->ControlType
+ case CTRL_FORM: Form_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_BUTTON: Button_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_LABEL: Label_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_CHECKBOX: CheckBox_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_OPTION: OptionButton_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_TEXTBOX: TextBox_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_RICHEDIT: TextBox_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_MASKEDEDIT: MaskedEdit_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_LISTBOX: ListBox_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_COMBOBOX: ComboBox_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_FRAME: Frame_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_PICTUREBOX: PictureBox_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_PROGRESSBAR: ProgressBar_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_LISTVIEW: Listview_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_MONTHCALENDAR: MonthCalendar_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_DATETIMEPICKER: DateTimePicker_ApplyProperties(pDoc, pCtrl, pProp)
+ case CTRL_TABCONTROL
+ ' Tab Control gets recreated as a whole when the properties change.
+ case CTRL_TIMER
+ ' Timers are non-visual controls so no need to do any further processing.
+ CASE ELSE
+ END SELECT
+
+ next
+
+ ' If layout has been suspended then only move/resize the control after
+ ' all of the relevant properties have now been set.
+ if pCtrl->SuspendLayout THEN
+ pWindow->SetWindowPos( pCtrl->hWindow, 0, nLeft, nTop, nWidth, nHeight, SWP_NOZORDER)
+ END IF
+
+ if pCtrl->ControlType = CTRL_TABCONTROL then
+ ReCreateToolboxControl( pDoc, pCtrl )
+ end if
+
+ if pCtrl->ControlType = CTRL_DATETIMEPICKER then
+ ReCreateToolboxControl( pDoc, pCtrl )
+ end if
+
+ ' Repaint to ensure that the grab handles draw
+ AfxRedrawWindow(pCtrl->hWindow)
+ AfxRedrawWindow(pDoc->hWndFrame)
+ AfxRedrawWindow(pDoc->hWndForm)
+ AfxRedrawNonClientArea(pDoc->hWndForm)
+
+ function = 0
+
+end function
+
diff --git a/src/modVDColors.bi b/src/modVDColors.bi
index 86ba34ee..3cb02f01 100644
--- a/src/modVDColors.bi
+++ b/src/modVDColors.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDColors.bi.bak b/src/modVDColors.bi.bak
new file mode 100644
index 00000000..86ba34ee
--- /dev/null
+++ b/src/modVDColors.bi.bak
@@ -0,0 +1,45 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMVDCOLORS_TABCONTROL 1000
+#Define IDC_FRMVDCOLORS_LSTCUSTOM 1001
+#Define IDC_FRMVDCOLORS_LSTCOLORS 1002
+#Define IDC_FRMVDCOLORS_LSTSYSTEM 1003
+
+#define FRMVDCOLORS_LISTBOX_LINEHEIGHT 20
+
+enum
+ COLOR_CUSTOM = 1
+ COLOR_COLORS
+ COLOR_SYSTEM
+end enum
+
+type clsColors
+ private:
+ public:
+ wszColorName as CWSTR
+ ColorType as long ' COLOR_QUICK, COLOR_SYSTEM
+ ColorValue as COLORREF
+ declare function SetColor( byref wszColorName as wstring, byval ColorType as long, byval ColorValue as COLORREF) as long
+END TYPE
+function clsColors.SetColor( byref wszColorName as wstring, byval ColorType as long, byval ColorValue as COLORREF) as Long
+ this.wszColorName = wszColorName
+ this.ColorType = ColorType ' COLOR_QUICK, COLOR_SYSTEM
+ this.ColorValue = ColorValue ' COLORREF
+ function = 0
+end function
+dim shared gColors(any) as clsColors
+
+declare Function frmVDColors_Show( ByVal hWndParent As HWnd, byref wszPropValue as wstring ) as LRESULT
diff --git a/src/modVDColors.inc b/src/modVDColors.inc
index e90750eb..2e4d977c 100644
--- a/src/modVDColors.inc
+++ b/src/modVDColors.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDColors.inc.bak b/src/modVDColors.inc.bak
new file mode 100644
index 00000000..e90750eb
--- /dev/null
+++ b/src/modVDColors.inc.bak
@@ -0,0 +1,439 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modVDColors.bi"
+#include once "clsDocument.bi"
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmVDColors
+' ========================================================================================
+private Function frmVDColors_OnCommand( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ dim pProp as clsProperty ptr = GetActivePropertyPtr()
+ dim as long nCurSel, idx
+
+ select case id
+ CASE IDC_FRMVDCOLORS_LSTCUSTOM
+ if codeNotify = LBN_SELCHANGE then
+ if pProp then
+ nCurSel = ListBox_GetCurSel(hwndCtl)
+ if nCurSel > -1 then
+ dim lCustomColor(15) AS LONG
+ dim as COLORREF clrResult
+ dim pProp as clsProperty ptr = GetActivePropertyPtr()
+ if pProp then
+ ' Set the default color to be whatever the current color is for the
+ ' property that is currently selected.
+ lCustomColor(0) = Val(AfxStrParse(pProp->wszPropValue, 2, "|"))
+ end if
+ clrResult = AfxChooseColorDialog( hwnd, lCustomColor(0), @lCustomColor(0))
+ if clrResult <> -1 then
+ pProp->wszPropValuePrev = pProp->wszPropValue
+ pProp->wszPropValue = "CUSTOM|" & clrResult
+ AfxRedrawWindow(GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES))
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+ frmMain_SetStatusbar
+ PostMessage(HWND_FRMVDCOLORS, WM_ACTIVATE, WA_INACTIVE, 0) ' to apply properties
+ end if
+ end if
+ END IF
+ END IF
+ case IDC_FRMVDCOLORS_LSTCOLORS, IDC_FRMVDCOLORS_LSTSYSTEM
+ if codeNotify = LBN_SELCHANGE then
+ if pProp then
+ nCurSel = ListBox_GetCurSel(hwndCtl)
+ if nCurSel > -1 then
+ idx = ListBox_GetItemData(hwndCtl, nCurSel)
+ pProp->wszPropValuePrev = pProp->wszPropValue
+ pProp->wszPropValue = _
+ iif(id = IDC_FRMVDCOLORS_LSTSYSTEM, "SYSTEM|", "COLORS|")
+ pProp->wszPropValue = pProp->wszPropValue & gColors(idx).wszColorName
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+ frmMain_SetStatusbar
+ ShowWindow(HWND_FRMVDCOLORS, SW_HIDE)
+ AfxRedrawWindow(GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES))
+ end if
+ end if
+ end if
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_NOTIFY message for window/dialog: frmVDColors
+' ========================================================================================
+private Function frmVDColors_OnNotify( ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal pNMHDR As NMHDR Ptr _
+ ) As LRESULT
+
+ SELECT CASE id
+ CASE IDC_FRMVDCOLORS_TABCONTROL
+ dim as long iPage = TabCtrl_GetCurSel(pNMHDR->hwndFrom)
+ SELECT CASE pNMHDR->code
+ CASE TCN_SELCHANGE
+ ' Show the selected page controls
+ if iPage = 0 then ShowWindow( GetDlgItem(HWND, IDC_FRMVDCOLORS_LSTCUSTOM), SW_SHOW)
+ if iPage = 1 then ShowWindow( GetDlgItem(HWND, IDC_FRMVDCOLORS_LSTCOLORS), SW_SHOW)
+ if iPage = 2 then ShowWindow( GetDlgItem(HWND, IDC_FRMVDCOLORS_LSTSYSTEM), SW_SHOW)
+
+ CASE TCN_SELCHANGING
+ if iPage = 0 then ShowWindow( GetDlgItem(HWND, IDC_FRMVDCOLORS_LSTCUSTOM), SW_HIDE)
+ if iPage = 1 then ShowWindow( GetDlgItem(HWND, IDC_FRMVDCOLORS_LSTCOLORS), SW_HIDE)
+ if iPage = 2 then ShowWindow( GetDlgItem(HWND, IDC_FRMVDCOLORS_LSTSYSTEM), SW_HIDE)
+ END SELECT
+
+ END SELECT
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+private Function frmVDColors_PositionWindows() As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMVDCOLORS)
+ if pWindow = 0 THEN exit function
+
+ ' Get the entire client area
+ Dim As Rect rc
+ GetClientRect(HWND_FRMVDCOLORS, @rc)
+
+ Dim As HWnd hTabCtl = GetDlgItem(HWND_FRMVDCOLORS, IDC_FRMVDCOLORS_TABCONTROL)
+ Dim As HWnd hList1 = GetDlgItem(HWND_FRMVDCOLORS, IDC_FRMVDCOLORS_LSTCUSTOM)
+ Dim As HWnd hList2 = GetDlgItem(HWND_FRMVDCOLORS, IDC_FRMVDCOLORS_LSTCOLORS)
+ Dim As HWnd hList3 = GetDlgItem(HWND_FRMVDCOLORS, IDC_FRMVDCOLORS_LSTSYSTEM)
+
+ SetWindowPos( hTabCtl, 0, 0, 0, rc.Right-rc.Left, pWindow->ScaleY(24), SWP_SHOWWINDOW Or SWP_NOZORDER )
+ SetWindowPos( hList1, 0, 0, pWindow->ScaleY(24), rc.Right-rc.Left, rc.Bottom-rc.top-pWindow->ScaleY(24), SWP_NOZORDER )
+ SetWindowPos( hList2, 0, 0, pWindow->ScaleY(24), rc.Right-rc.Left, rc.Bottom-rc.top-pWindow->ScaleY(24), SWP_NOZORDER )
+ SetWindowPos( hList3, 0, 0, pWindow->ScaleY(24), rc.Right-rc.Left, rc.Bottom-rc.top-pWindow->ScaleY(24), SWP_NOZORDER )
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmVDColors
+' ========================================================================================
+private Function frmVDColors_OnSize( ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+ If state <> SIZE_MINIMIZED Then
+ frmVDColors_PositionWindows
+ End If
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_MEASUREITEM message for window/dialog: frmVDColors
+' ========================================================================================
+private Function frmVDColors_OnMeasureItem( ByVal HWnd As HWnd, _
+ ByVal lpmis As MEASUREITEMSTRUCT Ptr _
+ ) As Long
+ ' Set the height of the List box items.
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ lpmis->itemHeight = pWindow->ScaleY(FRMVDCOLORS_LISTBOX_LINEHEIGHT)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DRAWITEM message for window/dialog: frmVDColors
+' ========================================================================================
+private Function frmVDColors_OnDrawItem( ByVal HWnd As HWnd, _
+ ByVal lpdis As Const DRAWITEMSTRUCT Ptr _
+ ) As Long
+
+ Dim As HBRUSH hBrush, hBrushOld
+ Dim As RECT rc1, rc2
+ Dim wzText As WString * MAX_PATH
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ if pWindow = 0 THEN exit function
+
+ If lpdis->itemID = -1 Then Exit Function ' no selected row
+
+ Select Case lpdis->itemAction
+ Case ODA_DRAWENTIRE, ODA_SELECT
+
+ SaveDC(lpdis->hDC)
+
+ ' CLEAR BACKGROUND
+ If (lpdis->itemState And ODS_SELECTED) Then
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHT))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHTTEXT))
+ hBrush = GetSysColorBrush(COLOR_HIGHLIGHT)
+ else
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_WINDOW))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT))
+ hBrush = GetSysColorBrush(COLOR_WINDOW)
+ end if
+ SelectObject(lpdis->hDC, hBrush)
+ FillRect(lpdis->hDC, @lpdis->rcItem, hBrush)
+
+ If cast(long, lpdis->itemData) = Cast(long, -1) Then
+ wzText = "Custom Color"
+ dim pProp as clsProperty ptr = GetActivePropertyPtr()
+ if pProp then
+ dim as CWSTR wszColorValue = AfxStrParse(pProp->wszPropValue, 2, "|")
+ hBrush = CreateSolidBrush(val(wszColorValue))
+ else
+ hBrush = CreateSolidBrush(BGR(255,255,255))
+ end if
+ else
+ wzText = gColors(lpdis->itemData).wszColorName
+ hBrush = CreateSolidBrush(gColors(lpdis->itemData).ColorValue)
+ end if
+
+ rc1 = lpdis->rcItem
+ rc1.left = pWindow->ScaleX(2): rc1.right = rc1.left + pWindow->ScaleX(16)
+ rc1.top = rc1.top + pWindow->ScaleY(2): rc1.bottom = rc1.bottom - pWindow->ScaleY(2)
+
+ rc2 = lpdis->rcItem
+ rc2.left = rc2.left + pWindow->ScaleX(24)
+
+ ' DRAW COLOR RECT
+ hBrushOld = SelectObject( Cast(HDC, lpdis->hDC), hBrush)
+ RoundRect( lpdis->hDC, rc1.Left, rc1.Top, rc1.Right, rc1.Bottom, pWindow->ScaleX(3), pWindow->ScaleY(3))
+ SelectObject( Cast(HDC, lpdis->hDC), hBrushOld)
+
+ ' DRAW TEXT
+ DrawText( lpdis->hDC, wzText, -1, Cast(lpRect, @rc2), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER )
+
+ RestoreDC(lpdis->hDC, -1)
+ DeleteObject(hBrush)
+
+ Function = True : Exit Function
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmVDColors
+' ========================================================================================
+private Function frmVDColors_OnClose( ByVal HWnd As HWnd ) As LRESULT
+ ' Never close the window; simply hide it.
+ ShowWindow( HWnd, SW_HIDE )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmVDColors
+' ========================================================================================
+private Function frmVDColors_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ HWND_FRMVDCOLORS = 0
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' frmVDColors Window procedure
+' ========================================================================================
+private Function frmVDColors_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_COMMAND, frmVDcolors_OnCommand)
+ HANDLE_MSG (HWnd, WM_NOTIFY, frmVDColors_OnNotify)
+ HANDLE_MSG (HWnd, WM_SIZE, frmVDColors_OnSize)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmVDColors_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmVDColors_OnDestroy)
+ HANDLE_MSG (HWnd, WM_MEASUREITEM, frmVDColors_OnMeasureItem)
+ HANDLE_MSG (HWnd, WM_DRAWITEM, frmVDColors_OnDrawItem)
+
+ case WM_ACTIVATE
+ if wParam = WA_INACTIVE then
+ ShowWindow(HWND_FRMVDCOLORS, SW_HIDE)
+ ' This function allows for two use cases: (1) is to be able to choose colors
+ ' in the PropertyList for various controls, and (2) is to be able to select
+ ' colors for StatusBar Panels. If the StatusBar Editor is active then we
+ ' must be looking for the pPropColor related to that panel, otherwise it
+ ' must be the PropertyList that is being used.
+ if IsWindowVisible(HWND_FRMSTATUSBAREDITOR) then
+ dim as hwnd hList1 = GetDlgItem( HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_LSTPANELS)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+ if nCurSel = -1 then exit function
+
+ select case gPanelItems(nCurSel).idColorCombo
+ case IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLOR
+ gPanelItems(nCurSel).wszBackColor = gPanelItems(nCurSel).pPropColor.wszPropValue
+ case IDC_FRMSTATUSBAREDITOR_COMBOBACKCOLORHOT
+ gPanelItems(nCurSel).wszBackColorHot = gPanelItems(nCurSel).pPropColor.wszPropValue
+ case IDC_FRMSTATUSBAREDITOR_COMBOFORECOLOR
+ gPanelItems(nCurSel).wszForeColor = gPanelItems(nCurSel).pPropColor.wszPropValue
+ case IDC_FRMSTATUSBAREDITOR_COMBOFORECOLORHOT
+ gPanelItems(nCurSel).wszForeColorHot = gPanelItems(nCurSel).pPropColor.wszPropValue
+ end select
+ AfxRedrawWindow( GetDlgItem(HWND_FRMSTATUSBAREDITOR, gPanelItems(nCurSel).idColorCombo ))
+
+ else
+ ' Regular PropertyList case
+ dim pCtrl as clsControl ptr
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc then pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl then ApplyControlProperties(pDoc, pCtrl)
+ end if
+ end if
+
+ End Select
+
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmVDColors_SetColorListBoxSelection
+' ========================================================================================
+private Function frmVDColors_SetColorListBoxSelection( byref wszPropValue as wstring ) as Long
+
+ ' wszPropValue is in two parts separated by "|"
+ ' eg. SYSTEM|ButtonFace
+ ' COLORS|Red
+ ' CUSTOM|
+
+ dim as HWND hTabCtl = GetDlgItem(HWND_FRMVDCOLORS, IDC_FRMVDCOLORS_TABCONTROL)
+ dim as long nCurSel
+ dim as hwnd hList
+
+ dim as CWSTR wszList, wszValue
+ wszList = AfxStrParse(wszPropValue, 1, "|")
+ wszValue = AfxStrParse(wszPropValue, 2, "|")
+
+ dim as hwnd hList1 = GetDlgItem(HWND_FRMVDCOLORS, IDC_FRMVDCOLORS_LSTCUSTOM)
+ dim as hwnd hList2 = GetDlgItem(HWND_FRMVDCOLORS, IDC_FRMVDCOLORS_LSTCOLORS)
+ dim as hwnd hList3 = GetDlgItem(HWND_FRMVDCOLORS, IDC_FRMVDCOLORS_LSTSYSTEM)
+
+ ' Ensure that any previously selected listbox row is now deselected
+ ListBox_SetCurSel(hList1, -1)
+ ListBox_SetCurSel(hList2, -1)
+ ListBox_SetCurSel(hList3, -1)
+
+ ' Hide all existing pages
+ ShowWindow( hList1, SW_HIDE )
+ ShowWindow( hList2, SW_HIDE )
+ ShowWindow( hList3, SW_HIDE )
+
+ select case wszList
+ CASE "CUSTOM"
+ TabCtrl_SetCurSel(hTabCtl, 0)
+ wszValue = "Custom Color"
+ hList = hList1
+ case "COLORS"
+ TabCtrl_SetCurSel(hTabCtl, 1)
+ hList = hList2
+ case "SYSTEM"
+ TabCtrl_SetCurSel(hTabCtl, 2)
+ hList = hList3
+ END SELECT
+
+ nCurSel = ListBox_FindStringExact(hList, -1, wszValue.sptr)
+ ShowWindow(hList, SW_SHOW)
+ ListBox_SetCurSel(hList, nCurSel)
+ SetFocus(hList)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' frmVDColors_Show
+' ========================================================================================
+public Function frmVDColors_Show( ByVal hWndParent As HWnd, _
+ byref wszPropValue as wstring _
+ ) as LRESULT
+
+ ' If the colors popup already exists then no need to recreate it.
+ If IsWindow(HWND_FRMVDCOLORS) Then
+ frmVDColors_SetColorListBoxSelection(wszPropValue)
+ exit function
+ END IF
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ HWND_FRMVDCOLORS = _
+ pWindow->Create( hWndParent, "", @frmVDColors_WndProc, 0, 0, 200, 240, _
+ WS_POPUP or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN or WS_BORDER, 0)
+
+ Dim As HWnd hTabCtl = _
+ pWindow->AddControl("TAB", , IDC_FRMVDCOLORS_TABCONTROL, "", 0, 0, 0, 0)
+ TabCtrl_AddTab(hTabCtl, 0, "Custom")
+ TabCtrl_AddTab(hTabCtl, 0, "Colors")
+ TabCtrl_AddTab(hTabCtl, 0, "System")
+
+ Dim As HWnd hListCustom = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMVDCOLORS_LSTCUSTOM, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or LBS_NOINTEGRALHEIGHT Or WS_VSCROLL or _
+ LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS Or LBS_NOTIFY, WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR)
+
+ Dim As HWnd hListColors = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMVDCOLORS_LSTCOLORS, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or LBS_NOINTEGRALHEIGHT Or WS_VSCROLL or _
+ LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS or LBS_NOTIFY, WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR)
+
+ Dim As HWnd hListSystem = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMVDCOLORS_LSTSYSTEM, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or LBS_NOINTEGRALHEIGHT Or WS_VSCROLL or _
+ LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS or LBS_NOTIFY, WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR)
+
+ dim as long idx
+
+ ' CUSTOM COLOR
+ idx = ListBox_AddString(hListCustom, @WSTR("Custom Color"))
+ ListBox_SetItemData(hListCustom, idx, -1) ' special value to signify custom color
+
+ ' Add the Colors to the listboxes
+ for i as long = lbound(gColors) to ubound(gColors)
+ select case gColors(i).ColorType
+ CASE COLOR_COLORS
+ idx = ListBox_AddString(hListColors, gColors(i).wszColorName.sptr)
+ ListBox_SetItemData(hListColors, idx, i) ' store the array index
+ CASE COLOR_SYSTEM
+ idx = ListBox_AddString(hListSystem, gColors(i).wszColorName.sptr)
+ ListBox_SetItemData(hListSystem, idx, i) ' store the array index
+ END SELECT
+ NEXT
+
+ frmVDColors_PositionWindows
+ frmVDColors_SetColorListBoxSelection(wszPropValue)
+
+ Function = 0
+End Function
+
+
diff --git a/src/modVDControls.bi b/src/modVDControls.bi
index 3a51d1cf..7250a2ef 100644
--- a/src/modVDControls.bi
+++ b/src/modVDControls.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDControls.bi.bak b/src/modVDControls.bi.bak
new file mode 100644
index 00000000..3a51d1cf
--- /dev/null
+++ b/src/modVDControls.bi.bak
@@ -0,0 +1,34 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_LBLFAKEMAINMENU 1000
+#Define IDC_LBLSNAPLINE 1001
+#Define IDC_FAKESTATUSBAR 1002
+#Define IDC_FAKEREBAR 1003
+#Define IDC_FAKETOOLBAR 1004
+
+declare function KeyboardMoveControls( byval pDoc as clsDocument ptr, byval vKeycode as long ) as Long
+declare function KeyboardResizeControls( byval pDoc as clsDocument ptr, byval vKeycode as long ) as Long
+declare function KeyboardCycleActiveControls( byval pDoc as clsDocument ptr, byval vKeycode as long ) as Long
+declare function IsControlNameExists( byval pDoc as clsDocument ptr, byref wszControlName as wstring ) as boolean
+Declare Function IsControlLocked( byval pDoc as clsDocument ptr, byval pCtrl as clsControl ptr ) as boolean
+Declare Function IsFormNameExists( byref wszFormName as wstring ) as boolean
+declare function CreateToolboxControl( byval pDoc as clsDocument ptr, byval ControlType as long, byref rcDraw as RECT ) as clsControl ptr
+declare function ReCreateToolboxControl( byval pDoc as clsDocument ptr, byval pCtrl as clsControl ptr ) as long
+
+
+
+
+
diff --git a/src/modVDControls.inc b/src/modVDControls.inc
index bcadac1f..8d93559e 100644
--- a/src/modVDControls.inc
+++ b/src/modVDControls.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDControls.inc.bak b/src/modVDControls.inc.bak
new file mode 100644
index 00000000..bcadac1f
--- /dev/null
+++ b/src/modVDControls.inc.bak
@@ -0,0 +1,1493 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modVDControls.bi"
+#include once "modVDDesignForm.bi"
+#include once "frmMenuEditor.bi"
+#include once "frmStatusBarEditor.bi"
+#include once "frmToolBarEditor.bi"
+
+
+' ========================================================================================
+' Add a property to the incoming control and optionally a value
+' ========================================================================================
+function AddControlProperty( _
+ byval pCtrl as clsControl ptr, _
+ byref wszPropName as CWSTR, _
+ byref wszPropValue as CWSTR, _
+ byval nPropType as PropertyType _
+ ) as Long
+ dim as long ub = ubound(pCtrl->Properties) + 1
+ redim preserve pCtrl->Properties(ub) as clsProperty
+ pCtrl->Properties(ub).wszPropName = wszPropName
+ pCtrl->Properties(ub).wszPropValue = wszPropValue
+ pCtrl->Properties(ub).wszPropDefault = wszPropValue
+ pCtrl->Properties(ub).PropType = nPropType
+ function = 0
+end function
+
+
+' ========================================================================================
+' Attach default properties for the incoming control
+' ========================================================================================
+function AttachDefaultControlProperties( byval pCtrl as clsControl ptr ) as Long
+
+ ' Only add default properties if the no properties already exist for the control
+ if ubound(pCtrl->Properties) - lbound(pCtrl->Properties) + 1 > 0 then exit function
+
+ ' Add the default same generic proprties that apply to all controls
+ AddControlProperty(pCtrl, "Name", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Left", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "Top", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "Width", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "Height", "0", PropertyType.EditEnterNumericOnly)
+
+ ' Add control specific properties
+ select CASE pCtrl->ControlType
+ case CTRL_FORM
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "ChildForm", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ChildFormParent", "", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "WindowState", "FormWindowState.Normal", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "StartPosition", "FormStartPosition.Manual", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "BorderStyle", "FormBorderStyle.Sizable", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "MinimizeBox", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "MaximizeBox", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ControlBox", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "AcceptButton", "", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "KeyPreview", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "CancelButton", "", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "Icon", "", PropertyType.ImagePicker)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "MaximumHeight", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "MaximumWidth", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "MinimumHeight", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "MinimumWidth", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+
+ case CTRL_LABEL
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BackColorHot", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "ForeColor", "SYSTEM|ControlText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "ForeColorHot", "SYSTEM|ControlText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BorderStyle", "ControlBorderStyle.None", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "TextAlign", "LabelAlignment.TopLeft", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "UseMnemonic", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_BUTTON
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "AllowFocusRect", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BackColorDown", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BackColorHot", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "MultiLine", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TextForeColor", "SYSTEM|ControlText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "TextForeColorHot", "SYSTEM|ControlText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "TextBackColor", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "TextForeColorDown", "SYSTEM|ControlText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "TextBackColorDown", "SYSTEM|Control", PropertyType.ColorPicker)
+ ' The properties are automatically sorted when they are displayed, however we
+ ' need to order them here correctly because with ApplyProperties is called we want
+ ' to ensure that the properties are acted on in a specific order. The width and height
+ ' need to be set before scaling is called.
+ AddControlProperty(pCtrl, "Image", "", PropertyType.ImagePicker)
+ AddControlProperty(pCtrl, "ImageAlign", "ImageAlignment.TopLeft", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "ImageWidth", "16", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "ImageHeight", "16", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "ImageMargin", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "ImageHighDPI", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "TextAlign", "ButtonAlignment.MiddleCenter", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "TextMargin", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "UseMnemonic", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ThemeSupport", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ToggleMode", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_TEXTBOX, CTRL_RICHEDIT
+ AddControlProperty(pCtrl, "AcceptsReturn", iif(pCtrl->ControlType=CTRL_TEXTBOX,"False","True"), PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "AcceptsTab", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BorderStyle", "ControlBorderStyle.Fixed3D", PropertyType.ComboPicker)
+ if pCtrl->ControlType = CTRL_TEXTBOX then
+ AddControlProperty(pCtrl, "CharacterCasing", "CharacterCase.Normal", PropertyType.ComboPicker)
+ end if
+ if pCtrl->ControlType = CTRL_TEXTBOX then
+ AddControlProperty(pCtrl, "CueBannerText", "", PropertyType.EditEnter)
+ end if
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "ForeColor", "SYSTEM|WindowText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "HideSelection", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ if pCtrl->ControlType = CTRL_TEXTBOX then
+ AddControlProperty(pCtrl, "MaxLength", "32767", PropertyType.EditEnterNumericOnly)
+ else
+ AddControlProperty(pCtrl, "MaxLength", "64000", PropertyType.EditEnterNumericOnly)
+ end if
+ AddControlProperty(pCtrl, "Multiline", iif(pCtrl->ControlType=CTRL_TEXTBOX,"False","True"), PropertyType.TrueFalse)
+ if pCtrl->ControlType = CTRL_TEXTBOX then
+ AddControlProperty(pCtrl, "PasswordChar", "", PropertyType.EditEnter)
+ end if
+ AddControlProperty(pCtrl, "ReadOnly", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TextScrollBars", "ScrollBars.None", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "TextAlign", "TextAlignment.Left", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "WordWrap", iif(pCtrl->ControlType=CTRL_TEXTBOX,"False","True"), PropertyType.TrueFalse)
+
+ case CTRL_MASKEDEDIT
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BorderStyle", "ControlBorderStyle.Fixed3D", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "DefaultCharacter", "_", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "ForeColor", "SYSTEM|WindowText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "HideSelection", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "InputString", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "MaskString", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ReadOnly", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ValidCharacters", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_CHECKBOX
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "CheckState", "CheckBoxState.Unchecked", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "TextAlign", "ButtonAlignment.MiddleLeft", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "ThreeState", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "UseMnemonic", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_LISTBOX
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BackColorHot", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BackColorSelected", "SYSTEM|Highlight", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BorderStyle", "ControlBorderStyle.Fixed3D", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "ColumnWidth", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "ForeColor", "SYSTEM|WindowText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "ForeColorHot", "SYSTEM|WindowText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "ForeColorSelected", "SYSTEM|HighlightText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "HorizontalExtent", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "IntegralHeight", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ItemHeight", "28", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "MultiColumn", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ScrollAlwaysVisible", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "SelectionMode", "ListSelectionMode.One", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "Sorted", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TextAlign", "LabelAlignment.MiddleLeft", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "UseTabStops", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_COMBOBOX
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "DropDownStyle", "ComboBoxStyle.DropDownList", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "IntegralHeight", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Sorted", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_OPTION
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "Checked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "GroupName", "OptionGroup1", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "StartGroup", "StartGroup", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "TextAlign", "ButtonAlignment.MiddleLeft", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "UseMnemonic", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_FRAME
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "UseMnemonic", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_PICTUREBOX
+ AddControlProperty(pCtrl, "Text", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BackColorHot", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+ ' The properties are automatically sorted when they are displayed, however we
+ ' need to order them here correctly because with ApplyProperties is called we want
+ ' to ensure that the properties are acted on in a specific order.
+ AddControlProperty(pCtrl, "Image", "", PropertyType.ImagePicker)
+ AddControlProperty(pCtrl, "ImageWidth", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "ImageHeight", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "ImageScaling", "ImageScale.AutoSize", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+
+ case CTRL_PROGRESSBAR
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "Maximum", "100", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Minimum", "0", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "StepValue", "1", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Value", "0", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Marquee", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "MarqueeAnimationSpeed", "30", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Vertical", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_LISTVIEW
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BorderStyle", "ControlBorderStyle.Fixed3D", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "CheckBoxes", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "ForeColor", "SYSTEM|WindowText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "FullRowSelect", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "GridLines", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "HeaderThemed", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "HeaderStyle", "ColumnHeaderStyle.Clickable", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "HeaderHeight", "20", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "HeaderForeColor", "SYSTEM|WindowText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "HeaderBackColor", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "HideSelection", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "MultiSelect", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "OddRowColor", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "OddRowColorEnabled", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_TREEVIEW
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Window", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "BorderStyle", "ControlBorderStyle.Fixed3D", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "CheckBoxes", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "FadeButtons", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "ForeColor", "SYSTEM|WindowText", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "FullRowSelect", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "HideSelection", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "HotTracking", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ItemHeight", "20", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Scrollable", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ShowLines", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ShowRootLines", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ShowPlusMinus", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Sorted", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_MONTHCALENDAR
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "BackColor", "SYSTEM|Control", PropertyType.ColorPicker)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ShortDayNames", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TodayCircle", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "SelectedDate", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "TodaySelector", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TrailingDates", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "WeekNumbers", "False", PropertyType.TrueFalse)
+
+ case CTRL_DATETIMEPICKER
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "CalendarRightAlign", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "DateFormat", "DateTimePickerFormat.ShortDateCentury", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "FormatCustom", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "SelectedDate", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "SelectedTime", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ShowUpDown", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_TABCONTROL
+ AddControlProperty(pCtrl, "(Custom)", "", PropertyType.CustomDialog)
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "AllowFocus", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "ResizeTabPages", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ButtonStyle", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "FixedWidthTabs", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ForceImageLeft", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "ForceLabelLeft", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "HotTracking", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabTopPadding", "4", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabSidePadding", "4", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "MultiLine", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabImageSize", "ControlImageSize.Size16", PropertyType.ComboPicker)
+ AddControlProperty(pCtrl, "TabHeight", "24", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabWidth", "100", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_UPDOWN
+ AddControlProperty(pCtrl, "AllowDrop", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Anchor", "", PropertyType.AnchorPicker)
+ AddControlProperty(pCtrl, "Enabled", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Font", CreateDefaultFontPropValue, PropertyType.FontPicker)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "TabIndex", "0", PropertyType.EditEnterNumericOnly)
+ AddControlProperty(pCtrl, "TabStop", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTip", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "ToolTipBalloon", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Visible", "True", PropertyType.TrueFalse)
+
+ case CTRL_TIMER
+ AddControlProperty(pCtrl, "AutoReset", "True", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Enabled", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Locked", "False", PropertyType.TrueFalse)
+ AddControlProperty(pCtrl, "Tag", "", PropertyType.EditEnter)
+ AddControlProperty(pCtrl, "Interval", "1000", PropertyType.EditEnterNumericOnly)
+
+ case CTRL_HSCROLL
+ case CTRL_VSCROLL
+ case CTRL_SLIDER
+ case CTRL_WEBBROWSER
+ case CTRL_CUSTOM
+ case CTRL_OCX
+ END SELECT
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Attach default events for the incoming control
+' ========================================================================================
+private function AttachDefaultControlEvents( byval pCtrl as clsControl ptr ) as Long
+
+ ' Only add default events if the no events already exist for the control
+ if ubound(pCtrl->Events) - lbound(pCtrl->Events) + 1 > 0 then exit function
+
+ ' Add the default AllEvents event that applies to all controls
+ AddControlEvent(pCtrl, "AllEvents")
+
+ ' Add control specific properties
+ select CASE pCtrl->ControlType
+ case CTRL_FORM
+ AddControlEvent(pCtrl, "Load")
+ AddControlEvent(pCtrl, "Initialize")
+ AddControlEvent(pCtrl, "Shown")
+ AddControlEvent(pCtrl, "Activated")
+ AddControlEvent(pCtrl, "Deactivate")
+ AddControlEvent(pCtrl, "Resize")
+ AddControlEvent(pCtrl, "FormClosing")
+ AddControlEvent(pCtrl, "FormClosed")
+ AddControlEvent(pCtrl, "FormReady")
+ AddControlEvent(pCtrl, "Move")
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+ AddControlEvent(pCtrl, "MessagePumpHook")
+
+ case CTRL_LABEL
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+
+ case CTRL_BUTTON
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+
+ case CTRL_TEXTBOX, CTRL_RICHEDIT
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "TextChanged")
+ if pCtrl->ControlType = CTRL_RICHEDIT then
+ AddControlEvent(pCtrl, "SelectionChanged")
+ end if
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+
+ case CTRL_MASKEDEDIT
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "TextChanged")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+
+ case CTRL_CHECKBOX, CTRL_UPDOWN
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+
+ case CTRL_LISTBOX
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+
+ case CTRL_OPTION
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+
+ case CTRL_FRAME
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+
+ case CTRL_COMBOBOX
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "DropDown")
+ AddControlEvent(pCtrl, "DropDownClosed")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+ AddControlEvent(pCtrl, "TextChanged")
+
+ case CTRL_PICTUREBOX
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+
+ case CTRL_PROGRESSBAR
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+
+ case CTRL_LISTVIEW
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "DoubleClick")
+ AddControlEvent(pCtrl, "RightClick")
+ AddControlEvent(pCtrl, "ColumnClick")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "ItemSelectionChanged")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ ' Do not add a MouseHover event for the ListView as it
+ ' seems to invoke hot tracking and automatic row selection.
+ 'AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+
+ case CTRL_TREEVIEW
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "BeforeSelect")
+ AddControlEvent(pCtrl, "AfterSelect")
+ AddControlEvent(pCtrl, "BeforeCollapse")
+ AddControlEvent(pCtrl, "AfterCollapse")
+ AddControlEvent(pCtrl, "BeforeExpand")
+ AddControlEvent(pCtrl, "AfterExpand")
+ AddControlEvent(pCtrl, "BeforeCheck")
+ AddControlEvent(pCtrl, "AfterCheck")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+
+ case CTRL_MONTHCALENDAR
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+ AddControlEvent(pCtrl, "SelectionChanged")
+
+ case CTRL_DATETIMEPICKER
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "DateTimeChanged")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+
+ case CTRL_TABCONTROL
+ AddControlEvent(pCtrl, "Click")
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "DropFiles")
+ AddControlEvent(pCtrl, "GotFocus")
+ AddControlEvent(pCtrl, "LostFocus")
+ AddControlEvent(pCtrl, "MouseMove")
+ AddControlEvent(pCtrl, "MouseDown")
+ AddControlEvent(pCtrl, "MouseUp")
+ AddControlEvent(pCtrl, "MouseDoubleClick")
+ AddControlEvent(pCtrl, "MouseEnter")
+ AddControlEvent(pCtrl, "MouseHover")
+ AddControlEvent(pCtrl, "MouseLeave")
+ AddControlEvent(pCtrl, "KeyDown")
+ AddControlEvent(pCtrl, "KeyPress")
+ AddControlEvent(pCtrl, "KeyUp")
+ AddControlEvent(pCtrl, "Selected")
+ AddControlEvent(pCtrl, "Selecting")
+
+ case CTRL_TIMER
+ AddControlEvent(pCtrl, "Destroy")
+ AddControlEvent(pCtrl, "Elapsed")
+
+
+ case CTRL_HSCROLL
+ case CTRL_VSCROLL
+ case CTRL_SLIDER
+ case CTRL_WEBBROWSER
+ case CTRL_CUSTOM
+ case CTRL_OCX
+ END SELECT
+
+ function = 0
+end function
+
+' ========================================================================================
+' Respond to keyboard input and move selected controls by 1 pixel
+' ========================================================================================
+public function KeyboardMoveControls( byval pDoc as clsDocument ptr, _
+ byval vKeycode as long _
+ ) as Long
+
+ dim pCtrl as clsControl ptr
+ dim as long nTemp
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType <> CTRL_FORM THEN
+ if pCtrl->IsSelected then
+ select CASE vKeycode
+ case VK_UP
+ nTemp = val(GetControlProperty(pCtrl, "TOP")) - 1
+ SetControlProperty(pCtrl, "TOP", str(nTemp))
+ pDoc->UserModified = true
+ case VK_DOWN
+ nTemp = val(GetControlProperty(pCtrl, "TOP")) + 1
+ SetControlProperty(pCtrl, "TOP", str(nTemp))
+ pDoc->UserModified = true
+ case VK_LEFT
+ nTemp = val(GetControlProperty(pCtrl, "LEFT")) - 1
+ SetControlProperty(pCtrl, "LEFT", str(nTemp))
+ pDoc->UserModified = true
+ case VK_RIGHT
+ nTemp = val(GetControlProperty(pCtrl, "LEFT")) + 1
+ SetControlProperty(pCtrl, "LEFT", str(nTemp))
+ pDoc->UserModified = true
+ END SELECT
+ pCtrl->SuspendLayout = true
+ ApplyControlProperties( pDoc, pCtrl )
+ pCtrl->SuspendLayout = false
+ end if
+ end if
+ next
+
+ AfxRedrawWindow(pDoc->hWndForm)
+ frmMain_SetStatusbar
+ DisplayPropertyList(pDoc)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Respond to keyboard input and resize selected controls by 1 pixel
+' ========================================================================================
+public function KeyboardResizeControls( byval pDoc as clsDocument ptr, _
+ byval vKeycode as long _
+ ) as Long
+
+ dim pCtrl as clsControl ptr
+ dim as long nTemp
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType <> CTRL_FORM THEN
+ if pCtrl->IsSelected then
+ select CASE vKeycode
+ case VK_UP
+ nTemp = val(GetControlProperty(pCtrl, "HEIGHT")) - 1
+ SetControlProperty(pCtrl, "HEIGHT", str(nTemp))
+ pDoc->UserModified = true
+ case VK_DOWN
+ nTemp = val(GetControlProperty(pCtrl, "HEIGHT")) + 1
+ SetControlProperty(pCtrl, "HEIGHT", str(nTemp))
+ pDoc->UserModified = true
+ case VK_LEFT
+ nTemp = val(GetControlProperty(pCtrl, "WIDTH")) - 1
+ SetControlProperty(pCtrl, "WIDTH", str(nTemp))
+ pDoc->UserModified = true
+ case VK_RIGHT
+ nTemp = val(GetControlProperty(pCtrl, "WIDTH")) + 1
+ SetControlProperty(pCtrl, "WIDTH", str(nTemp))
+ pDoc->UserModified = true
+ END SELECT
+ pCtrl->SuspendLayout = true
+ ApplyControlProperties( pDoc, pCtrl )
+ pCtrl->SuspendLayout = false
+ end if
+ end if
+ next
+
+ AfxRedrawWindow(pDoc->hWndForm)
+ frmMain_SetStatusbar
+ DisplayPropertyList(pDoc)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Respond to keyboard input to cycle amongst the selected controls in the group.
+' ========================================================================================
+public function KeyboardCycleActiveControls( byval pDoc as clsDocument ptr, _
+ byval vKeycode as long _
+ ) as Long
+
+ dim pCtrl as clsControl ptr
+ dim as long idxActive
+ dim as long idxPrev = -1
+ dim as long idxNext = -1
+ dim as Boolean bSelectedGroup = iif( pDoc->Controls.SelectedControlsCount > 1, true, false)
+
+ ' Get the current active control in the group
+ dim pCtrlActive as clsControl ptr = pDoc->Controls.GetActiveControl
+
+ ' Determine the array position that the active control is at.
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ if pDoc->Controls.ItemAt(i) = pCtrlActive then
+ idxActive = i: exit for
+ end if
+ next
+
+ ' The following will cycle amongst controls in a selected group. If there is
+ ' no selected group then the focus will simply shift to the next/prev control.
+ select CASE vKeycode
+ case VK_UP, VK_LEFT ' get the previous control in the group
+ for i as long = (idxActive - 1) to pDoc->Controls.ItemFirst step -1
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType = CTRL_FORM THEN continue for
+ if bSelectedGroup then
+ if pCtrl->IsSelected then
+ idxPrev = i: exit for
+ end if
+ else
+ idxPrev = i: exit for
+ end if
+ next
+ if idxPrev = -1 THEN ' prev still not found. wrap to end of array
+ for i as long = pDoc->Controls.ItemLast to idxActive step -1
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType = CTRL_FORM THEN continue for
+ if bSelectedGroup then
+ if pCtrl->IsSelected then
+ idxPrev = i: exit for
+ end if
+ else
+ idxPrev = i: exit for
+ end if
+ next
+ end if
+ if idxPrev <> -1 then
+ if bSelectedGroup = false THEN pDoc->Controls.DeselectAllControls
+ pCtrl = pDoc->Controls.ItemAt(idxPrev)
+ pDoc->Controls.SetActiveControl(pCtrl->hWindow)
+ end if
+
+ case VK_DOWN, VK_RIGHT ' get the next control in the gorup
+ for i as long = (idxActive + 1) to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType = CTRL_FORM THEN continue for
+ if bSelectedGroup then
+ if pCtrl->IsSelected then
+ idxNext = i: exit for
+ end if
+ else
+ idxNext = i: exit for
+ end if
+ next
+ if idxNext = -1 THEN ' next still not found. wrap to start of array
+ for i as long = pDoc->Controls.ItemFirst to idxActive
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType = CTRL_FORM THEN continue for
+ if bSelectedGroup then
+ if pCtrl->IsSelected then
+ idxNext = i: exit for
+ end if
+ else
+ idxNext = i: exit for
+ end if
+ next
+ end if
+ if idxNext <> -1 then
+ if bSelectedGroup = false THEN pDoc->Controls.DeselectAllControls
+ pCtrl = pDoc->Controls.ItemAt(idxNext)
+ pDoc->Controls.SetActiveControl(pCtrl->hWindow)
+ END IF
+
+ end select
+
+ AfxRedrawWindow(pDoc->hWndForm)
+ frmMain_SetStatusbar
+ DisplayPropertyList(pDoc)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Determine if the specified control name already exists on the incoming form.
+' ========================================================================================
+public function IsControlNameExists( byval pDoc as clsDocument ptr, _
+ byref wszControlName as wstring _
+ ) as boolean
+ dim pCtrl as clsControl ptr
+ for ii as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(ii)
+ if pCtrl->ControlType <> CTRL_FORM THEN
+ if ucase(GetControlProperty(pCtrl, "NAME")) = ucase(wszControlName) THEN
+ return true
+ END IF
+ END IF
+ NEXT
+ return false
+end function
+
+
+' ========================================================================================
+' Determines if the control is locked or full form is locked
+' ========================================================================================
+public function IsControlLocked( byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr _
+ ) as boolean
+ if pDoc->bLockControls then return true
+ if GetControlProperty(pCtrl, "LOCKED") = "True" then return true
+ return false
+end function
+
+
+' ========================================================================================
+' Determine if the specified form name already exists.
+' ========================================================================================
+public function IsFormNameExists( byref wszFormName as wstring ) as boolean
+
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ dim pCtrl as clsControl ptr
+ dim as Boolean bExists = false
+
+ do until pDoc = 0
+ for ii as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(ii)
+ if pCtrl->ControlType = CTRL_FORM THEN
+ if ucase(GetControlProperty(pCtrl, "NAME")) = ucase(wszFormName) THEN
+ bExists = true
+ END IF
+ exit for
+ END IF
+ NEXT
+ if bExists THEN exit do
+ pDoc = pDoc->pDocNext
+ loop
+
+ return bExists
+end function
+
+
+' ========================================================================================
+' Generate a default name for the new form
+' ========================================================================================
+private function GenerateDefaultFormName() as CWSTR
+
+ ' Generate a default name for the form, then iterate the document collection
+ ' to see if it already exists.
+ dim as long NextFormNumber = 0
+ dim as CWSTR wszDefaultName
+
+ do
+ NextFormNumber = NextFormNumber + 1
+ wszDefaultName = "Form" & NextFormNumber
+ if IsFormNameExists(wszDefaultName) = false then exit do
+ loop
+
+ return wszDefaultName
+end function
+
+
+' ========================================================================================
+' Generate a default name for the new control
+' ========================================================================================
+private function GenerateDefaultControlName( byval pDoc as clsDocument ptr, _
+ byval nControlType as long _
+ ) as CWSTR
+
+ ' Generate a default name for the control, then iterate the control collection
+ ' to see if it already exists.
+ dim as long NextControlNumber = 0
+ dim as CWSTR wszDefaultName
+ dim as CWSTR wszName
+ dim as Boolean bOK
+ dim pCtrl as clsControl ptr
+
+ wszName = GetControlName(nControlType)
+
+ do
+ NextControlNumber = NextControlNumber + 1
+ wszDefaultName = wszName & NextControlNumber
+ bOK = true
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if ucase(GetControlProperty(pCtrl, "NAME")) = ucase(wszDefaultName) THEN
+ bOK = false: exit for
+ END IF
+ NEXT
+ loop until bOK = true
+
+ return wszDefaultName
+end function
+
+
+' ========================================================================================
+' Generate a default TabIndex value for the new control
+' ========================================================================================
+private function GenerateDefaultTabIndex( byval pDoc as clsDocument ptr ) as CWSTR
+
+ dim as long HighTabIndex = -1
+ dim as long nPropValue
+ dim pCtrl as clsControl ptr
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ nPropValue = val(GetControlProperty(pCtrl, "TABINDEX"))
+ if nPropValue > HighTabIndex then HighTabIndex = nPropValue
+ NEXT
+
+ return wstr(HighTabIndex+1)
+end function
+
+
+' ========================================================================================
+' Re-Create the specified control on the design form
+' ========================================================================================
+public function ReCreateToolboxControl( byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr _
+ ) as long
+
+ ' Some controls need to be destroyed and re-created in order for certan properties
+ ' to be properly displayed in the visual designer.
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+ dim pProp as clsProperty ptr
+
+ dim as RECT rc
+ dim as DWORD dwStyle, dwExStyle
+ dim wszCustomFormat as wstring * MAX_PATH = ""
+ dim as CWSTR wszPropValue
+ dim as long CtrlID = GetDlgCtrlID(pCtrl->hWindow)
+
+ GetWindowRect( pCtrl->hWindow, @rc )
+ MapWindowPoints( HWND_DESKTOP, pWindow->hWindow, CAST(POINT PTR, @rc), 2)
+
+ select case pCtrl->ControlType
+
+ case CTRL_TABCONTROL
+ if pCtrl->hImageList then ImageList_Destroy(pCtrl->hImageList)
+ DestroyWindow( pCtrl->hWindow )
+
+ dwStyle = WS_VISIBLE
+ if GetControlProperty(pCtrl, "BUTTONSTYLE") = "True" then
+ dwStyle = dwStyle or TCS_BUTTONS or TCS_FLATBUTTONS
+ else
+ dwStyle = dwStyle or TCS_TABS
+ end if
+
+ if GetControlProperty(pCtrl, "FIXEDWIDTHTABS") = "True" then
+ dwStyle = dwStyle or TCS_FIXEDWIDTH
+ else
+ dwStyle = dwStyle or TCS_RAGGEDRIGHT
+ end if
+
+ if GetControlProperty(pCtrl, "MULTILINE") = "True" then
+ dwStyle = dwStyle or TCS_MULTILINE
+ end if
+
+ if GetControlProperty(pCtrl, "FORCELABELLEFT") = "True" then
+ ' This will force the label and icon left
+ dwStyle = dwStyle or TCS_FORCELABELLEFT
+ else
+ if GetControlProperty(pCtrl, "FORCEIMAGELEFT") = "True" then
+ dwStyle = dwStyle or TCS_FORCEICONLEFT
+ end if
+ end if
+
+ pCtrl->hWindow = pWindow->AddControl( "TabControl", , CtrlID, "", _
+ pWindow->UnScaleX(rc.left), pWindow->UnScaleY(rc.top), _
+ pWindow->UnScaleX(rc.right-rc.left), pWindow->UnScaleY(rc.bottom-rc.top), _
+ dwStyle, dwExStyle, , _
+ CAST(SUBCLASSPROC, @Control_SubclassProc), CTRL_TABCONTROL, CAST(DWORD_PTR, pDoc))
+
+ wszPropValue = GetControlProperty(pCtrl, "(CUSTOM)")
+ frmVDTabChild_LoadTabPagesArray( wszPropValue )
+
+ dim as boolean bHasImages
+ for i as long = 0 to ubound(gTabPages)
+ dim as long nIndex = TabCtrl_AddTab( pCtrl->hWindow, 0, gTabPages(i).wszText, 0 )
+ if gTabPages(i).IsActiveTab then
+ TabCtrl_SetCurSel( pCtrl->hWindow, nIndex )
+ end if
+ if len(gTabPages(i).wszImage) then bHasImages = true
+ next
+
+ if bHasImages then
+ dim as long nImageSize = 16
+ wszPropValue = GetControlProperty(pCtrl, "TABIMAGESIZE")
+ select case wszPropValue
+ case "ControlImageSize.Size16": nImageSize = 16
+ case "ControlImageSize.Size24": nImageSize = 24
+ case "ControlImageSize.Size32": nImageSize = 32
+ case "ControlImageSize.Size48": nImageSize = 48
+ end select
+
+ dim as long cx = nImageSize * (pWindow->DPI \ 96)
+ pCtrl->hImageList = ImageList_Create(cx, cx, ILC_MASK Or ILC_COLOR32, 1, 0)
+ TabCtrl_SetImageList( pCtrl->hWindow, pCtrl->hImageList )
+
+ Dim As HICON hIcon
+ dim as long nIndex
+ for i as long = 0 to ubound(gTabPages)
+ TabCtrl_SetImageIndex( pCtrl->hWindow, i, -1 )
+ if len(rtrim(gTabPages(i).wszImage)) then
+ dim pImageType as IMAGES_TYPE ptr = GetImagesTypePtr(gTabPages(i).wszImage)
+ if pImageType then
+ hIcon = AfxGdipIconFromFile( pImageType->wszFileName )
+ nIndex = ImageList_AddIcon( pCtrl->hImageList, hIcon )
+ TabCtrl_SetImageIndex( pCtrl->hWindow, i, nIndex )
+ end if
+ end if
+ next
+ end if
+
+ if GetControlProperty(pCtrl, "FIXEDWIDTHTABS") = "True" then
+ dim as long nWidth = AfxScaleX(val(GetControlProperty(pCtrl, "TABWIDTH")))
+ dim as long nHeight = AfxScaleY(val(GetControlProperty(pCtrl, "TABHEIGHT")))
+ if (nWidth * nHeight) <> 0 then ' neither can be zero
+ TabCtrl_SetItemSize( pCtrl->hWindow, nWidth, nHeight )
+ end if
+ end if
+
+ ' Set the horizontal and vertical padding
+ dim as long nHorizPadding = AfxScaleX(val(GetControlProperty(pCtrl, "TABSIDEPADDING")))
+ dim as long nVertPadding = AfxScaleY(val(GetControlProperty(pCtrl, "TABTOPPADDING")))
+ TabCtrl_SetPadding( pCtrl->hWindow, nHorizPadding, nVertPadding )
+
+ ' Reset the gTabPages array
+ erase gTabPages
+
+
+ case CTRL_DATETIMEPICKER
+ DestroyWindow( pCtrl->hWindow )
+
+ dwStyle = WS_VISIBLE
+ if GetControlProperty(pCtrl, "SHOWUPDOWN") = "True" then
+ dwStyle = dwStyle Or DTS_UPDOWN
+ end if
+
+ select case GetControlProperty(pCtrl, "DATEFORMAT")
+ case "DateTimePickerFormat.LongDate"
+ dwStyle = dwStyle Or DTS_LONGDATEFORMAT
+ case "DateTimePickerFormat.ShortDate"
+ dwStyle = dwStyle Or DTS_SHORTDATEFORMAT
+ case "DateTimePickerFormat.ShortDateCentury"
+ dwStyle = dwStyle Or DTS_SHORTDATECENTURYFORMAT
+ case "DateTimePickerFormat.TimeFormat"
+ dwStyle = dwStyle Or DTS_TIMEFORMAT
+ case "DateTimePickerFormat.CustomFormat"
+ ' Set value after control is created
+ wszCustomFormat = GetControlProperty(pCtrl, "FORMATCUSTOM")
+ end select
+
+ pCtrl->hWindow = pWindow->AddControl( "SysDateTimePick32", , CtrlID, "", _
+ pWindow->UnScaleX(rc.left), pWindow->UnScaleY(rc.top), _
+ pWindow->UnScaleX(rc.right-rc.left), pWindow->UnScaleY(rc.bottom-rc.top), _
+ dwStyle, dwExStyle, , _
+ CAST(SUBCLASSPROC, @Control_SubclassProc), CTRL_DATETIMEPICKER, CAST(DWORD_PTR, pDoc))
+
+ DateTime_SetFormat( pCtrl->hWindow, @wszCustomFormat )
+
+ Dim As SYSTEMTIME pst
+ dim as CWSTR wszDate = GetControlProperty(pCtrl, "SELECTEDDATE")
+ pst.wYear = val(left(wszDate, 4))
+ pst.wMonth = val(mid(wszDate, 5, 2))
+ pst.wDay = val(right(wszDate, 2))
+ dim as CWSTR wszTime = GetControlProperty(pCtrl, "SELECTEDTIME")
+ pst.wHour = val(left(wszTime, 2))
+ pst.wSecond = val(mid(wszTime, 3, 2))
+ pst.wMinute = val(right(wszTime, 2))
+ DateTime_SetSystemTime( pCtrl->hWindow, GDT_VALID, @pst )
+
+ end select
+
+ ' Apply the correct font
+ pProp = GetControlPropertyPtr( pCtrl, "FONT" )
+ if pProp then
+ dim as HFONT hFontOld = AfxGetWindowFont(pCtrl->hWindow)
+ dim as LOGFONT lf
+ lf = SetLogFontFromPropValue(pProp->wszPropValue)
+ dim as HFONT hFont = CreateFontIndirect(@lf)
+ AfxSetWindowFont(pCtrl->hWindow, hFont, true)
+ DeleteFont(hFontOld)
+ end if
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Create the specified control on the design form
+' ========================================================================================
+public function CreateToolboxControl( byval pDoc as clsDocument ptr, _
+ byval ControlType as long, _
+ byref rcDraw as RECT _
+ ) as clsControl ptr
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+ dim pCtrl as clsControl ptr = new clsControl
+ dim as CWSTR wszDefaultControlName, wszDefaultGroupName
+
+ pDoc->Controls.DeselectAllControls
+ pCtrl->ControlType = ControlType
+ pCtrl->IsActive = false
+
+ ' Set default properties and events for the created control
+ AttachDefaultControlProperties(pCtrl)
+ AttachDefaultControlEvents(pCtrl)
+
+ if ControlType = CTRL_FORM THEN
+ dim pForm as CWindow ptr = New CWindow
+ pForm->DPI = AfxCWindowPtr(pDoc->hWndFrame)->DPI
+
+ wszDefaultControlName = GenerateDefaultFormName()
+ pDoc->hWndForm = _
+ pForm->Create( pDoc->hWndFrame, "Form1", @DesignerForm_WndProc, 0, 0, 0, 0, _
+ WS_CHILD or WS_OVERLAPPED Or WS_OVERLAPPEDWINDOW or WS_VISIBLE or _
+ WS_CLIPSIBLINGS or WS_CLIPCHILDREN, _
+ WS_EX_CONTROLPARENT OR WS_EX_WINDOWEDGE)
+ pForm->ClassStyle = CS_DBLCLKS
+ SetWindowLongPtr( pDoc->hWndForm, GWLP_ID, IDC_DESIGNFORM )
+ ' We will set our own mouse pointer as needed
+ SetClassLongPtr(pDoc->hWndForm, GCLP_HCURSOR, 0)
+ pCtrl->hWindow = pDoc->hWndForm
+
+ ' Fake topmenu
+ pDoc->hWndFakeMenu = _
+ pForm->AddControl("LABEL", pDoc->hWndForm, IDC_LBLFAKEMAINMENU, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT Or SS_NOTIFY, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ dim ncm As NONCLIENTMETRICS
+ ncm.cbSize = SizeOf(ncm)
+ SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(ncm), @ncm, 0)
+ pDoc->hFontFakeMenu = CreateFontIndirect(@ncm.lfMenuFont)
+ SendMessage( pDoc->hWndFakeMenu, WM_SETFONT, cast(WPARAM, pDoc->hFontFakeMenu), cast(LPARAM, CTRUE))
+
+ ' StatusBar
+ pDoc->hWndStatusBar = _
+ pForm->AddControl("STATUSBAR", pDoc->hWndForm, IDC_FAKESTATUSBAR, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPCHILDREN OR WS_CLIPSIBLINGS OR CCS_BOTTOM OR SBARS_TOOLTIPS, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ ' ToolBar
+ frmToolBarEditor_CreateFakeToolBar( pDoc )
+
+ ' Create the four SnapLines
+ for i as long = 0 to 3
+ pDoc->hSnapLine(i) = _
+ pForm->AddControl("LABEL", pDoc->hWndForm, IDC_LBLSNAPLINE, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, WS_EX_LEFT Or WS_EX_LTRREADING)
+ next
+
+
+ else
+ if pWindow = 0 THEN exit function
+ wszDefaultControlName = GenerateDefaultControlName(pDoc, ControlType)
+ select case ControlType
+ case CTRL_BUTTON
+ ' Use the custom control CXpButton instead of the standard Windows button control.
+ pCtrl->AfxButtonPtr = new CXpButton(pWindow, 100, wszDefaultControlName, _
+ rcDraw.left, rcDraw.top, rcDraw.right-rcDraw.left, rcDraw.bottom-rcDraw.top)
+ pCtrl->hWindow = pCtrl->AfxButtonPtr->hWindow
+ SetWindowSubclass(pCtrl->hWindow, CAST(SUBCLASSPROC, @Control_SubclassProc), ControlType, CAST(DWORD_PTR, pDoc))
+ case CTRL_MASKEDEDIT
+ pCtrl->AfxMaskedPtr = new CMaskedEdit(pWindow, 100, _
+ rcDraw.left, rcDraw.top, rcDraw.right-rcDraw.left, rcDraw.bottom-rcDraw.top)
+ pCtrl->hWindow = pCtrl->AfxMaskedPtr->hWindow
+ SetWindowSubclass(pCtrl->hWindow, CAST(SUBCLASSPROC, @Control_SubclassProc), ControlType, CAST(DWORD_PTR, pDoc))
+ case CTRL_PICTUREBOX
+ pCtrl->AfxPicturePtr = new CImageCtx(pWindow, 100, , _
+ rcDraw.left, rcDraw.top, rcDraw.right-rcDraw.left, rcDraw.bottom-rcDraw.top)
+ pCtrl->hWindow = pCtrl->AfxPicturePtr->hWindow
+ SetWindowSubclass(pCtrl->hWindow, CAST(SUBCLASSPROC, @Control_SubclassProc), ControlType, CAST(DWORD_PTR, pDoc))
+ case CTRL_TIMER
+ ' Readjust the rcDraw to be 16x16
+ rcDraw.right = rcDraw.left + 16 ' do not dpi scale number
+ rcDraw.bottom = rcDraw.top + 16 ' do not dpi scale number
+ pCtrl->AfxPicturePtr = new CImageCtx(pWindow, 100, , _
+ rcDraw.left, rcDraw.top, rcDraw.right-rcDraw.left, rcDraw.bottom-rcDraw.top)
+ pCtrl->hWindow = pCtrl->AfxPicturePtr->hWindow
+ SetWindowSubclass(pCtrl->hWindow, CAST(SUBCLASSPROC, @Control_SubclassProc), ControlType, CAST(DWORD_PTR, pDoc))
+ pCtrl->AfxPicturePtr->LoadImageFromResource( pWindow->InstanceHandle, "IMAGE_TIMERCONTROL" )
+ pCtrl->AfxPicturePtr->SetImageAdjustment( GDIP_IMAGECTX_STRETCH, true )
+ case else
+ dim as long dwExStyle = -1
+ dim as long dwStyle = -1
+ if ControlType = CTRL_LISTBOX then
+ ' WinFBX defaults to listbox with integralheight. We want to make sure that
+ ' our listboxes have NoIntegralHeight.
+ dwStyle = WS_CHILD or WS_VISIBLE OR WS_HSCROLL OR WS_VSCROLL OR WS_BORDER OR _
+ LBS_HASSTRINGS OR LBS_NOTIFY or LBS_NOINTEGRALHEIGHT
+ elseif ControlType = CTRL_LABEL then
+ dwStyle = WS_CHILD or WS_VISIBLE OR SS_LEFT OR WS_GROUP OR SS_NOTIFY or SS_OWNERDRAW
+ elseif ControlType = CTRL_COMBOBOX then
+ ' WinFBX defaults to combobox with integralheight. We want to make sure that
+ ' our comboboxes have NoIntegralHeight.
+ dwStyle = WS_CHILD or WS_VISIBLE OR WS_HSCROLL OR WS_VSCROLL OR WS_BORDER OR _
+ CBS_HASSTRINGS or CBS_NOINTEGRALHEIGHT or CBS_DROPDOWNLIST
+ ' Also subclass the combobox edit control
+ dim as HWND hWndEditCtrl = ComboBox_GetEditBoxHandle(pCtrl->hWindow)
+ if IsWindow(hWndEditCtrl) then
+ SetWindowSubclass(hWndEditCtrl, CAST(SUBCLASSPROC, @Control_SubclassProc), ControlType, CAST(DWORD_PTR, pDoc))
+ end if
+ dim as HWND hWndListCtrl = ComboBox_GetListBoxHandle(pCtrl->hWindow)
+ if IsWindow(hWndListCtrl) then
+ SetWindowSubclass(hWndListCtrl, CAST(SUBCLASSPROC, @Control_SubclassProc), CTRL_COMBOBOX, CAST(DWORD_PTR, pDoc))
+ end if
+ elseif ControlType = CTRL_FRAME then
+ dwStyle = WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or BS_GROUPBOX
+ dwExStyle = WS_EX_TRANSPARENT
+ elseif ControlType = CTRL_MONTHCALENDAR then
+ dwStyle = WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS or WS_CLIPCHILDREN
+ dwExStyle = 0
+ elseif ControlType = CTRL_TABCONTROL then
+ dwStyle = WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS or WS_CLIPCHILDREN OR _
+ TCS_TABS OR TCS_SINGLELINE OR TCS_RAGGEDRIGHT or TCS_FORCEICONLEFT
+ dwExStyle = WS_EX_CONTROLPARENT
+ end if
+
+ ' Create the control
+ pCtrl->hWindow = pWindow->AddControl( GetControlClassName(pCtrl), , 100, wszDefaultControlName, _
+ rcDraw.left, rcDraw.top, rcDraw.right-rcDraw.left, rcDraw.bottom-rcDraw.top, _
+ dwStyle, dwExStyle, , _
+ CAST(SUBCLASSPROC, @Control_SubclassProc), ControlType, CAST(DWORD_PTR, pDoc))
+
+ if pCtrl->ControlType = CTRL_TABCONTROL then
+ ReCreateToolboxControl( pDoc, pCtrl )
+ end if
+
+ end select
+ END IF
+
+ pDoc->Controls.Add(pCtrl)
+
+ SetControlProperty(pCtrl, "NAME", wszDefaultControlName)
+ SetControlProperty(pCtrl, "TEXT", wszDefaultControlName)
+ SetControlProperty(pCtrl, "LEFT", str(rcDraw.left))
+ SetControlProperty(pCtrl, "TOP", str(rcDraw.top))
+ SetControlProperty(pCtrl, "WIDTH", str(rcDraw.right-rcDraw.left))
+ SetControlProperty(pCtrl, "HEIGHT", str(rcDraw.bottom-rcDraw.top))
+
+ ' Need to create fake statusbar here in order to ensure that all of the
+ ' statusbar panels display correctly when the form is first shown.
+ frmStatusBarEditor_CreateFakeStatusBar(pDoc)
+
+ ' If this form/control is being created from reading an existing source file then
+ ' then we would wait until the all of the control's properties have been loaded.
+ ' See clsDocument.ParseDesignerString
+ if pDoc->LoadingFromFile = false then
+ ' By default, generate the next highest TabIndex value for this new control.
+ SetControlProperty(pCtrl, "TABINDEX", GenerateDefaultTabIndex(pDoc))
+ pCtrl->SuspendLayout = true
+ ApplyControlProperties( pDoc, pCtrl )
+ pCtrl->SuspendLayout = false
+ pDoc->bRegenerateCode = true
+ pDoc->Controls.SelectControl(pCtrl->hWindow)
+ pDoc->Controls.SetActiveControl(pCtrl->hWindow)
+ DisplayPropertyList(pDoc)
+ end if
+
+ function = pCtrl
+END FUNCTION
+
+
diff --git a/src/modVDDesignForm.bi b/src/modVDDesignForm.bi
index 96c6f8c3..f66b386f 100644
--- a/src/modVDDesignForm.bi
+++ b/src/modVDDesignForm.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDDesignForm.bi.bak b/src/modVDDesignForm.bi.bak
new file mode 100644
index 00000000..96c6f8c3
--- /dev/null
+++ b/src/modVDDesignForm.bi.bak
@@ -0,0 +1,69 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+' Grab handles (clockwise starting at top left corner)
+enum
+ GRAB_NOHIT = 0
+ GRAB_TOPLEFT
+ GRAB_TOP
+ GRAB_TOPRIGHT
+ GRAB_RIGHT
+ GRAB_BOTTOMRIGHT
+ GRAB_BOTTOM
+ GRAB_BOTTOMLEFT
+ GRAB_LEFT
+end enum
+
+enum SnapLinePosition
+ top = 0
+ bottom
+ left
+ right
+end enum
+
+
+declare function IsDesignerView( byval pDoc as clsDocument ptr ) as Boolean
+declare function DrawGrabHandles( byval hDC as HDC, byval pDoc as clsDocument ptr, byval bFormOnly as Boolean ) as long
+declare function HandleDesignerLButtonDown( ByVal HWnd As HWnd ) as LRESULT
+declare function HandleDesignerLButtonUp( ByVal HWnd As HWnd ) as LRESULT
+declare function HandleDesignerRButtonDown( ByVal HWnd As HWnd ) as LRESULT
+declare function HandleDesignerMouseMove( ByVal HWnd As HWnd ) as LRESULT
+declare Function DesignerForm_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+declare FUNCTION Control_SubclassProc( BYVAL hwnd AS HWND, _ ' Control window handle
+ BYVAL uMsg AS UINT, _ ' Type of message
+ BYVAL wParam AS WPARAM, _ ' First message parameter
+ BYVAL lParam AS LPARAM, _ ' Second message parameter
+ BYVAL uIdSubclass AS UINT_PTR, _ ' The subclass ID
+ BYVAL dwRefData AS DWORD_PTR _ ' Pointer to reference data
+ ) AS LRESULT
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/modVDDesignForm.inc b/src/modVDDesignForm.inc
index 8b01809d..edc18557 100644
--- a/src/modVDDesignForm.inc
+++ b/src/modVDDesignForm.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDDesignForm.inc.bak b/src/modVDDesignForm.inc.bak
new file mode 100644
index 00000000..8b01809d
--- /dev/null
+++ b/src/modVDDesignForm.inc.bak
@@ -0,0 +1,1332 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+' VISUAL DESIGNER ROUTINES
+'
+
+#include once "modVDDesignForm.bi"
+
+
+' ========================================================================================
+' Determines if the current view should be Design or Code. This is done by checking
+' the current selection of the design/code tabcontrol.
+' ========================================================================================
+function IsDesignerView( byval pDoc as clsDocument ptr ) as Boolean
+ if pDoc = 0 THEN exit function
+
+ dim as Boolean bDesignView
+
+ ' If this is a Visual Designer document then the display depends on what tab is selected
+ ' in the design|code tabcontrol.
+ if pDoc->IsDesigner then
+ bDesignView = iif(pDoc->DesignTabsCurSel = 0, true, false)
+ else
+ ' Must be a code window
+ bDesignView = false
+ END IF
+
+ function = bDesignView
+end function
+
+
+' ========================================================================================
+' Reset any SnapLines data in order to ready it for future control movements.
+' ========================================================================================
+function ResetSnapLines( byval pDoc as clsDocument ptr ) as Long
+ if pDoc->bSnapLines = false then exit function
+
+ dim pt as POINT
+
+ for i as long = SnapLinePosition.top to SnapLinePosition.right
+ ' Hide any visible SnapLines
+ ShowWindow( pDoc->hSnapLine(i), SW_HIDE )
+ pDoc->bSnapActive(i) = false
+ pDoc->ptCursorStart(i) = pt
+ next
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Calculate any SnapLines and show them on screen.
+' Returns True if SnapLines have been set and calling program should perform the snap.
+' ========================================================================================
+Function PerformSnapLines( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrlActive as clsControl ptr, _
+ byval ptCursor as POINT, _
+ byref xDelta as long, _
+ byref yDelta as long _
+ ) As long
+
+ if pDoc->bSnapLines = false then exit function
+
+ ' Incoming ptCursor is in client coordinates
+
+ dim pCtrl as clsControl ptr
+ dim as RECT rc, rcClient, rcIntersect, rcActive
+
+ dim as RECT rcTest1 ' the hit area for the control being tested
+ dim as RECT rcTest2 ' the hit area for the active control
+
+ dim as long HitPixels = AfxScaleY(8)
+
+ dim as Boolean bHit(3)
+ dim as RECT rcSnap(3)
+ dim as long nShowWindow
+ dim as long xCursorDistance, yCursorDistance
+ dim as long nSnap(3)
+ dim as Boolean bDone
+
+ ' Get the rectangle of the current active control being moved or sized
+ GetClientRect( pDoc->hWndForm, @rcClient )
+ GetWindowRect( pDoc->pCtrlAction->hWindow, @rcActive )
+ MapWindowPoints( 0, pDoc->hWndForm, cast(point ptr, @rcActive), 2 )
+
+ ' NOTE: Based on testing, including the BOTTOM and RIGHT tests can cause
+ ' jerkiness behaviour in the visual designer. For example, a control can
+ ' sometimes get "stuck" alternating between a LEFT hit and a RIGHT hit
+ ' causing the control to immediately snap LEFT and then when you try to
+ ' move, it will snap RIGHT. Being able to dislodge the control from this
+ ' behaviour is very hard.
+ ' Therefore, until a better algorithm can be found, we will just do hit
+ ' testing for TOP and LEFT.
+ '
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType = CTRL_FORM then continue for
+ if pCtrl->IsSelected = true THEN continue for
+ if pCtrl = pCtrlActive THEN continue for
+
+ ' Get the control rectangle to test
+ GetWindowRect( pCtrl->hWindow, @rc )
+ MapWindowPoints( 0, pDoc->hWndForm, cast(point ptr, @rc), 2 )
+
+ ' TOP TEST
+ SetRect( @rcTest1, 0, rc.top - HitPixels, rcClient.right, rc.top + HitPixels )
+ SetRect( @rcTest2, 0, rcActive.top, rcClient.right, rcActive.top + 1 )
+ if IntersectRect( @rcIntersect, @rcTest1, @rcTest2 ) then
+ bHit(SnapLinePosition.top) = true
+ if IsRectEmpty( @rcSnap(SnapLinePosition.top) ) then
+ SetRect( @rcSnap(SnapLinePosition.top), rcActive.left, rc.top - 1, rcActive.right, rc.top )
+ end if
+ if rc.left < rcSnap(SnapLinePosition.top).left then rcSnap(SnapLinePosition.top).left = rc.left
+ if rc.right > rcSnap(SnapLinePosition.top).right then rcSnap(SnapLinePosition.top).right = rc.right
+ nSnap(SnapLinePosition.top) = rc.top
+ end if
+
+' ' BOTTOM TEST
+' if bHit(SnapLinePosition.top) = false then
+' SetRect( @rcTest1, 0, rc.bottom - HitPixels, rcClient.right, rc.bottom + HitPixels )
+' SetRect( @rcTest2, 0, rcActive.bottom, rcClient.right, rcActive.bottom + 1 )
+' if IntersectRect( @rcIntersect, @rcTest1, @rcTest2 ) then
+' if bHit(SnapLinePosition.top) = false then
+' bHit(SnapLinePosition.bottom) = true
+' if IsRectEmpty( @rcSnap(SnapLinePosition.bottom) ) then
+' SetRect( @rcSnap(SnapLinePosition.bottom), rcActive.left, rc.bottom - 1, rcActive.right, rc.bottom )
+' end if
+' if rc.left < rcSnap(SnapLinePosition.bottom).left then rcSnap(SnapLinePosition.bottom).left = rc.left
+' if rc.right > rcSnap(SnapLinePosition.bottom).right then rcSnap(SnapLinePosition.bottom).right = rc.right
+' nSnap(SnapLinePosition.bottom) = rc.bottom
+' end if
+' end if
+' end if
+
+ ' LEFT TEST
+ SetRect( @rcTest1, rc.left - HitPixels, 0, rc.left + HitPixels, rcClient.bottom )
+ SetRect( @rcTest2, rcActive.left, 0, rcActive.left + 1, rcClient.bottom )
+ if IntersectRect( @rcIntersect, @rcTest1, @rcTest2 ) then
+ bHit(SnapLinePosition.left) = true
+ if IsRectEmpty( @rcSnap(SnapLinePosition.left) ) then
+ SetRect( @rcSnap(SnapLinePosition.left), rc.left - 1, rcActive.top, rc.left, rcActive.bottom )
+ end if
+ if rc.top < rcSnap(SnapLinePosition.left).top then rcSnap(SnapLinePosition.left).top = rc.top
+ if rc.bottom > rcSnap(SnapLinePosition.left).bottom then rcSnap(SnapLinePosition.left).bottom = rc.bottom
+ nSnap(SnapLinePosition.left) = rc.left
+ end if
+
+' ' RIGHT TEST
+' if bHit(SnapLinePosition.left) = false then
+' SetRect( @rcTest1, rc.right - HitPixels, 0, rc.right + HitPixels, rcClient.bottom )
+' SetRect( @rcTest2, rcActive.right, 0, rcActive.right + 1, rcClient.bottom )
+' if IntersectRect( @rcIntersect, @rcTest1, @rcTest2 ) then
+' if bHit(SnapLinePosition.left) = false then
+' bHit(SnapLinePosition.right) = true
+' if IsRectEmpty( @rcSnap(SnapLinePosition.right) ) then
+' SetRect( @rcSnap(SnapLinePosition.right), rc.right - 1, rcActive.top, rc.right, rcActive.bottom )
+' end if
+' if rc.top < rcSnap(SnapLinePosition.right).top then rcSnap(SnapLinePosition.right).top = rc.top
+' if rc.bottom > rcSnap(SnapLinePosition.right).bottom then rcSnap(SnapLinePosition.right).bottom = rc.bottom
+' nSnap(SnapLinePosition.right) = rc.right
+' end if
+' end if
+' end if
+ next
+
+
+ ' Testing Sequence
+ ' Top, Left, Bottom, Right
+ for i as long = SnapLinePosition.top to SnapLinePosition.right
+
+ if bHit(i) then
+ ' If the snap has not performed then do it now and save the current screen cursor position.
+ if pDoc->bSnapActive(i) = false then
+ pDoc->bSnapActive(i) = true
+ pDoc->ptCursorStart(i) = ptCursor
+ select case i
+ case SnapLinePosition.top
+ yDelta = nSnap(i) - rcActive.top
+ case SnapLinePosition.left
+ xDelta = nSnap(i) - rcActive.left
+ case SnapLinePosition.bottom
+ yDelta = nSnap(i) - rcActive.bottom
+ case SnapLinePosition.right
+ xDelta = nSnap(i) - rcActive.right
+ end select
+
+ else
+ ' A previous SnapLine action has occurred and the control is still snapped
+ ' to the snapline. Need to test if the cursor has moved far enough outside
+ ' the capture area to free the control from the snap.
+ xCursorDistance = ( ptCursor.x - pDoc->ptCursorStart(i).x )
+ yCursorDistance = ( ptCursor.y - pDoc->ptCursorStart(i).y )
+ select case i
+ case SnapLinePosition.top, SnapLinePosition.bottom
+ if abs(yCursorDistance) > HitPixels then
+ pDoc->bSnapActive(SnapLinePosition.top) = false
+ pDoc->bSnapActive(SnapLinePosition.bottom) = false
+ bHit(SnapLinePosition.left) = false ' prevent further tests
+ bHit(SnapLinePosition.right) = false ' prevent further tests
+ bHit(SnapLinePosition.top) = false ' prevent further tests
+ bHit(SnapLinePosition.bottom) = false ' prevent further tests
+ yDelta = yCursorDistance
+ bDone = true
+ else
+ ' We are still snapped and still within the snap area. Therefore, do not
+ ' allow the control to move by setting yDelta to zero.
+ yDelta = 0
+ end if
+ case SnapLinePosition.left, SnapLinePosition.right
+ if abs(xCursorDistance) > HitPixels then
+ pDoc->bSnapActive(SnapLinePosition.left) = false
+ pDoc->bSnapActive(SnapLinePosition.right) = false
+ bHit(SnapLinePosition.left) = false ' prevent further tests
+ bHit(SnapLinePosition.right) = false ' prevent further tests
+ bHit(SnapLinePosition.top) = false ' prevent further tests
+ bHit(SnapLinePosition.bottom) = false ' prevent further tests
+ xDelta = xCursorDistance
+ bDone = true
+ else
+ ' We are still snapped and still within the snap area. Therefore, do not
+ ' allow the control to move by setting xDelta to zero.
+ xDelta = 0
+ end if
+ end select
+
+ end if
+ end if
+
+ nShowWindow = iif( bHit(i), SWP_SHOWWINDOW, SWP_HIDEWINDOW )
+ if pDoc->bSnapActive(i) then nShowWindow = SWP_SHOWWINDOW
+
+ SetWindowPos( pDoc->hSnapLine(i), HWND_TOP, _
+ rcSnap(i).left, rcSnap(i).top, _
+ rcSnap(i).right - rcSnap(i).left, _
+ rcSnap(i).bottom - rcSnap(i).top, _
+ nShowWindow )
+ if bDone then exit for
+ next
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Create and display popup control menu.
+' ========================================================================================
+function DisplayControlPopupMenu( _
+ byval hwnd as hwnd, _
+ byval xpos as long, _
+ byval ypos as long _
+ ) As Long
+ static as HMENU hPopupMenu
+
+ If hPopupMenu Then DestroyMenu(hPopupMenu)
+
+ hPopupMenu = CreatePopupMenu()
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_CUT, L(17,"Cu&t")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_COPY, L(18,"&Copy")
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_PASTE, L(19,"&Paste")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_DELETE, L(326,"&Delete")
+ TrackPopupMenu(hPopupMenu, TPM_LEFTALIGN Or TPM_LEFTBUTTON, xpos, ypos, 0, hWnd, 0)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Create and display popup form menu.
+' ========================================================================================
+Function DisplayFormPopupMenu( _
+ byval hwnd as hwnd, _
+ byval xpos as long, _
+ byval ypos as long _
+ ) As Long
+ static as HMENU hPopupMenu
+
+ If hPopupMenu Then DestroyMenu(hPopupMenu)
+
+ hPopupMenu = CreatePopupMenu()
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_PASTE, L(19,"Paste")
+ AppendMenu hPopUpMenu, MF_SEPARATOR, 0, ""
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_MENUEDITOR, L(312,"Menu Editor") & "..."
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_TOOLBAREDITOR, L(313,"Toolbar Editor") & "..."
+ AppendMenu hPopUpMenu, MF_ENABLED, IDM_STATUSBAREDITOR, L(314,"Statusbar Editor") & "..."
+ TrackPopupMenu(hPopupMenu, TPM_LEFTALIGN Or TPM_LEFTBUTTON, xpos, ypos, 0, hWnd, 0)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Change the mouse cursor depending on selected Toolbox control.
+' ========================================================================================
+function SetMouseCursor() As Long
+ Dim As HWnd hList1 = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTTOOLBOX)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+
+ if nCurSel = -1 THEN exit function
+
+ ' The index into the global gToolbox array is stored in the line's data area.
+ dim as long idx = ListBox_GetItemData(hList1, nCurSel)
+ if idx > 0 THEN
+ SetCursor LoadCursor( GetModuleHandle(NULL), *gToolBox(idx).wszCursor)
+ else
+ SetCursor LoadCursor( 0, ByVal IDC_ARROW )
+ END IF
+ function = 0
+End Function
+
+
+' ========================================================================================
+' Change the mouse cursor if over a valid grab handle
+' ========================================================================================
+function SetGrabHandleMouseCursor( _
+ byval pDoc as clsDocument ptr, _
+ byval x as long, _
+ byval y as long, _
+ byref pCtrlAction as clsControl Ptr _
+ ) as LRESULT
+
+ dim pCtrl as clsControl ptr
+ dim rcCtrl as RECT
+ dim pt as point: pt.x = x: pt.y = y ' The point in is client coordinates
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ for ii as long = GRAB_TOPLEFT to GRAB_LEFT
+ if PtInRect(@pCtrl->rcHandles(ii), pt) then
+ ' Test to ensure that the specific control Locked property is not set, or
+ ' the global Locked setting for the entire form is not set.
+ if (pDoc->bLockControls = true) or (GetControlProperty(pCtrl, "Locked") = "True") then
+ SetCursor( LoadCursor(Null, ByVal IDC_NO) ): return GRAB_NOHIT
+ end if
+ select case ii
+ Case GRAB_TOP, GRAB_BOTTOM: SetCursor( LoadCursor(Null, ByVal IDC_SIZENS) )
+ case GRAB_LEFT, GRAB_RIGHT: SetCursor( LoadCursor(Null, ByVal IDC_SIZEWE) )
+ case GRAB_TOPLEFT, GRAB_BOTTOMRIGHT: SetCursor( LoadCursor(Null, ByVal IDC_SIZENWSE) )
+ case GRAB_TOPRIGHT, GRAB_BOTTOMLEFT: SetCursor( LoadCursor(Null, ByVal IDC_SIZENESW) )
+ end select
+ pCtrlAction = pCtrl
+ return ii ' return hit code GRAB_TOPLEFT to GRAB_LEFT
+ end if
+ NEXT
+ next
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType = CTRL_FORM THEN continue for
+ GetWindowRect(pCtrl->hWindow, @rcCtrl)
+ MapWindowPoints(0, pDoc->hWndForm, cast(point ptr, @rcCtrl), 2)
+ if PtInRect(@rcCtrl, pt) THEN
+ ' Test to ensure that the specific control Locked property is not set, or
+ ' the global Locked setting for the entire form is not set.
+ if (pDoc->bLockControls = true) or (GetControlProperty(pCtrl, "Locked") = "True") then
+ ' We will continue to allow the Arrow cursor for Locked controls in order to
+ ' indicate that the control can be selected. If the user attempts to move the
+ ' control then the cursor will change to IDC_NO
+ return GRAB_NOHIT
+ else
+ ' Cursor is over a valid control
+ SetCursor( LoadCursor(Null, ByVal IDC_SIZEALL) ): return GRAB_NOHIT
+ end if
+ END IF
+ next
+
+ function = GRAB_NOHIT
+
+end function
+
+
+' ========================================================================================
+' Calculate the size of form/controls grab handle rectangles
+' ========================================================================================
+function CalculateGrabHandles( byval pDoc as clsDocument ptr) as long
+ if pDoc = 0 THEN exit function
+
+ dim pCtrl as clsControl ptr
+
+ dim as long cx = AfxScaleX(6)
+ dim as long cy = AfxScaleY(6)
+ dim as long HMid, VMid ' horiz and vert middles
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+
+ dim rc as RECT
+ GetWindowRect(pCtrl->hWindow, @rc)
+ MapWindowPoints(0, GetParent(pCtrl->hWindow), cast(point ptr, @rc), 2)
+
+ ' Calculate the grab handle rectangles
+ HMid = (rc.right - rc.left) / 2
+ VMid = (rc.bottom - rc.top) / 2
+ '
+ ' 1 2 3
+ '
+ ' 8 4
+ '
+ ' 7 6 5
+ '
+ ' Only calculate the grab handle rectangles if the control is selected
+ if pCtrl->IsSelected THEN
+ SetRect(@pCtrl->rcHandles(GRAB_TOPLEFT), rc.left-cx, rc.top-cy, rc.left, rc.top)
+ SetRect(@pCtrl->rcHandles(GRAB_TOP), rc.left+HMid-(cx/2), rc.top-cy, rc.left+HMid+(cx/2), rc.top)
+ SetRect(@pCtrl->rcHandles(GRAB_TOPRIGHT), rc.right, rc.top-cy, rc.right+cx, rc.top)
+ SetRect(@pCtrl->rcHandles(GRAB_RIGHT), rc.right, rc.top+VMid-(cy/2), rc.right+cx, rc.top+VMid+(cy/2))
+ SetRect(@pCtrl->rcHandles(GRAB_BOTTOMRIGHT), rc.right, rc.bottom, rc.right+cx, rc.bottom+cy)
+ SetRect(@pCtrl->rcHandles(GRAB_BOTTOM), rc.left+HMid-(cx/2), rc.bottom, rc.left+HMid+(cx/2), rc.bottom+cy)
+ SetRect(@pCtrl->rcHandles(GRAB_BOTTOMLEFT), rc.left-cx, rc.bottom, rc.left, rc.bottom+cy)
+ SetRect(@pCtrl->rcHandles(GRAB_LEFT), rc.left-cx, rc.top+VMid-(cy/2), rc.left, rc.top+VMid+(cy/2))
+ else
+ for i as long = GRAB_TOPLEFT to GRAB_LEFT
+ SetRectEmpty(@pCtrl->rcHandles(i))
+ NEXT
+ end if
+
+ ' If this is a form then we don't want to display some of the grab handles
+ ' so simply set them to be empty rectangles.
+ if pCtrl->ControlType = CTRL_FORM THEN
+ SetRectEmpty(@pCtrl->rcHandles(GRAB_TOPLEFT))
+ SetRectEmpty(@pCtrl->rcHandles(GRAB_TOP))
+ SetRectEmpty(@pCtrl->rcHandles(GRAB_TOPRIGHT))
+ SetRectEmpty(@pCtrl->rcHandles(GRAB_BOTTOMLEFT))
+ SetRectEmpty(@pCtrl->rcHandles(GRAB_LEFT))
+ end if
+
+ NEXT
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Draw the actual grab handles (this is called from WM_PAINT)
+' ========================================================================================
+function DrawGrabHandles( _
+ byval hDC as HDC, _
+ byval pDoc as clsDocument ptr, _
+ byval bFormOnly as Boolean _
+ ) as long
+
+ if pDoc = 0 THEN exit function
+
+ dim pCtrl as clsControl ptr
+
+ CalculateGrabHandles(pDoc)
+
+ SaveDC hDC
+
+ dim as LOGBRUSH LogBrush
+ LogBrush.lbColor = BGR(0,0,0)
+ LogBrush.lbStyle = PS_SOLID
+ dim as HPEN hDottedPen = ExtCreatePen( PS_COSMETIC or PS_ALTERNATE, 1, @LogBrush, 0, NULL )
+ dim as HPEN hSolidPen = CreatePen(PS_SOLID, 1, BGR(0,0,0))
+ dim as HBRUSH hWhiteBrush = CreateSolidBrush(BGR(255,255,255))
+ dim as HBRUSH hBlackBrush = CreateSolidBrush(BGR(0,0,0))
+ dim as HBRUSH hRedBrush = CreateSolidBrush(BGR(255,0,0))
+
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+
+ if bFormOnly THEN
+ if pCtrl->ControlType <> CTRL_FORM THEN continue for
+ else
+ if pCtrl->ControlType = CTRL_FORM THEN continue for
+ end if
+
+ dim rc as RECT
+ GetWindowRect(pCtrl->hWindow, @rc)
+ MapWindowPoints(0, GetParent(pCtrl->hWindow), cast(point ptr, @rc), 2)
+
+ ' Draw the actual grab handles
+ if pCtrl->IsSelected THEN
+ ' Draw the dotted rectangle around the control
+ dim as long nOffset = AfxScaleX(2)
+ SelectObject( hDC, hDottedPen )
+ SelectObject( hDC, GetStockObject( NULL_BRUSH ) )
+ Rectangle(hDC, rc.left-nOffset, rc.top-nOffset, rc.right+nOffset, rc.bottom+nOffset)
+
+ SelectObject( hDC, hSolidPen )
+
+ ' If Form level locking is set or the Control is locked then paint in red.
+ if IsControlLocked(pDoc, pCtrl) then
+ SelectObject( hDC, hRedBrush )
+ else
+ SelectObject( hDC, iif(pCtrl->IsActive, hWhiteBrush, hBlackBrush) )
+ end if
+
+ for ii as long = GRAB_TOPLEFT to GRAB_LEFT
+ if pCtrl->IsActive THEN
+ RoundRect(hDC, pCtrl->rcHandles(ii).left, pCtrl->rcHandles(ii).top, _
+ pCtrl->rcHandles(ii).right, pCtrl->rcHandles(ii).bottom, 2, 2 )
+ else
+ ' Make the non-active control grab handles a little smaller so as not to
+ ' visually overpower the active control's white handles.
+ Rectangle(hDC, pCtrl->rcHandles(ii).left, pCtrl->rcHandles(ii).top, _
+ pCtrl->rcHandles(ii).right-2, pCtrl->rcHandles(ii).bottom-2 )
+ END IF
+ NEXT
+ END IF
+ next
+
+ RestoreDC hDC, -1
+
+ DeleteObject(hDottedPen)
+ DeleteObject(hSolidPen)
+ DeleteObject(hWhiteBrush)
+ DeleteObject(hBlackBrush)
+ DeleteObject(hRedBrush)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Handle WM_LBUTTONDBLCLK messages for the Form (displays the code editor)
+' ========================================================================================
+function HandleDesignerLButtonDoubleClick( ByVal HWnd As HWnd ) as LRESULT
+ ' When a Control is double clicked, it would have already set the default Event
+ ' in the PropertyList. Therefore, all we need to do is call the doubleclick
+ ' handler for the Event listbox. This will create (if necessary) the Event
+ ' handler code and then position the code editor to that Event.
+ dim as HWND hEvents = GetDlgItem( HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTEVENTS )
+ SendMessage( HWND_FRMVDTOOLBOX, WM_COMMAND, MAKELONG(IDC_FRMVDTOOLBOX_LSTEVENTS, LBN_DBLCLK), cast(LPARAM,hEvents) )
+ function = 0
+end function
+
+
+' ========================================================================================
+' Handle WM_LBUTTONDOWN messages for the Form and Frame windows
+' ========================================================================================
+function HandleDesignerLButtonDown( ByVal HWnd As HWnd ) as LRESULT
+
+ dim as POINT pt
+ dim as RECT rc
+
+
+ dim pDoc as clsDocument ptr = gApp.GetDocumentPtrByWindow(hwnd)
+ if pDoc = 0 THEN exit function
+
+ dim pCtrl as clsControl ptr
+
+ GetCursorPos(@pt)
+ MapWindowPoints(0, HWND, @pt, 1)
+
+ ' Ensure that the cursor stays within the client area
+ GetClientRect(hwnd, @rc)
+ MapWindowPoints(hwnd, 0, cast(point ptr, @rc), 2)
+ ClipCursor(@rc)
+
+ SetCapture(hwnd)
+
+
+ ' #1: Determine if a grab handle has been clicked on
+ pDoc->GrabHit = SetGrabHandleMouseCursor(pDoc, pt.x, pt.y, pCtrl)
+ if pDoc->GrabHit <> GRAB_NOHIT THEN
+ ' One of the sizing handles was clicked on.
+ ' Do not allow resizing of Timer controls.
+ if pCtrl->ControlType = CTRL_TIMER then
+ ClipCursor(0)
+ ReleaseCapture
+ exit function
+ end if
+ pDoc->bSizing = true
+ pDoc->pCtrlAction = pCtrl
+ GetWindowRect(pDoc->pCtrlAction->hWindow, @pDoc->rcSize)
+ pDoc->Controls.SetActiveControl(pDoc->pCtrlAction->hWindow)
+ else
+ ' #2: Determine what control/form was clicked on
+ dim as hwnd hWndCtrl = RealChildWindowFromPoint(pDoc->hWndForm, pt)
+ pCtrl = pDoc->Controls.GetCtrlPtr(hWndCtrl)
+ if pCtrl then
+ ' If Ctrl is held down then toggle adding/removing the control
+ if (GetAsyncKeyState(VK_CONTROL) and &H8000) THEN
+ ' If we are individually selecting/deselecting controls then ensure that
+ ' the form control itself is not part of the group otherwise any cut/copy
+ ' operation will fail with a GPF.
+ ' The form itself can not be part of a selected group
+ if pCtrl->ControlType <> CTRL_FORM then
+ dim pCtrlForm as clsControl ptr = GetFormCtrlPtr(pDoc)
+ if pCtrlForm then pCtrlForm->IsSelected = false
+ pCtrl->IsSelected = not(pCtrl->IsSelected)
+ END IF
+ else
+ ' If the control being clicked on is already selected then it will become
+ ' the active control. If not already selected then deselect all other controls
+ ' in the selection group.
+ if pCtrl->IsSelected = false THEN pDoc->Controls.DeselectAllControls
+ pCtrl->IsSelected = true
+ ' If the Form is clicked on the start the lasso process.
+ if pCtrl->ControlType = CTRL_FORM THEN
+ gLasso.Create(pDoc->hWndForm)
+ gLasso.SetStartPoint(pt.x, pt.y)
+ gLasso.SetEndPoint(pt.x, pt.y)
+ else
+ pDoc->pCtrlAction = pCtrl
+ pDoc->bMoving = true
+ END IF
+ END IF
+ pDoc->Controls.SetActiveControl( iif(pCtrl->IsSelected, hWndCtrl, 0) )
+ frmMain_SetStatusbar
+ END IF
+ END IF
+
+
+ ' Save the current mouse position
+ pDoc->ptPrev.x = pt.x
+ pDoc->ptPrev.y = pt.y
+
+ ' Ensure the grab handles of form and controls are redrawn or hidden
+ AfxRedrawWindow(pDoc->hWndFrame)
+ AfxRedrawWindow(pDoc->hWndForm)
+ DisplayPropertyList(pDoc)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Handle WM_LBUTTONUP messages for the Form and Frame windows
+' ========================================================================================
+function HandleDesignerLButtonUp( ByVal HWnd As HWnd ) as LRESULT
+
+ ClipCursor(0)
+ ReleaseCapture
+
+ dim pDoc as clsDocument ptr = gApp.GetDocumentPtrByWindow(hwnd)
+ if pDoc = 0 THEN exit function
+
+ dim as Rect rcIntersect, rcLasso, rcCtrl
+
+ ' Reset any previous SnapLines data in order to ready it for any
+ ' future movement of controls on the form.
+ ResetSnapLines( pDoc )
+
+
+ ' Hide any previous lasso (and select controls)
+ if gLasso.IsActive THEN
+ dim pCtrl as clsControl ptr
+
+ rcLasso = gLasso.GetLassoRect()
+ gLasso.Destroy
+
+ ' If the Toolbox Pointer/Arrow is selected then attempt to select the controls
+ ' that intersect with the lasso, otherwise draw and create the new Toolbox control.
+ if GetActiveToolboxControlType = CTRL_POINTER THEN
+ dim as hwnd hCtrlSel
+ pDoc->Controls.DeselectAllControls
+ MapWindowPoints(pDoc->hWndForm, 0, cast(point ptr, @rcLasso), 2)
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType <> CTRL_FORM THEN
+ GetWindowRect( pCtrl->hWindow, @rcCtrl)
+ If IntersectRect( @rcIntersect, @rcCtrl, @rcLasso ) Then
+ hCtrlSel = pCtrl->hWindow
+ pCtrl->IsSelected = true
+ end if
+ end if
+ next
+ if hCtrlSel = 0 THEN hCtrlSel = pDoc->hWndForm
+ pDoc->Controls.SelectControl(hCtrlSel)
+ pDoc->Controls.SetActiveControl(hCtrlSel)
+ DisplayPropertyList(pDoc)
+ else
+ ' Create the selected Toolbox control.
+ ' Need to modify rcLasso dimensions in case of HighDPI
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+ SetRect( @rcCtrl, pWindow->UnScaleX(rcLasso.Left), pWindow->UnScaleY(rcLasso.Top), _
+ pWindow->UnScaleX(rcLasso.Right), pWindow->UnScaleY(rcLasso.Bottom) )
+ ' Check for a minimum default size when creating. Check needed because a user could
+ ' select a control in the Toolbox and simply click on the Form rather than drawing
+ ' the control on the form.
+ dim as long nControlType = GetActiveToolboxControlType()
+ rcCtrl = CheckMinimumControlSize( nControlType, rcCtrl )
+ pCtrl = CreateToolboxControl( pDoc, nControlType, rcCtrl )
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+ pDoc->Controls.SelectControl(pCtrl->hWindow)
+ pDoc->Controls.SetActiveControl(pCtrl->hWindow)
+ DisplayPropertyList(pDoc)
+ end if
+ end if
+
+ pDoc->GrabHit = GRAB_NOHIT
+ pDoc->bSizing = false
+ pDoc->bMoving = false
+ pDoc->pCtrlAction = 0
+
+ SetActiveToolboxControl(CTRL_POINTER)
+ SetMouseCursor
+
+ ' Ensure the grab handles of form and controls are redrawn or hidden
+ AfxRedrawWindow(pDoc->hWndFrame)
+ AfxRedrawWindow(pDoc->hWndForm)
+ frmMain_SetStatusbar
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Handle WM_RBUTTONDOWN messages for the Form and Frame windows
+' ========================================================================================
+function HandleDesignerRButtonDown( ByVal HWnd As HWnd ) as LRESULT
+
+ dim as POINT pt
+
+ dim pDoc as clsDocument ptr = gApp.GetDocumentPtrByWindow(hwnd)
+ if pDoc = 0 THEN exit function
+
+ dim pCtrl as clsControl ptr
+
+ ' Call LButtonDown to select control
+ HandleDesignerLButtonDown(HWnd)
+ ClipCursor(0)
+ ReleaseCapture
+
+ GetCursorPos(@pt)
+ pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl THEN
+ if pCtrl->ControlType = CTRL_FORM THEN
+ DisplayFormPopupMenu(HWND_FRMMAIN, pt.x, pt.y)
+ else
+ DisplayControlPopupMenu(HWND_FRMMAIN, pt.x, pt.y)
+ END IF
+ END IF
+
+ ' Call LButtonUp to reset selections
+ HandleDesignerLButtonUp(hwnd)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Handle MOUSEMOVE messages for the Form and Frame windows
+' ========================================================================================
+function HandleDesignerMouseMove( ByVal HWnd As HWnd ) as LRESULT
+
+ dim as POINT pt
+ dim as long xDelta, yDelta
+
+ dim pDoc as clsDocument ptr = gApp.GetDocumentPtrByWindow(hwnd)
+ if pDoc = 0 THEN exit function
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(pDoc->hWndForm)
+ dim pCtrl as clsControl ptr
+
+ GetCursorPos(@pt)
+ MapWindowPoints(0, HWND, @pt, 1)
+ xDelta = pt.x - pDoc->ptPrev.x
+ yDelta = pt.y - pDoc->ptPrev.y
+
+ if (xDelta = 0) andalso (yDelta = 0) THEN exit function
+
+ ' Test to ensure that the specific control Locked property is not set, or
+ ' the global Locked setting for the entire form is not set.
+ if (pDoc->bMoving) andalso IsControlLocked(pDoc, pDoc->pCtrlAction) then
+ SetCursor( LoadCursor(Null, ByVal IDC_NO) )
+ exit function
+ end if
+
+ ' If the mouse cursor is not resizing or moving a control then determine the cursor
+ ' based on what control is selected in the toolbox.
+ if (pDoc->bSizing = false) andalso (pDoc->bMoving = false) then
+ SetMouseCursor
+ end if
+
+
+ if pDoc->bSizing THEN
+
+ Select Case pDoc->GrabHit
+ Case GRAB_BOTTOMRIGHT
+ pDoc->rcSize.right = pDoc->rcSize.right + xDelta
+ pDoc->rcSize.bottom = pDoc->rcSize.bottom + yDelta
+ Case GRAB_RIGHT
+ pDoc->rcSize.right = pDoc->rcSize.right + xDelta
+ Case GRAB_BOTTOM
+ pDoc->rcSize.bottom = pDoc->rcSize.bottom + yDelta
+ case GRAB_BOTTOMLEFT
+ pDoc->rcSize.left = pDoc->rcSize.left + xDelta
+ pDoc->rcSize.bottom = pDoc->rcSize.bottom + yDelta
+ Case GRAB_TOPLEFT
+ pDoc->rcSize.left = pDoc->rcSize.left + xDelta
+ pDoc->rcSize.top = pDoc->rcSize.top + yDelta
+ Case GRAB_TOPRIGHT
+ pDoc->rcSize.right = pDoc->rcSize.right + xDelta
+ pDoc->rcSize.top = pDoc->rcSize.top + yDelta
+ Case GRAB_LEFT
+ pDoc->rcSize.left = pDoc->rcSize.left + xDelta
+ Case GRAB_TOP
+ pDoc->rcSize.top = pDoc->rcSize.top + yDelta
+ End Select
+
+ ' NOTE:
+ ' Set our control to a default minimum value If Zero.
+ ' We want to do this so we don't loose visibility of our control and we can still
+ ' see the handles when selected.
+
+ ' Check for a minimum width and height
+ If pDoc->rcSize.right - pDoc->rcSize.left <= AfxScaleX(8) Then pDoc->rcSize.right = pDoc->rcSize.left + AfxScaleX(8)
+ If pDoc->rcSize.bottom - pDoc->rcSize.top <= AfxScaleY(8) Then pDoc->rcSize.bottom = pDoc->rcSize.top + AfxScaleY(8)
+
+ ' Resize all selected the form/control
+ ' Convert pDoc->rcSize from Window to Client coordinates
+ dim as rect rc = pDoc->rcSize
+ MapWindowPoints(0, HWND, cast(point ptr, @rc), 2)
+ ' Ensure that the rect is unscaled
+ SetRect(@rc, pWindow->UnScaleX(rc.Left), pWindow->UnScaleY(rc.Top), _
+ pWindow->UnScaleX(rc.Right), pWindow->UnScaleY(rc.Bottom))
+
+ pDoc->pCtrlAction->SuspendLayout = true
+ SetControlProperty( pDoc->pCtrlAction, "LEFT", str(rc.left) )
+ SetControlProperty( pDoc->pCtrlAction, "TOP", str(rc.top) )
+ SetControlProperty( pDoc->pCtrlAction, "WIDTH", str(rc.right - rc.left) )
+ SetControlProperty( pDoc->pCtrlAction, "HEIGHT", str(rc.bottom - rc.top) )
+ ApplyControlProperties( pDoc, pDoc->pCtrlAction )
+ pDoc->pCtrlAction->SuspendLayout = false
+
+ ' If a Menu, ToolBar or StatusBar exists on the Form then ensure that it
+ ' resizes to the new Form width.
+ if pDoc->pCtrlAction->ControlType = CTRL_FORM then
+ frmMenuEditor_CreateFakeMainMenu(pDoc)
+ if pDoc->hWndRebar then
+ dim as long nTopMenu_Height, nRebar_Height
+ if pDoc->hWndFakeMenu then
+ nTopMenu_Height = AfxGetWindowHeight( pDoc->hWndFakeMenu )
+ end if
+ GetClientRect( hwnd, @rc )
+ dim as long cx, cy
+ cx = rc.left - rc.right
+ cy = AfxGetWindowHeight( pDoc->hWndRebar )
+ SetWindowPos pDoc->hWndRebar, 0, 0, nTopMenu_Height, rc.right, cy, SWP_NOZORDER
+ SendMessage pDoc->hWndRebar, WM_SIZE, cx, cy
+ end if
+ frmStatusBarEditor_CreateFakeStatusBar(pDoc)
+ end if
+
+ ' Indicate that the file is now dirty and will need to be saved
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+
+ ' Ensure the grab handles are redrawn
+ AfxRedrawWindow(hwnd) ' HWND because could be form or frame
+ frmMain_SetStatusbar
+ DisplayPropertyList(pDoc)
+
+ elseif pDoc->bMoving then
+
+ ' Determine if snap to Snaplines
+ PerformSnapLines( pDoc, pDoc->pCtrlAction, pt, xDelta, yDelta )
+
+ ' Move the control to its new position
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->IsSelected THEN
+ if IsControlLocked(pDoc, pCtrl) then continue for
+ GetWindowRect(pCtrl->hWindow, @pDoc->rcSize)
+ MapWindowPoints(0, pDoc->hWndForm, cast(point ptr, @pDoc->rcSize), 2)
+
+ pDoc->rcSize.left = pDoc->rcSize.left + xDelta
+ pDoc->rcSize.top = pDoc->rcSize.top + yDelta
+
+ ' Ensure that the rect is unscaled
+ SetRect(@pDoc->rcSize, pWindow->UnScaleX(pDoc->rcSize.Left), pWindow->UnScaleY(pDoc->rcSize.Top), _
+ pWindow->UnScaleX(pDoc->rcSize.Right), pWindow->UnScaleY(pDoc->rcSize.Bottom))
+ pCtrl->SuspendLayout = true
+ SetControlProperty(pCtrl, "LEFT", str(pDoc->rcSize.left))
+ SetControlProperty(pCtrl, "TOP", str(pDoc->rcSize.top))
+ ApplyControlProperties(pDoc, pCtrl)
+ pCtrl->SuspendLayout = false
+ END IF
+ next
+
+ ' Indicate that the file is now dirty and will need to be saved
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+
+ ' Ensure the grab handles are redrawn
+ AfxRedrawWindow(pDoc->hWndForm)
+ frmMain_SetStatusbar
+ DisplayPropertyList(pDoc)
+
+ elseif gLasso.IsActive then
+ gLasso.SetEndPoint(pt.x, pt.y)
+ gLasso.Show()
+ else
+ pDoc->GrabHit = SetGrabHandleMouseCursor(pDoc, pt.x, pt.y, pCtrl)
+ end if
+
+ ' Save the current mouse position
+ pDoc->ptPrev.x = pt.x
+ pDoc->ptPrev.y = pt.y
+
+ function = 0
+
+END FUNCTION
+
+
+' ========================================================================================
+' Process WM_PAINT message for Visual Designer Form
+' ========================================================================================
+Function DesignerForm_OnPaint( ByVal HWnd As HWnd) As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(hWnd)
+ If pWindow = 0 Then Exit Function
+
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDC
+ dim as HPEN hPen = CreatePen(PS_SOLID, 1, BGR(0,0,255))
+
+ hDC = BeginPaint(hWnd, @ps)
+
+ SaveDC hDC
+
+ dim pDoc as clsDocument ptr = gApp.GetDocumentPtrByWindow(hwnd)
+ if pDoc THEN
+ ' Draw the control's grab handles
+ DrawGrabHandles(hDC, pDoc, false)
+ end if
+
+ RestoreDC hDC, -1
+ DeleteObject(hPen)
+ EndPaint hWnd, @ps
+
+ ' Repaint any Frame controls because they disappear when the form's background is painted.
+ if pDoc THEN
+ dim pCtrl as clsControl ptr
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if (pCtrl <> 0) andalso (pCtrl->ControlType = CTRL_FRAME) then
+ AfxRedrawWindow(pCtrl->hWindow)
+ end if
+ next
+ end if
+
+ Function = 0
+
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for Visual Designer Form
+' ========================================================================================
+function DesignerForm_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(hWnd)
+ if pWindow then Delete pWindow
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_NOTIFY message for Visual Designer Form
+' ========================================================================================
+function DesignerForm_OnNotify( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal pNMHDR As NMHDR Ptr _
+ ) As LRESULT
+
+ Select Case pNMHDR->code
+ Case NM_CLICK
+ if id = IDC_FAKESTATUSBAR then
+ ' Determine if one of the Panels was clicked on. If it was then send
+ ' that value to the routine that will open the sttausbar editor
+ ' defaulting to that panel as being selected.
+ Dim lpnm As NMMOUSE Ptr = Cast(NMMOUSE Ptr, pNMHDR)
+ ' lpnm->dwItemSpec ' index of clicked panel
+ PostMessage( HWND_FRMMAIN, WM_COMMAND, _
+ MAKELONG(IDM_STATUSBAREDITOR, lpnm->dwItemSpec), 0 )
+ end if
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Process WM_COMMAND message for Visual Designer Form
+' ========================================================================================
+function DesignerForm_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+ Select Case id
+ Case IDC_LBLFAKEMAINMENU
+ If codeNotify = BN_CLICKED Then
+ PostMessage( HWND_FRMMAIN, WM_COMMAND, MAKELONG(IDM_MENUEDITOR, 0), 0 )
+ end if
+ end select
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Visual Designer Form Window procedure
+' ========================================================================================
+function DesignerForm_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_PAINT, DesignerForm_OnPaint)
+ HANDLE_MSG (HWnd, WM_NOTIFY, DesignerForm_OnNotify)
+ HANDLE_MSG (HWnd, WM_COMMAND, DesignerForm_OnCommand)
+ HANDLE_MSG (HWnd, WM_DESTROY, DesignerForm_OnDestroy)
+
+ case WM_LBUTTONDBLCLK: HandleDesignerLButtonDoubleClick(HWND)
+ case WM_RBUTTONDOWN: HandleDesignerRButtonDown(HWND)
+ case WM_LBUTTONDOWN: HandleDesignerLButtonDown(HWND)
+ case WM_LBUTTONUP: HandleDesignerLButtonUp(HWND)
+ case WM_MOUSEMOVE: HandleDesignerMouseMove(HWND)
+
+ Case WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN, WM_NCLBUTTONDBLCLK
+ ' Will only fire when the Caption bar, Min/Max/Close buttons are clicked.
+ SetActiveWindow HWND_FRMMAIN
+ dim pDoc as clsDocument ptr = gApp.GetDocumentPtrByWindow(hwnd)
+ if pDoc THEN
+ pDoc->Controls.DeselectAllControls
+ pDoc->Controls.SetActiveControl(pDoc->hWndForm)
+ AfxRedrawWindow(pDoc->hWndFrame)
+ AfxRedrawWindow(pDoc->hWndForm)
+ DisplayPropertyList(pDoc)
+ END IF
+ Function = TRUE: Exit Function
+
+
+ Case WM_NCHITTEST
+ ' Catch certain critical mouseover points on the form so we can stop processing them.
+ dim as LRESULT nHitTest = DefWindowProc(hWnd, uMsg, wParam, lParam)
+
+ Select Case nHitTest
+ ' Border edges of the window and captionbar
+ Case HTLEFT, HTTOP, HTTOPLEFT, HTTOPRIGHT, _
+ HTBOTTOMLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT, _
+ HTCLOSE, HTMENU, HTMINBUTTON, HTMAXBUTTON
+ Function = 0 ' Return zero so the mousepointer will not change
+ Exit Function
+ End Select
+
+ Function = nHitTest ' Return the default code from the default window handler.
+ Exit Function
+
+
+ case WM_CTLCOLOREDIT, WM_CTLCOLORBTN, WM_CTLCOLORLISTBOX, WM_CTLCOLORSTATIC
+ ' wParam: HDC of the control.
+ ' lParam: Handle to the control.
+ ' Need to determine the child control handle that is sending the request to be painted.
+ dim pCtrl as clsControl ptr
+ dim pDoc as clsDocument ptr = gApp.GetDocumentPtrByWindow(hwnd)
+ if pDoc THEN
+ pCtrl = pDoc->Controls.GetCtrlPtr(cast(hwnd, lParam) )
+ if pCtrl then
+ ' Colors for WinFormsX Label controls are set in WM_DRAWITEM
+ if pCtrl->ControlType <> CTRL_LABEL then
+ dim pProp as clsProperty ptr
+ pProp = GetControlPropertyPtr(pCtrl, "FORECOLOR")
+ if pProp then
+ SetTextColor(cast(HDC, wParam), GetRGBColorFromProperty(pProp->wszPropValue))
+ end if
+ pProp = GetControlPropertyPtr(pCtrl, "BACKCOLOR")
+ if pProp then
+ dim as COLORREF clrBack = GetRGBColorFromProperty(pProp->wszPropValue)
+ SetBkColor(cast(HDC, wParam), clrBack)
+ if pCtrl->hBackBrush then DeleteBrush(pCtrl->hBackBrush)
+ pCtrl->hBackBrush = CreateSolidBrush(clrBack)
+ Return Cast(LRESULT, pCtrl->hBackBrush)
+ end if
+ end if
+ end if
+ end if
+
+ ' We would have handled any FRAME control backcolor in the code above. The following code
+ ' deals with color for fake menu and snap lines.
+ if uMsg = WM_CTLCOLORSTATIC then
+ if pDoc THEN
+ ' Need to determine if the incoming control handle relates to
+ ' a snapline or is the fake topmenu label.
+ dim as hwnd hCtrl = cast(HWND, lParam)
+ if hCtrl = pDoc->hWndFakeMenu then
+ Return Cast( LRESULT, GetSysColorBrush(COLOR_MENU+1) )
+ else
+ for i as long = 0 to 3
+ if hCtrl = pDoc->hSnapLine(i) then
+ ' SnapLines labels have purple brush
+ if pDoc->hBrushSnapLine = 0 then
+ pDoc->hBrushSnapLine = CreateSolidBrush( BGR(128,0,128) ) ' purple
+ end if
+ Return Cast(LRESULT, pDoc->hBrushSnapLine)
+ end if
+ next
+ end if
+ end if
+ end if
+
+
+ case WM_DRAWITEM
+ dim lpdis As DRAWITEMSTRUCT Ptr = cast( DRAWITEMSTRUCT Ptr, lParam )
+ if lpdis = 0 then exit function
+ dim pDoc as clsDocument ptr = gApp.GetDocumentPtrByWindow(hwnd)
+ if pDoc = 0 THEN exit function
+
+ if lpdis->hwndItem = pDoc->hWndStatusBar then
+ ' StatusBar panels are OwnerDraw
+ Dim memDC as HDC ' Double buffering
+ Dim hbit As HBITMAP ' Double buffering
+ Dim As RECT rc
+ Dim wszText As WString * MAX_PATH
+ dim as long nImageWidth
+ dim as long nImageHeight
+
+ rc = lpdis->rcItem
+
+ dim as long nItem = lpdis->itemID
+ If (nItem < 0) or (nItem > ubound(pDoc->PanelItems)) Then Exit Function
+
+ ' The image/text output rectangle is positioned within the main rc rectangle
+ ' depending on the alignment.
+ dim as RECT rc1 = rc
+
+ dim wszImageName as wstring * MAX_PATH
+ wszImageName = pDoc->PanelItems(nItem).pProp.wszPropValue
+
+ dim as HANDLE hIcon
+ dim hImageListNormal As HIMAGELIST
+ if len(wszImageName) then
+ Dim cx As Long = AfxScaleX(16)
+ dim pImageType as IMAGES_TYPE ptr = GetImagesTypePtr(wszImageName)
+ hImageListNormal = ImageList_Create( cx, cx, ILC_COLOR32 Or ILC_MASK, 1, 1)
+ dim as long ii = AfxGdipAddIconFromFile( hImageListNormal, pImageType->wszFileName )
+ hIcon = ImageList_GetIcon( hImageListNormal, ii, ILD_NORMAL )
+ if hIcon then
+ nImageWidth = AfxScaleX(16)
+ nImageHeight = AfxScaleY(16)
+ end if
+ End If
+
+ wszText = " " & pDoc->PanelItems(nItem).wszText & " "
+ dim as long nTextWidth = GetTextWidthPixels( lpdis->hwndItem, wszText )
+
+ dim as long nTotalWidth
+ if nImageWidth then nTotalWidth = nImageWidth + AfxScaleX(4)
+ if nTextWidth then nTotalWidth = nTotalWidth + nTextWidth
+
+ select case pDoc->PanelItems(nItem).wszAlignment
+ case "StatusBarPanelAlignment.Left"
+ ' No need to do anything because rc1 is already the full size of rc.
+ case "StatusBarPanelAlignment.Center"
+ dim as long nPad = MAX(0, (rc.right - rc.left - nTotalWidth) / 2)
+ rc1.left = rc1.left + nPad
+ case "StatusBarPanelAlignment.Right"
+ rc1.left = rc1.right - nTotalWidth
+ end select
+
+ memDC = CreateCompatibleDC( lpdis->hDC )
+ hbit = CreateCompatibleBitmap( lpdis->hDC, rc.right, rc.bottom )
+ If hbit Then hbit = SelectObject( memDC, hbit )
+
+ dim as HFONT _hFont = AfxGetWindowFont( lpdis->hwndItem )
+ SelectObject( memDC, _hFont )
+
+ ' Paint the entire background
+ dim as HBRUSH hBackBrush
+ dim as COLORREF rgbBackClr, rgbForeClr
+
+ ' In the visual designer we only display the panels in the "non hot" state.
+ rgbBackClr = GetRGBColorFromProperty(pDoc->PanelItems(nItem).wszBackColor)
+ rgbForeClr = GetRGBColorFromProperty(pDoc->PanelItems(nItem).wszForeColor)
+
+ SetBkColor( memDC, rgbBackClr )
+ SetTextColor( memDC, rgbForeClr )
+ hBackBrush = CreateSolidBrush(rgbBackClr)
+ FillRect( memDC, @rc, hBackBrush )
+ DeleteObject(hBackBrush)
+
+ ' Output any defined icon for the panel
+ if hIcon then
+ ' Center the image vertically within rc1
+ dim as long nPad = (rc1.bottom - rc1.top - nImageHeight) / 2
+ DrawIconEx( memDC, rc1.left, rc1.top + nPad, _
+ hIcon, _
+ nImageWidth, nImageHeight, 0, null, DI_NORMAL )
+ DeleteObject( hIcon )
+ ImageList_Destroy( hImageListNormal )
+ rc1.left = rc1.left + nImageWidth + AfxScaleX(4)
+ end if
+
+ ' Prepare and paint the text coloring
+ dim as long lFormat = DT_LEFT Or DT_VCENTER or DT_SINGLELINE
+ wszText = pDoc->PanelItems(nItem).wszText
+ DrawText( memDC, wszText, -1, Cast(lpRect, @rc1), lFormat )
+
+ BitBlt lpdis->hDC, 0, 0, rc.right, rc.bottom, memDC, 0, 0, SRCCOPY
+
+ ' Cleanup
+ If hbit Then DeleteObject SelectObject(memDC, hbit)
+ If memDC Then DeleteDC memDC
+
+ else
+ ' Label controls are OwnerDraw
+ dim pCtrl as clsControl ptr = pDoc->Controls.GetCtrlPtr( lpdis->hwndItem )
+ if pCtrl then
+ dim pProp as clsProperty ptr
+
+ select case pCtrl->ControlType
+ case CTRL_LABEL
+ pProp = GetControlPropertyPtr( pCtrl, "FORECOLOR" )
+ if pProp then SetTextColor( lpdis->hDC, GetRGBColorFromProperty(pProp->wszPropValue) )
+ pProp = GetControlPropertyPtr(pCtrl, "BACKCOLOR")
+ if pProp then
+ dim as COLORREF clrBack = GetRGBColorFromProperty(pProp->wszPropValue)
+ SetBkColor( lpdis->hDC, clrBack )
+ dim as RECT rc
+ GetClientRect( lpdis->hwndItem, @rc )
+ if pCtrl->hBackBrush then DeleteBrush( pCtrl->hBackBrush )
+ pCtrl->hBackBrush = CreateSolidBrush( clrBack )
+ FillRect( lpdis->hDC, @rc, pCtrl->hBackBrush )
+ end if
+ dim wszText as WString * MAX_PATH
+
+ ' Windows draws Labels with SS_LEFT, CC_CENTER and SS_RIGHT styles by using
+ ' DrawText with the DT_WORDBREAK and DT_EXPANDTABS parameters. Other styles
+ ' must use DT_SINGLELINE and do not word wrap.
+ dim as long lWrapMode = DT_SINGLELINE
+ dim as long lFormat
+ Select Case **GetControlProperty(pCtrl, "TEXTALIGN")
+ Case "LabelAlignment.BottomCenter": lFormat = DT_CENTER Or DT_BOTTOM
+ Case "LabelAlignment.BottomLeft": lFormat = DT_LEFT Or DT_BOTTOM
+ Case "LabelAlignment.BottomRight": lFormat = DT_RIGHT Or DT_BOTTOM
+ Case "LabelAlignment.MiddleCenter": lFormat = DT_CENTER Or DT_VCENTER
+ Case "LabelAlignment.MiddleLeft": lFormat = DT_LEFT Or DT_VCENTER
+ Case "LabelAlignment.MiddleRight": lFormat = DT_RIGHT Or DT_VCENTER
+ Case "LabelAlignment.TopCenter"
+ lFormat = DT_CENTER Or DT_TOP
+ lWrapMode = DT_WORDBREAK
+ Case "LabelAlignment.TopLeft"
+ lFormat = DT_LEFT Or DT_TOP
+ lWrapMode = DT_WORDBREAK
+ Case "LabelAlignment.TopRight"
+ lFormat = DT_RIGHT Or DT_TOP
+ lWrapMode = DT_WORDBREAK
+ End Select
+ lFormat = lFormat or lWrapMode or DT_EXPANDTABS
+
+ wszText = AfxGetWindowText( lpdis->hwndItem )
+ DrawText( lpdis->hDC, wszText, -1, Cast(lpRect, @lpdis->rcItem), lFormat )
+ end select
+ end if
+ end if
+
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed controls.
+' ========================================================================================
+function Control_SubclassProc( _
+ BYVAL hwnd AS HWND, _ ' Control window handle
+ BYVAL uMsg AS UINT, _ ' Type of message
+ BYVAL wParam AS WPARAM, _ ' First message parameter
+ BYVAL lParam AS LPARAM, _ ' Second message parameter
+ BYVAL uIdSubclass AS UINT_PTR, _ ' The subclass ID
+ BYVAL dwRefData AS DWORD_PTR _ ' Pointer to reference data
+ ) AS LRESULT
+
+ dim pDoc as clsDocument ptr = cast(clsDocument ptr, dwRefData)
+
+ SELECT CASE uMsg
+
+ CASE WM_GETDLGCODE
+ ' All keyboard input
+ FUNCTION = DLGC_WANTALLKEYS
+ EXIT FUNCTION
+
+ case WM_RBUTTONDOWN: HandleDesignerRButtonDown(pDoc->hWndForm): return CTRUE
+ case WM_LBUTTONDOWN: HandleDesignerLButtonDown(pDoc->hWndForm): return CTRUE
+ case WM_LBUTTONDBLCLK: HandleDesignerLButtonDoubleClick(pDoc->hWndForm): return CTRUE
+ case WM_LBUTTONUP: HandleDesignerLButtonUp(pDoc->hWndForm): return CTRUE
+ case WM_MOUSEMOVE: HandleDesignerMouseMove(pDoc->hWndForm)
+
+ Case WM_MOUSEACTIVATE
+ ' Defeat this message so that mouse clicks do not activate the control. However, we
+ ' do need to set focus to the control in order to allow keyboard move/resize.
+ SetFocus(hwnd)
+ Function = MA_NOACTIVATE: uMsg = WM_NULL
+ Exit Function
+
+ Case WM_SETCURSOR
+ Function = CTRUE: uMsg = WM_NULL
+ Exit Function
+
+ Case WM_SETFOCUS
+ ' Defeat the caret activation, for some
+ ' reason MA_NOACTIVATE does not work for right clicks.
+ Function = 0: uMsg = WM_NULL
+ Exit Function
+
+ CASE WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass( hwnd, @Control_SubclassProc, uIdSubclass )
+
+ END SELECT
+
+ ' Default processing of Windows messages
+ FUNCTION = DefSubclassProc(hwnd, uMsg, wParam, lParam)
+
+END FUNCTION
+
+
+
diff --git a/src/modVDDesignFrame.bi b/src/modVDDesignFrame.bi
index b13f3cac..712cd12d 100644
--- a/src/modVDDesignFrame.bi
+++ b/src/modVDDesignFrame.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDDesignFrame.bi.bak b/src/modVDDesignFrame.bi.bak
new file mode 100644
index 00000000..b13f3cac
--- /dev/null
+++ b/src/modVDDesignFrame.bi.bak
@@ -0,0 +1,17 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+declare Function DesignerFrame_WndProc( ByVal HWnd As HWnd, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM ) As LRESULT
+
diff --git a/src/modVDDesignFrame.inc b/src/modVDDesignFrame.inc
index fc740aa1..63844b28 100644
--- a/src/modVDDesignFrame.inc
+++ b/src/modVDDesignFrame.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDDesignFrame.inc.bak b/src/modVDDesignFrame.inc.bak
new file mode 100644
index 00000000..fc740aa1
--- /dev/null
+++ b/src/modVDDesignFrame.inc.bak
@@ -0,0 +1,69 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+#include once "modVDDesignFrame.bi"
+
+' ========================================================================================
+' Process WM_PAINT message for Visual Designer Frame
+' ========================================================================================
+private Function DesignerFrame_OnPaint( ByVal HWnd As HWnd) As LRESULT
+
+ Dim As PAINTSTRUCT ps
+ Dim As HDC hDC
+
+ hDC = BeginPaint(hWnd, @ps)
+
+ dim pDoc as clsDocument ptr = gApp.GetDocumentPtrByWindow(hwnd)
+ if pDoc THEN DrawGrabHandles(hDC, pDoc, true)
+
+ EndPaint hWnd, @ps
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for Visual Designer frame
+' ========================================================================================
+private Function DesignerFrame_OnDestroy(HWnd As HWnd) As LRESULT
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(hWnd)
+ if pWindow then Delete pWindow
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Visual Designer Frame Window procedure (the container frame window)
+' ========================================================================================
+public Function DesignerFrame_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_PAINT, DesignerFrame_OnPaint)
+ HANDLE_MSG (HWnd, WM_DESTROY, DesignerFrame_OnDestroy)
+
+ case WM_LBUTTONDOWN: HandleDesignerLButtonDown(HWND)
+ case WM_LBUTTONUP: HandleDesignerLButtonUp(HWND)
+ case WM_MOUSEMOVE: HandleDesignerMouseMove(HWND)
+
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
diff --git a/src/modVDDesignMain.bi b/src/modVDDesignMain.bi
index 40e7f8ec..03ba44b2 100644
--- a/src/modVDDesignMain.bi
+++ b/src/modVDDesignMain.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDDesignMain.bi.bak b/src/modVDDesignMain.bi.bak
new file mode 100644
index 00000000..40e7f8ec
--- /dev/null
+++ b/src/modVDDesignMain.bi.bak
@@ -0,0 +1,20 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#define IDC_DESIGNFRAME 100
+#define IDC_DESIGNFORM 101
+#define IDC_DESIGNTABCTRL 102
+
+declare Function DesignerMain_WndProc( ByVal HWnd As HWnd, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM ) As LRESULT
diff --git a/src/modVDDesignMain.inc b/src/modVDDesignMain.inc
index 45296e01..e9e51ab5 100644
--- a/src/modVDDesignMain.inc
+++ b/src/modVDDesignMain.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDDesignMain.inc.bak b/src/modVDDesignMain.inc.bak
new file mode 100644
index 00000000..45296e01
--- /dev/null
+++ b/src/modVDDesignMain.inc.bak
@@ -0,0 +1,72 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+' VISUAL DESIGNER ROUTINES
+'
+
+#include once "modVDDesignMain.bi"
+
+
+' ========================================================================================
+' Process WM_DESTROY message for Visual Designer main window
+' ========================================================================================
+private Function DesignerMain_OnDestroy( byval HWnd As HWnd ) As LRESULT
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(hWnd)
+ if pWindow then Delete pWindow
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Visual Designer Main (hWindow) Window procedure
+' ========================================================================================
+public Function DesignerMain_WndProc( ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_DESTROY, DesignerMain_OnDestroy)
+
+ CASE WM_SIZE
+ ' In the WM_SIZE message we need to check the validity of the pointers
+ ' because this message is sent before we have had time to store them.
+ DIM pWindow AS CWindow PTR = cast(CWindow PTR, GetWindowLongPtr(hwnd, 0))
+ DIM pScrollWindow AS CScrollWindow PTR
+ IF pWindow THEN
+ ' Resize the DesignerFrame to be same size as DesignerMain
+ Dim pFrame As CWindow Ptr = AfxCWindowPtr(GetDlgItem(hWnd, IDC_DESIGNFRAME))
+ if pFrame THEN pFrame->SetClientSize(pWindow->ClientWidth, pWindow->ClientHeight)
+ pScrollWindow = pWindow->ScrollWindowPtr
+ end if
+ IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
+ EXIT FUNCTION
+
+ CASE WM_VSCROLL, WM_HSCROLL
+ DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
+ IF pScrollWindow THEN
+ if uMsg = WM_VSCROLL then pScrollWindow->OnVScroll(wParam, lParam)
+ if uMsg = WM_HSCROLL then pScrollWindow->OnHScroll(wParam, lParam)
+ AfxRedrawWindow( GetDlgItem(hwnd, IDC_DESIGNFRAME) )
+ end if
+ EXIT FUNCTION
+
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
diff --git a/src/modVDProperties.bi b/src/modVDProperties.bi
index 00ab5db5..f79354cb 100644
--- a/src/modVDProperties.bi
+++ b/src/modVDProperties.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDProperties.bi.bak b/src/modVDProperties.bi.bak
new file mode 100644
index 00000000..00ab5db5
--- /dev/null
+++ b/src/modVDProperties.bi.bak
@@ -0,0 +1,62 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+Enum FontStyles
+ Normal = 0
+ Bold = 1
+ Italic = 2
+ Strikeout = 4
+ Underline = 8
+End Enum
+
+Enum FontCharset
+ Default = DEFAULT_CHARSET
+ Ansi = ANSI_CHARSET
+ Arabic = ARABIC_CHARSET
+ Baltic = BALTIC_CHARSET
+ ChineseBig5 = CHINESEBIG5_CHARSET
+ EastEurope = EASTEUROPE_CHARSET
+ GB2312 = GB2312_CHARSET
+ Greek = GREEK_CHARSET
+ Hangul = HANGUL_CHARSET
+ Hebrew = HEBREW_CHARSET
+ Johab = JOHAB_CHARSET
+ Mac = MAC_CHARSET
+ OEM = OEM_CHARSET
+ Russian = RUSSIAN_CHARSET
+ Shiftjis = SHIFTJIS_CHARSET
+ Symbol = SYMBOL_CHARSET
+ Thai = THAI_CHARSET
+ Turkish = TURKISH_CHARSET
+ Vietnamese = VIETNAMESE_CHARSET
+End Enum
+
+Declare Function DisplayPropertyDetails() as Long
+Declare Function DisplayEventDetails() as Long
+declare function GetRGBColorFromProperty( byref wszPropValue as wstring ) as COLORREF
+declare function SetLogFontFromPropValue( byref wszPropValue as wstring ) as LOGFONT
+declare function SetPropValueFromLogFont( byref lf as LOGFONT ) as CWSTR
+Declare Function IsPropertyExists( byval pCtrl as clsControl ptr, byval wszPropName as CWSTR ) as boolean
+Declare Function IsEventExists( byval pCtrl as clsControl ptr, byval wszEventName as CWSTR ) as boolean
+Declare Function GetControlPropertyPtr( byval pCtrl as clsControl ptr, byval wszPropName as CWSTR ) as clsProperty Ptr
+Declare Function GetControlProperty( byval pCtrl as clsControl ptr, byval wszPropName as CWSTR ) as CWSTR
+Declare Function SetControlProperty( byval pCtrl as clsControl ptr, byval wszPropName as CWSTR, byval wszPropValue as CWSTR ) as long
+Declare Function SetControlEvent( byval pCtrl as clsControl ptr, byval wszEventName as CWSTR, byval bIsSelected as boolean ) as long
+
+
+
+
+
+
diff --git a/src/modVDProperties.inc b/src/modVDProperties.inc
index d29961df..e6d1684a 100644
--- a/src/modVDProperties.inc
+++ b/src/modVDProperties.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDProperties.inc.bak b/src/modVDProperties.inc.bak
new file mode 100644
index 00000000..d29961df
--- /dev/null
+++ b/src/modVDProperties.inc.bak
@@ -0,0 +1,683 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modVDProperties.bi"
+#include once "clsApp.bi"
+#include once "clsDocument.bi"
+#include once "modVDColors.bi"
+
+
+
+' ========================================================================================
+' Display the Name and Description of the current selected Property.
+' ========================================================================================
+public function DisplayPropertyDetails() as Long
+
+ Dim As HWnd hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES)
+ Dim As HWnd hPropName = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LBLPROPNAME)
+ Dim As HWnd hPropDescribe = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LBLPROPDESCRIBE )
+
+ dim pProp as clsProperty ptr = GetActivePropertyPtr
+
+ ' If the listbox is not visible then do not set the labels. It could be that a different
+ ' listbox (Events) is active and is using the labels to display other information.
+ if IsWindowVisible(hList) = false then exit function
+
+ dim as CWSTR wszPropName, wszPropDescribe
+ if pProp then
+ wszPropName = pProp->wszPropName
+ gApp.PreviousPropName = pProp->wszPropName
+ END IF
+
+ select case ucase(wszPropName)
+ CASE "(CUSTOM)"
+ wszPropDescribe = "Set custom properties related to this object."
+ CASE "NAME"
+ wszPropDescribe = "Indicates the name used in code to identify the object."
+ case "ACCEPTSRETURN"
+ wszPropDescribe = "Indicates if return characters are accepted as input for multiline edit controls."
+ case "ACCEPTSTAB"
+ wszPropDescribe = "Indicates if tab characters are accepted as input for multiline edit controls."
+ case "ACCEPTBUTTON"
+ wszPropDescribe = "If this is set, the button is 'clicked' whenever the user presses the 'ENTER' key."
+ case "ALLOWCOLUMNREORDER"
+ wszPropDescribe = "Gets or sets a value indicating whether the user can drag column headers to reorder columns in the control."
+ case "ALLOWDROP"
+ wszPropDescribe = "Indicates whether the control can accept data that the user drags onto it."
+ case "ALLOWFOCUS"
+ wszPropDescribe = "Indicates whether the control can receive keyboard focus."
+ case "ALLOWFOCUSRECT"
+ wszPropDescribe = "Enables or disables drawing the focus rectangle for a Button control. ThemeSupport property must be set to False."
+ case "ANCHOR"
+ wszPropDescribe = "Specifies how a control anchors to the edges of its Form."
+ case "AUTORESET"
+ wszPropDescribe = "Gets or sets a value indicating whether the Timer should raise the Elapsed event only once (false) or repeatedly (true)."
+ case "BACKCOLOR"
+ wszPropDescribe = "The background color of the control. For Button controls the ThemeSupport property must be set to False."
+ case "BACKCOLORDOWN"
+ wszPropDescribe = "The background color of the control when pressed. For Button controls the ThemeSupport property must be set to False."
+ case "BACKCOLORHOT"
+ wszPropDescribe = "The background color of the control when the mouse is over the control. For Button controls the ThemeSupport property must be set to False."
+ case "BACKCOLORSELECTED"
+ wszPropDescribe = "The background color of the selected item in a control."
+ case "BACKGROUNDIMAGE"
+ wszPropDescribe = "The background image used for the control."
+ case "BACKGROUNDIMAGELAYOUT"
+ wszPropDescribe = "The background image layout used for the control."
+ case "BORDERSTYLE"
+ wszPropDescribe = "Indicates the appearance and behaviour of the border of the control."
+ case "BUTTONSTYLE"
+ wszPropDescribe = "Tabs appear as buttons and no border is drawn around the display area of the Tab Control."
+ case "CALENDARRIGHTALIGN"
+ wszPropDescribe = "Indicates whether the drop-down calendar will be right aligned with the control instead of left aligned which is the default."
+ case "CANCELBUTTON"
+ wszPropDescribe = "If this is set, the button is 'clicked' whenever the user presses the 'ESC' key."
+ case "CHARACTERCASING"
+ wszPropDescribe = "Indicates if all characters should be left alone or converted to uppercase or lowercase."
+ case "CHECKALIGN"
+ wszPropDescribe = "Determines the location of the check box inside the control."
+ case "CHECKBOXES"
+ wszPropDescribe = "Gets or sets a value indicating whether a check box appears next to each item in the control."
+ case "CHECKED"
+ wszPropDescribe = "Indicates whether the control is checked."
+ case "CHECKSTATE"
+ wszPropDescribe = "Indicates the state of the control."
+ case "CHILDFORM"
+ wszPropDescribe = "Determines whether a form can act like a child panel control or child tab page. When set to True, ControlBox, MaximizeBox, MinimizeBox, and BorderStyle are ignored."
+ case "CHILDFORMPARENT"
+ wszPropDescribe = "Gets or sets the parent form of a form with ChildForm property set to True."
+ case "COLUMNWIDTH"
+ wszPropDescribe = "Indicates how wide each column should be in a multicolumn listbox."
+ case "CONTROLBOX"
+ wszPropDescribe = "Determines whether a form has a Control/System menu box."
+ case "CUEBANNERTEXT"
+ wszPropDescribe = "Sets the textual cue, or tip, that is displayed by the edit control to prompt the user for information."
+ CASE "DEFAULTCHARACTER"
+ wszPropDescribe = "A default character that the control substitutes for each invalid character in the user input."
+ CASE "DROPDOWNSTYLE"
+ wszPropDescribe = "Specifies whether the list is always displayed or whether the list is displayed in a drop-down. Also specifies whether the text portion can be edited."
+ case "ENABLED"
+ wszPropDescribe = "Indicates whether the control is enabled."
+ case "FONT"
+ wszPropDescribe = "The font used to display text in the control."
+ case "FORECOLOR"
+ wszPropDescribe = "The foreground color of the control which is used to display text."
+ case "FORECOLORHOT"
+ wszPropDescribe = "The foreground color of the control when the mouse is over the control."
+ case "FORECOLORSELECTED"
+ wszPropDescribe = "The foreground color of the selected item in a control."
+ case "DATEFORMAT"
+ wszPropDescribe = "Gets or sets the format of the date and time displayed in the control."
+ case "FADEBUTTONS"
+ wszPropDescribe = "Fade expand/collapse buttons in or out when the mouse moves away or into a state of hovering over the control."
+ case "FIXEDWIDTHTABS"
+ wszPropDescribe = "Indicates that all tabs in a tab control are the same width."
+ case "FORCEIMAGELEFT"
+ wszPropDescribe = "Forces the tab image to the left, leaving the label centered in a tab control."
+ case "FORCELABELLEFT"
+ wszPropDescribe = "Forces the tab image and tab label to the left in a tab control."
+ case "FORMATCUSTOM"
+ wszPropDescribe = "Gets or sets the custom format when the DateFormat property is set to CustomFormat."
+ case "FULLROWSELECT"
+ wszPropDescribe = "Gets or sets a value indicating whether clicking an item selects all its subitems (for TreeViews this style cannot be used in conjunction with the ShowLines property.)"
+ case "GRIDLINES"
+ wszPropDescribe = "Gets or sets a value indicating whether grid lines appear between the rows and columns containing the items and subitems in the control."
+ case "GROUPNAME"
+ wszPropDescribe = "Controls with the same GroupName form part of the same OptionButton group."
+ case "HEADERTHEMED"
+ wszPropDescribe = "Gets or sets whether to apply Windows Theme style to the ListView header."
+ case "HEADERSTYLE"
+ wszPropDescribe = "Gets or sets the column header style."
+ case "HEADERHEIGHT"
+ wszPropDescribe = "Gets or sets the column header height."
+ case "HEADERBACKCOLOR"
+ wszPropDescribe = "The background color of the ListView column display text."
+ case "HEADERFORECOLOR"
+ wszPropDescribe = "The foreground color of the ListView column display text."
+ case "HIDESELECTION"
+ wszPropDescribe = "Indicates that the selection should be hidden when the control loses focus."
+ case "HORIZONTALEXTENT"
+ wszPropDescribe = "The width in pixels by which a listbox can be scrolled horizontally. Only valid if HorizontalScrollBars is true."
+ case "HOTTRACKING"
+ wszPropDescribe = "Determines whether items under the mouse pointer are automatically highlighted."
+ case "ICON"
+ wszPropDescribe = "The icon is displayed in the form's system menu box and when the form is minimized (use RC_DATA in Image Manager)."
+ case "IMAGE"
+ wszPropDescribe = "The image that will be displayed on the control (use RC_DATA in Image Manager)."
+ case "IMAGEHIGHDPI"
+ wszPropDescribe = "Determines whether high DPI scaling will be applied to the Image."
+ case "IMAGESCALING"
+ wszPropDescribe = "Determines the scaling (if any) to apply to the Image."
+ case "IMAGEWIDTH", "IMAGEHEIGHT"
+ wszPropDescribe = "The size of the image in pixels."
+ case "IMAGEALIGN"
+ wszPropDescribe = "The alignment of the image that will be displayed on the control. MiddleCenter will disable displaying Text."
+ case "IMAGEMARGIN"
+ wszPropDescribe = "The margin in pixels to apply to the image of a Button control."
+ CASE "INPUTSTRING"
+ wszPropDescribe = "A mask template string that specifies the literal characters that can appear at each position in the user input. Use the underscore character as a character placeholder."
+' case "INDEX"
+' wszPropDescribe = "The position of the control within the OptionButton group."
+ case "ITEMHEIGHT"
+ wszPropDescribe = "Determines the height of an individual item in a control (in pixels)."
+ case "INTEGRALHEIGHT"
+ wszPropDescribe = "Indicates whether the list can contain only complete items."
+ case "INTERVAL"
+ wszPropDescribe = "Gets or sets the interval, expressed in milliseconds, at which to raise the Elapsed event."
+ case "KEYPREVIEW"
+ wszPropDescribe = "Determines whether the form will receive key events before the event is passed to the control that has focus."
+ case "LABELEDIT"
+ wszPropDescribe = "Gets or sets a value indicating whether the user can edit the labels of items in the control."
+ case "LOCKED"
+ wszPropDescribe = "Determines if the control can be moved or resized."
+ case "MARQUEE"
+ wszPropDescribe = "The progress indicator does not grow in size but instead moves repeatedly along the length of the bar, indicating activity without specifying what proportion of the progress is complete."
+ case "MARQUEEANIMATIONSPEED"
+ wszPropDescribe = "Time, in milliseconds, between marquee animation updates."
+ CASE "MASKSTRING"
+ wszPropDescribe = "A mask string that specifies the type of character that can appear at each position in the user input.."
+ case "MAXIMIZEBOX"
+ wszPropDescribe = "Determines whether a form has a maximize box in the upper-right corner of its caption bar."
+ case "MINIMIZEBOX"
+ wszPropDescribe = "Determines whether a form has a minimize box in the upper-right corner of its caption bar."
+ case "MAXIMUM"
+ wszPropDescribe = "Gets or sets the maximum value of the range of the control."
+ case "MAXLENGTH"
+ wszPropDescribe = "Gets or sets the maximum text limit for an edit control."
+ case "MAXIMUMWIDTH"
+ wszPropDescribe = "The maximun width size the form can be resized to."
+ case "MAXIMUMHEIGHT"
+ wszPropDescribe = "The maximun height size the form can be resized to."
+ case "MINIMUM"
+ wszPropDescribe = "Gets or sets the minimum value of the range of the control"
+ case "MINIMUMWIDTH"
+ wszPropDescribe = "The minimum width size the form can be resized to."
+ case "MINIMUMHEIGHT"
+ wszPropDescribe = "The minimum height size the form can be resized to."
+ case "MULTICOLUMN"
+ wszPropDescribe = "Indicates if values should be displayed in columns horizontally."
+ case "MULTILINE"
+ wszPropDescribe = "Controls whether the text of the control can span more than one line."
+ case "MULTISELECT"
+ wszPropDescribe = "Gets or sets a value indicating whether multiple items can be selected."
+ case "ODDROWCOLOR"
+ wszPropDescribe = "The background color of alternate odd rows in a ListView."
+ case "ODDROWCOLORENABLED"
+ wszPropDescribe = "Indicates whether to use the color defined by the OddRowColor property."
+ case "PASSWORDCHAR"
+ wszPropDescribe = "Indicates the character to display for password input for single-line edit control."
+ case "READONLY"
+ wszPropDescribe = "Controls whether the text in the edit control can be changed or not."
+ case "RESIZETABPAGES"
+ wszPropDescribe = "Indicates whether the control will automatically resize the child tab pages to cover the entire control's client area."
+ case "SCROLLALWAYSVISIBLE"
+ wszPropDescribe = "Indicates if the listbox should always have a scrollbar present regardless of how many items are in it."
+ case "SELECTIONMODE"
+ wszPropDescribe = "Indicates if the listbox is to be simple-select, multiselect, or not selectable."
+ case "SHORTDAYNAMES"
+ wszPropDescribe = "Short day names are displayed in the month calendar header."
+ case "SHOWINTASKBAR"
+ wszPropDescribe = "Determines whether the form appears in the Windows Taskbar."
+ case "SCROLLABLE"
+ wszPropDescribe = "Gets or sets a value indicating whether the control displays scroll bars when they are needed."
+ case "SHOWROOTLINES"
+ wszPropDescribe = "Gets or sets a value indicating whether lines are drawn between the tree nodes that are at the root of the control."
+ case "SHOWPLUSMINUS"
+ wszPropDescribe = "Gets or sets a value indicating whether the expand/collapse image is displayed next to tree nodes that contain child tree nodes."
+ case "SHOWLINES"
+ wszPropDescribe = "Gets or sets a value indicating whether lines are drawn between the tree nodes in the control."
+ case "SORTED"
+ wszPropDescribe = "Controls whether the list is sorted."
+ case "SORTING"
+ wszPropDescribe = "Gets or sets the sort order for items in the control."
+ case "LEFT", "TOP"
+ wszPropDescribe = "The coordinates of the upper-left corner of the control relative to the upper-left corner of its container."
+ case "WIDTH", "HEIGHT"
+ wszPropDescribe = "The size of the control in pixels."
+ case "SELECTEDDATE"
+ wszPropDescribe = "Gets or sets the selected date in the format YYYYMMDD for a Month Calendar or DateTimePicker control."
+ case "SELECTEDTIME"
+ wszPropDescribe = "Gets or sets the selected time in the format HHMMSS for a DateTimePicker control."
+ case "SHOWUPDOWN"
+ wszPropDescribe = "Gets or sets a value indicating whether an up-down control is used to adjust the date/time value."
+ case "STARTPOSITION"
+ wszPropDescribe = "Determines the position of a form when it first appears."
+ case "STARTGROUP"
+ wszPropDescribe = "Indicates that this control starts the option button group (WS_GROUP)."
+ case "STEPVALUE"
+ wszPropDescribe = "Gets or sets the amount by which a call to the PerformStep method increases the current position of the progress bar."
+ case "TABINDEX"
+ wszPropDescribe = "Determines the index in the TAB order that this control will occupy."
+ case "TABSTOP"
+ wszPropDescribe = "Indicates whether the user can use the TAB key to give focus to the control."
+ case "TABIMAGESIZE"
+ wszPropDescribe = "Gets or sets the size (in pixels) of images for tabs in a tab control."
+ case "TABTOPPADDING"
+ wszPropDescribe = "Gets or sets the amount of vertical padding around each tab's icon and label in a tab control."
+ case "TABSIDEPADDING"
+ wszPropDescribe = "Gets or sets the amount of horizontal padding around each tab's icon and label in a tab control."
+ case "TABHEIGHT"
+ wszPropDescribe = "Gets or sets the height of tabs in a tab control that have the property FixedWidthTabs equal True."
+ case "TABWIDTH"
+ wszPropDescribe = "Gets or sets the width of tabs in a tab control that have the property FixedWidthTabs equal True."
+ case "TAG"
+ wszPropDescribe = "User-defined text data associated with the control."
+ case "TEXT"
+ wszPropDescribe = "The text associated with the control."
+ case "TEXTALIGN"
+ wszPropDescribe = "The alignment of the text that will be displayed on the control."
+ case "TEXTFORECOLOR"
+ wszPropDescribe = "The foreground color of the displayed control text. For Button controls the ThemeSupport property must be set to False."
+ case "TEXTBACKCOLOR"
+ wszPropDescribe = "The background color of the displayed control text. For Button controls the ThemeSupport property must be set to False."
+ case "TEXTFORECOLORDOWN"
+ wszPropDescribe = "The foreground color of the displayed control text when pressed. For Button controls the ThemeSupport property must be set to False."
+ case "TEXTBACKCOLORDOWN"
+ wszPropDescribe = "The background color of the displayed control text when pressed. For Button controls the ThemeSupport property must be set to False."
+ case "TEXTMARGIN"
+ wszPropDescribe = "The margin in pixels to apply to the text of a Button control."
+ case "TEXTSCROLLBARS"
+ wszPropDescribe = "Indicates for multiline edit controls which scroll bars will be shown for the control."
+ case "THEMESUPPORT"
+ wszPropDescribe = "If True, the Windows Theme is applied to the control. Set to False to specify a BackColor and/or ForeColor for the control."
+ case "THREESTATE"
+ wszPropDescribe = "Indicates whether the checkbox will allow three check states rather than two."
+ case "TODAYCIRCLE"
+ wszPropDescribe = "Indicates whether to circle the Today date in a month calendar control."
+ case "TODAYSELECTOR"
+ wszPropDescribe = "Indicates whether to display the Today date at the bottom of the month calendar control. "
+ case "TOOLTIP"
+ wszPropDescribe = "Sets or gets tooltip text that will display when the mouse cursor hovers over the control."
+ case "TOOLTIPBALLOON"
+ wszPropDescribe = "Sets the tooltip to display with a balloon style."
+ case "TRAILINGDATES"
+ wszPropDescribe = "Indicates whether to display the dates from the previous and next months within the current month's calendar."
+ case "WEEKNUMBERS"
+ wszPropDescribe = "Indicates whether to display week numbers (1-52) to the left of each row of days."
+ case "TOGGLEMODE"
+ wszPropDescribe = "Determines if the button allows dual states to toggle from ON (pressed) to OFF (unpressed)."
+ case "USEMNEMONIC"
+ wszPropDescribe = "If True, the first character preceded by an ampersand will be used as the button's mnemonic key."
+ case "USETABSTOPS"
+ wszPropDescribe = "Indicates if TAB character should be expanded into full spacing."
+ CASE "WINDOWSTATE"
+ wszPropDescribe = "Determines the initial visual state of the form."
+ CASE "WORDWRAP"
+ wszPropDescribe = "Indicates if lines are automatically word wrapped for multiline edit controls."
+ case "VALUE"
+ wszPropDescribe = "Gets or sets the current position of the progress bar."
+ CASE "VALIDCHARACTERS"
+ wszPropDescribe = "Specifies a string of valid characters that the user can enter. Empty string means all characters are valid."
+ case "VERTICAL"
+ wszPropDescribe = "The progress bar displays progress status vertically, from bottom to top."
+ CASE "VISIBLE"
+ wszPropDescribe = "Determines whether the control is visible or hidden."
+ case else
+ wszPropDescribe = ""
+ END SELECT
+
+ AfxSetWindowText(hPropName, wszPropName)
+ AfxSetWindowText(hPropDescribe, wszPropDescribe)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Display the Name and Description of the current selected Event.
+' ========================================================================================
+public function DisplayEventDetails() as Long
+
+ Dim As HWnd hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTEVENTS)
+ Dim As HWnd hEventName = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LBLPROPNAME)
+ Dim As HWnd hEventDescribe = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LBLPROPDESCRIBE )
+
+ dim pEvent as clsEvent ptr = GetActiveEventPtr()
+
+ ' If the listbox is not visible then do not set the labels. It could be that a different
+ ' listbox (Properties) is active and is using the labels to display other information.
+ if IsWindowVisible(hList) = false then exit function
+
+ dim as CWSTR wszEventName, wszEventDescribe
+ if pEvent then
+ wszEventName = pEvent->wszEventName
+ gApp.PreviousEventName = pEvent->wszEventName
+ END IF
+
+ select case ucase(wszEventName)
+ case "ALLEVENTS"
+ wszEventDescribe = "Allows the user to respond to all Windows messages for the control."
+ case "BEFOREEXPAND"
+ wszEventDescribe = "Occurs before the tree node is expanded."
+ case "AFTEREXPAND"
+ wszEventDescribe = "Occurs after the tree node is expanded."
+ case "BEFORECOLLAPSE"
+ wszEventDescribe = "Occurs before the tree node is collapsed."
+ case "AFTERCOLLAPSE"
+ wszEventDescribe = "Occurs after the tree node is collapsed."
+ case "BEFORESELECT"
+ wszEventDescribe = "Occurs before the tree node is selected."
+ case "AFTERSELECT"
+ wszEventDescribe = "Occurs after the tree node is selected."
+ case "BEFORECHECK"
+ wszEventDescribe = "Occurs before the tree node check box is checked."
+ case "AFTERCHECK"
+ wszEventDescribe = "Occurs after the tree node check box is checked."
+ case "LOAD"
+ wszEventDescribe = "Occurs whenever the user loads the form. Form and control window handles are valid at this point."
+ CASE "SHOWN"
+ wszEventDescribe = "Occurs whenever the form is first shown."
+ CASE "ACTIVATED"
+ wszEventDescribe = "Occurs whenever the form is activated."
+ CASE "DATETIMECHANGED"
+ wszEventDescribe = "Indicates that a change has occured in a date and time picker control."
+ CASE "DEACTIVATE"
+ wszEventDescribe = "Occurs whenever the form is deactivated."
+ CASE "DESTROY"
+ wszEventDescribe = "Occurs immediately before the control is about to be destroyed and all resources associated with it released."
+ CASE "DROPDOWN"
+ wszEventDescribe = "Occurs when the drop-down portion of the combobox is shown."
+ CASE "DROPDOWNCLOSED"
+ wszEventDescribe = "Indicates that the drop-down portion of the combobox has closed."
+ CASE "GOTFOCUS"
+ wszEventDescribe = "Occurs when the control receives focus."
+ case "INITIALIZE"
+ wszEventDescribe = "Occurs before a form loads. Form and control window handles are invalid at this point."
+ CASE "LOSTFOCUS"
+ wszEventDescribe = "Occurs when the control loses focus."
+ CASE "RESIZE"
+ wszEventDescribe = "Occurs when a form is resized."
+ CASE "FORMCLOSING"
+ wszEventDescribe = "Occurs whenever the user closes the form, before the form has been closed."
+ CASE "FORMCLOSED"
+ wszEventDescribe = "Occurs whenever the user closes the form, after the form has been closed."
+ CASE "FORMREADY"
+ wszEventDescribe = "Occurs when the form is fully loaded and ready for user interaction."
+ CASE "MOVE"
+ wszEventDescribe = "Occurs when a control is moved."
+ CASE "CLICK"
+ wszEventDescribe = "Occurs when a control is clicked."
+ CASE "RIGHTCLICK"
+ wszEventDescribe = "Occurs when right mouse button clicked on the control."
+ CASE "DOUBLECLICK"
+ wszEventDescribe = "Occurs when the ListView is double clicked by the mouse."
+ CASE "COLUMNCLICK"
+ wszEventDescribe = "Occurs when the user clicks one of the column headers in a ListView."
+ case "ELAPSED"
+ wszEventDescribe = "Occurs when the Timer interval elapses."
+ CASE "ITEMSELECTIONCHANGED"
+ wszEventDescribe = "Occurs when the selected row in a ListView changes."
+ CASE "DROPFILES"
+ wszEventDescribe = "Occurs whenever files are dropped on a control with the AllowDrop property enabled."
+ CASE "MESSAGEPUMPHOOK"
+ wszEventDescribe = "User defined code injected directly into the message pump."
+ CASE "MOUSEMOVE"
+ wszEventDescribe = "Occurs when the mouse pointer is moved over the control."
+ CASE "MOUSEDOWN"
+ wszEventDescribe = "Occurs when the mouse pointer is over a control and a mouse button is pressed."
+ CASE "MOUSEUP"
+ wszEventDescribe = "Occurs when the mouse pointer is over a control and a mouse button is released."
+ CASE "MOUSEDOUBLECLICK"
+ wszEventDescribe = "Occurs when the control is double clicked by the mouse."
+ CASE "MOUSEENTER"
+ wszEventDescribe = "Occurs when the mouse pointer enters the control."
+ CASE "MOUSEHOVER"
+ wszEventDescribe = "Occurs when the mouse pointer rests on the control."
+ CASE "MOUSELEAVE"
+ wszEventDescribe = "Occurs when the mouse pointer leaves the control."
+ case "TEXTCHANGED"
+ wszEventDescribe = "Occurs when the Text property is changed by either a programmatic modification or user interaction."
+ CASE "KEYDOWN"
+ wszEventDescribe = "Occurs when a key is first pressed."
+ CASE "KEYPRESS"
+ wszEventDescribe = "Occurs when a control has focus and the user presses and releases a key."
+ CASE "KEYUP"
+ wszEventDescribe = "Occurs when a key is released."
+ case "SELECTIONCHANGED"
+ ' MonthCalendar/RichEdit
+ wszEventDescribe = "Occurs in response to any selection change."
+ case "SELECTED" ' tabcontrol
+ wszEventDescribe = "Occurs when a tab is selected."
+ case "SELECTING" ' tabcontrol
+ wszEventDescribe = "Occurs before a tab is selected, enabling a handler to cancel the tab change."
+ case else
+
+ wszEventDescribe = ""
+ END SELECT
+
+ AfxSetWindowText(hEventName, wszEventName)
+ AfxSetWindowText(hEventDescribe, wszEventDescribe)
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Get the RGB (BGR) color value from the specified property value
+' ========================================================================================
+public function GetRGBColorFromProperty( byref wszPropValue as wstring ) as COLORREF
+ if len(wszPropValue) = 0 then exit function
+
+ dim as CWSTR wszList, wszValue
+ wszList = AfxStrParse(wszPropValue, 1, "|")
+ wszValue = AfxStrParse(wszPropValue, 2, "|")
+
+ dim as long nLookFor
+ select case **wszList
+ CASE "CUSTOM"
+ return val(wszValue)
+ case "COLORS": nLookFor = COLOR_COLORS
+ case "SYSTEM": nLookFor = COLOR_SYSTEM
+ end select
+ for i as long = lbound(gColors) to ubound(gColors)
+ if gColors(i).ColorType = nLookFor then
+ if gColors(i).wszColorName = wszValue then
+ return gColors(i).ColorValue
+ end if
+ end if
+ NEXT
+ function = 0
+end function
+
+
+' ========================================================================================
+' Set values of a LOGFONT based on property value string
+' ========================================================================================
+public function SetLogFontFromPropValue( byref wszPropValue as wstring ) as LOGFONT
+ dim lf as LOGFONT
+ lf.lfFaceName = AfxStrParse(wszPropValue, 1, ",")
+ lf.lfHeight = AfxGetFontHeight(val(AfxStrParse(wszPropValue, 2, ",")))
+ lf.lfWeight = val(AfxStrParse(wszPropValue, 3, ","))
+ lf.lfItalic = val(AfxStrParse(wszPropValue, 4, ","))
+ lf.lfUnderline = val(AfxStrParse(wszPropValue, 5, ","))
+ lf.lfStrikeOut = val(AfxStrParse(wszPropValue, 6, ","))
+ lf.lfCharSet = val(AfxStrParse(wszPropValue, 7, ","))
+ function = lf
+end function
+
+
+' ========================================================================================
+' Set values of a property value string based on LOGFONT
+' ========================================================================================
+public function SetPropValueFromLogFont( byref lf as LOGFONT ) as CWSTR
+ dim as CWSTR wszPropValue = _
+ lf.lfFaceName & "," & _
+ AfxGetFontPointSize(lf.lfHeight) & "," & _
+ lf.lfWeight & "," & _
+ lf.lfItalic & "," & _
+ lf.lfUnderline & "," & _
+ lf.lfStrikeOut & "," & _
+ lf.lfCharSet
+ function = wszPropValue
+end function
+
+
+' ========================================================================================
+' Create a default value for a FONT property of a control
+' ========================================================================================
+private function CreateDefaultFontPropValue() as CWSTR
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd_FRMMAIN)
+ if pWindow = 0 THEN return ""
+
+ if gApp.IsProjectActive then
+ if len(gApp.ProjectDefaultFont) then
+ return gApp.ProjectDefaultFont
+ end if
+ end if
+
+ ' Otherwise, no active project or a ProjectDefaultFont is not available
+ dim lf as LOGFONT
+ GetObject(pWindow->Font, sizeof(lf), @lf)
+
+ return SetPropValueFromLogFont(lf)
+end function
+
+
+' ========================================================================================
+' Determine if an Property exists for a Form
+' ========================================================================================
+public function IsPropertyExists( byval pCtrl as clsControl ptr, _
+ byval wszPropName as CWSTR _
+ ) as boolean
+ if pCtrl = 0 THEN return false
+ dim as long lb = lbound(pCtrl->Properties)
+ dim as long ub = ubound(pCtrl->Properties)
+ dim as CWSTR wszPropName_ucase = ucase(wszPropName)
+
+ for i as long = lb to ub
+ if ucase(pCtrl->Properties(i).wszPropName) = wszPropName_ucase THEN
+ return true
+ END IF
+ NEXT
+ return false
+end function
+
+
+' ========================================================================================
+' Determine if an Event exists for a Form
+' ========================================================================================
+public function IsEventExists( byval pCtrl as clsControl ptr, _
+ byval wszEventName as CWSTR _
+ ) as boolean
+ if pCtrl = 0 THEN return false
+ dim as long lb = lbound(pCtrl->Events)
+ dim as long ub = ubound(pCtrl->Events)
+ dim as CWSTR wszEventName_ucase = ucase(wszEventName)
+
+ for i as long = lb to ub
+ if ucase(pCtrl->Events(i).wszEventName) = wszEventName_ucase THEN
+ return true
+ END IF
+ NEXT
+ return false
+end function
+
+
+' ========================================================================================
+' Retrieve the Property pointer for the specified control property
+' ========================================================================================
+public function GetControlPropertyPtr( byval pCtrl as clsControl ptr, _
+ byval wszPropName as CWSTR _
+ ) as clsProperty Ptr
+ if pCtrl = 0 THEN return 0
+ dim as long lb = lbound(pCtrl->Properties)
+ dim as long ub = ubound(pCtrl->Properties)
+ dim as CWSTR wszPropName_ucase = ucase(wszPropName)
+
+ ' All property values are returned as strings.
+ for i as long = lb to ub
+ if ucase(pCtrl->Properties(i).wszPropName) = wszPropName_ucase THEN
+ return @pCtrl->Properties(i)
+ END IF
+ NEXT
+
+ return 0
+end function
+
+
+' ========================================================================================
+' Retrieve the value for the specified control property
+' ========================================================================================
+public function GetControlProperty( byval pCtrl as clsControl ptr, _
+ byval wszPropName as CWSTR _
+ ) as CWSTR
+ dim pProp as clsProperty ptr = GetControlPropertyPtr(pCtrl, wszPropName)
+ if pProp then return pProp->wszPropValue
+ return 0
+end function
+
+
+' ========================================================================================
+' Set the value for the specified control property
+' ========================================================================================
+public function SetControlProperty( byval pCtrl as clsControl ptr, _
+ byval wszPropName as CWSTR, _
+ byval wszPropValue as CWSTR _
+ ) as long
+ if pCtrl = 0 then exit function
+ dim as long lb = lbound(pCtrl->Properties)
+ dim as long ub = ubound(pCtrl->Properties)
+ dim as CWSTR wszPropName_ucase = ucase(wszPropName)
+
+ for i as long = lb to ub
+ if ucase(pCtrl->Properties(i).wszPropName) = wszPropName_ucase THEN
+ ' Save the previous property value so that ApplyProperties will only
+ ' act on any properties that have actually changed.
+ pCtrl->Properties(i).wszPropValuePrev = pCtrl->Properties(i).wszPropValue
+ pCtrl->Properties(i).wszPropValue = wszPropValue
+ exit for
+ END IF
+ NEXT
+ function = 0
+end function
+
+
+' ========================================================================================
+' Add an event to the incoming control and optionally a value
+' ========================================================================================
+private function AddControlEvent( byval pCtrl as clsControl ptr, _
+ byref wszEventName as CWSTR, _
+ byval bIsSelected as boolean = false _
+ ) as Long
+ dim as long ub = ubound(pCtrl->Events) + 1
+ redim preserve pCtrl->Events(ub) as clsEvent
+ pCtrl->Events(ub).wszEventName = wszEventName
+ pCtrl->Events(ub).bIsSelected = bIsSelected
+ function = 0
+end function
+
+
+' ========================================================================================
+' Set the value for the specified control event
+' ========================================================================================
+public function SetControlEvent( byval pCtrl as clsControl ptr, _
+ byval wszEventName as CWSTR, _
+ byval bIsSelected as boolean _
+ ) as long
+ if pCtrl = 0 then exit function
+ dim as long lb = lbound(pCtrl->Events)
+ dim as long ub = ubound(pCtrl->Events)
+ dim as CWSTR wszEventName_ucase = ucase(wszEventName)
+
+ for i as long = lb to ub
+ if ucase(pCtrl->Events(i).wszEventName) = wszEventName_ucase THEN
+ pCtrl->Events(i).bIsSelected = bIsSelected
+ exit for
+ END IF
+ NEXT
+ function = 0
+end function
+
+
+
diff --git a/src/modVDRoutines.bi b/src/modVDRoutines.bi
index 3105679e..4a2ce1b8 100644
--- a/src/modVDRoutines.bi
+++ b/src/modVDRoutines.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDRoutines.bi.bak b/src/modVDRoutines.bi.bak
new file mode 100644
index 00000000..3105679e
--- /dev/null
+++ b/src/modVDRoutines.bi.bak
@@ -0,0 +1,31 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+declare Function GetImagesTypePtr( byref wszImageName as wstring ) As IMAGES_TYPE ptr
+declare function CheckMinimumControlSize( byval nCtrlType as long, byval rc as RECT ) as RECT
+declare function GetActiveToolboxControlType() as Long
+declare function GetActivePropertyPtr() as clsProperty ptr
+declare function GetActiveEventPtr() as clsEvent ptr
+declare function GetFormCtrlPtr( byval pDoc as clsDocument ptr ) as clsControl ptr
+declare function SetActiveToolboxControl( byval ControlType as long ) as Long
+declare function GetControlClassName( byval pCtrl as clsControl ptr ) as CWSTR
+declare function GetToolBoxName( byval nControlType as long ) as CWSTR
+declare function GetControlName( byval nControlType as long ) as CWSTR
+declare function GetControlType( byval wszControlName as CWSTR ) as long
+declare function GetWinformsXClassName( byval nControlType as long ) as CWSTR
+declare function GetControlRECT( byval pCtrl as clsControl ptr ) as RECT
+
+
+
diff --git a/src/modVDRoutines.inc b/src/modVDRoutines.inc
index 14883800..8343ee33 100644
--- a/src/modVDRoutines.inc
+++ b/src/modVDRoutines.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDRoutines.inc.bak b/src/modVDRoutines.inc.bak
new file mode 100644
index 00000000..14883800
--- /dev/null
+++ b/src/modVDRoutines.inc.bak
@@ -0,0 +1,309 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modVDRoutines.bi"
+#include once "frmStatusBarEditor.bi"
+
+
+' ========================================================================================
+' Retrieve the IMAGES_TYPE pointer for the IMAGE name.
+' ========================================================================================
+public Function GetImagesTypePtr( byref wszImageName as wstring ) As IMAGES_TYPE ptr
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ do until pDoc = 0
+ if (gApp.IsProjectActive = false) andalso _
+ (gTTabCtl.GetActiveDocumentPtr <> 0) andalso _
+ (pDoc <> gTTabCtl.GetActiveDocumentPtr) then
+ ' For non-projects only get images related to the active form.
+ else
+ for i as long = lbound(pDoc->AllImages) to ubound(pDoc->AllImages)
+ if pDoc->AllImages(i).wszImageName = wszImageName then
+ return @pDoc->AllImages(i)
+ end if
+ next
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+ function = 0
+end function
+
+
+' ========================================================================================
+' Check for a minimum default size when creating. Check needed because a user could
+' select a control in the Toolbox and simply click on the Form rather than drawing
+' the control on the form.
+' ========================================================================================
+function CheckMinimumControlSize( byval nControlType as long, byval rcIn as RECT ) as RECT
+ dim as RECT rc = rcIn
+ dim as long nWidth = rc.right - rc.left
+ dim as long nHeight = rc.bottom - rc.top
+
+ if (nWidth < 5) orelse (nHeight < 5) then
+ 'AFXMSG( "Control too small" )
+ select case nControlType
+ case CTRL_LABEL: nWidth = 97: nHeight = 41
+ case CTRL_BUTTON: nWidth = 188: nHeight = 58
+ case CTRL_TEXTBOX: nWidth = 250: nHeight = 47
+ case CTRL_CHECKBOX: nWidth = 197: nHeight = 45
+ case CTRL_OPTION: nWidth = 228: nHeight = 45
+ case CTRL_FRAME: nWidth = 500: nHeight = 250
+ case CTRL_PICTUREBOX: nWidth = 250: nHeight = 125
+ case CTRL_COMBOBOX: nWidth = 302: nHeight = 49
+ case CTRL_LISTBOX: nWidth = 300: nHeight = 209
+ case CTRL_RICHEDIT: nWidth = 250: nHeight = 240
+ case CTRL_MASKEDEDIT: nWidth = 250: nHeight = 47
+ case CTRL_PROGRESSBAR: nWidth = 250: nHeight = 58
+ case CTRL_LISTVIEW: nWidth = 302: nHeight = 242
+ case CTRL_TREEVIEW: nWidth = 302: nHeight = 242
+ case CTRL_MONTHCALENDAR: nWidth = 489: nHeight = 399
+ case CTRL_DATETIMEPICKER: nWidth = 500: nHeight = 47
+ case CTRL_TABCONTROL: nWidth = 500: nHeight = 58
+ case CTRL_UPDOWN: nWidth = 44: nHeight = 47
+ case CTRL_TIMER: nWidth = 32: nHeight = 32
+ case CTRL_HSCROLL: nWidth = 200: nHeight = 108
+ case CTRL_VSCROLL: nWidth = 108: nHeight = 500
+ case CTRL_SLIDER: nWidth = 260: nHeight = 114
+ case CTRL_WEBBROWSER:
+ case CTRL_CUSTOM:
+ case CTRL_OCX:
+ end select
+
+ rc.right = rc.left + AfxUnScaleX(nWidth)
+ rc.bottom = rc.top + AfxUnScaleY(nHeight)
+ end if
+
+ return rc
+end function
+
+
+' ========================================================================================
+' Retrieve the control type that is currently actively selected in the Toolbox
+' ========================================================================================
+public function GetActiveToolboxControlType() as Long
+
+ Dim As HWnd hList1 = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTTOOLBOX)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+
+ if nCurSel = -1 THEN return CTRL_POINTER
+
+ ' The index into the global gToolbox array is stored in the line's data area.
+ dim as long idx = ListBox_GetItemData(hList1, nCurSel)
+ function = gToolbox(idx).nToolType
+end function
+
+
+' ========================================================================================
+' Retrieve a pointer to the currently selected Property in the PropertyList
+' ========================================================================================
+public function GetActivePropertyPtr() as clsProperty ptr
+
+ ' This function allows for two use cases: (1) is to be able to choose colors
+ ' in the PropertyList for various controls, and (2) is to be able to select
+ ' colors for StatusBar Panels. If the StatusBar Editor is active then we
+ ' must be looking for the pPropColor related to that panel, otherwise it
+ ' must be the PropertyList that is being used.
+
+ if IsWindowVisible(HWND_FRMSTATUSBAREDITOR) then
+ dim as hwnd hList1 = GetDlgItem( HWND_FRMSTATUSBAREDITOR, IDC_FRMSTATUSBAREDITOR_LSTPANELS)
+ dim as long nCurSel = ListBox_GetCurSel(hList1)
+ if nCurSel = -1 then return 0
+ return @gPanelItems(nCurSel).pPropColor
+
+ else
+ Dim As HWnd hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES)
+ dim as long nCurSel = ListBox_GetCurSel(hList)
+ if nCurSel = -1 then return 0
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr
+ if pDoc then pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl = 0 THEN return 0
+
+ dim as long idx = ListBox_GetItemData(hList, nCurSel) ' property array index in listbox item
+
+ return @pCtrl->Properties(idx)
+ end if
+
+end function
+
+
+' ========================================================================================
+' Retrieve a pointer to the currently selected Event in the PropertyList
+' ========================================================================================
+public function GetActiveEventPtr() as clsEvent ptr
+
+ Dim As HWnd hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTEVENTS)
+ dim as long nCurSel = ListBox_GetCurSel(hList)
+ if nCurSel = -1 then return 0
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr
+ if pDoc then pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl = 0 THEN return 0
+
+ dim as long idx = ListBox_GetItemData(hList, nCurSel) ' event array index in listbox item
+
+ return @pCtrl->Events(idx)
+end function
+
+
+' ========================================================================================
+' Get the pCtrl pointer for the Form
+' ========================================================================================
+public function GetFormCtrlPtr( byval pDoc as clsDocument ptr ) as clsControl ptr
+ dim pCtrl as clsControl ptr
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl->ControlType = CTRL_FORM then return pCtrl
+ NEXT
+ return 0
+end function
+
+
+' ========================================================================================
+' Set the Tools listbox to incoming control type.
+' ========================================================================================
+public function SetActiveToolboxControl( byval ControlType as long ) as Long
+
+ Dim As HWnd hList1 = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTTOOLBOX)
+ dim as long NumItems = ListBox_GetCount(hList1)
+ dim as long idx
+
+ for i as long = 0 to NumItems
+ idx = ListBox_GetItemData(hList1, i)
+ if gToolbox(idx).nToolType = ControlType THEN
+ ListBox_SetCurSel(hList1, i)
+ exit for
+ end if
+ NEXT
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Get the class name based on the type of control
+' ========================================================================================
+public function GetControlClassName( byval pCtrl as clsControl ptr ) as CWSTR
+ for i as long = lbound(gToolbox) to ubound(gToolbox)
+ if gToolbox(i).nToolType = pCtrl->ControlType THEN
+ return gToolbox(i).wszClassName
+ END IF
+ NEXT
+ return ""
+end function
+
+
+' ========================================================================================
+' Get the control ToolBox name based on the type of control
+' ========================================================================================
+public function GetToolBoxName( byval nControlType as long ) as CWSTR
+ if nControlType = CTRL_FORM then return "Form"
+ for i as long = lbound(gToolbox) to ubound(gToolbox)
+ if gToolbox(i).nToolType = nControlType THEN
+ return gToolbox(i).wszToolBoxName
+ END IF
+ NEXT
+ return ""
+end function
+
+
+' ========================================================================================
+' Get the control name based on the type of control
+' ========================================================================================
+public function GetControlName( byval nControlType as long ) as CWSTR
+ if nControlType = CTRL_FORM then return "Form"
+ for i as long = lbound(gToolbox) to ubound(gToolbox)
+ if gToolbox(i).nToolType = nControlType THEN
+ return gToolbox(i).wszControlName
+ END IF
+ NEXT
+ return ""
+end function
+
+
+' ========================================================================================
+' Get the control type number based on the name of the control
+' ========================================================================================
+public function GetControlType( byval wszControlName as CWSTR ) as long
+ wszControlName = ucase(wszControlName)
+ if wszControlName = "FORM" then return CTRL_FORM
+ for i as long = lbound(gToolbox) to ubound(gToolbox)
+ if ucase(gToolbox(i).wszToolBoxName) = wszControlName then
+ return gToolbox(i).nToolType
+ END IF
+ NEXT
+ return 0
+end function
+
+
+' ========================================================================================
+' Get the WinFormsX class name for the incoming control type
+' ========================================================================================
+public function GetWinformsXClassName( byval nControlType as long ) as CWSTR
+ dim wszText as CWSTR
+ select case nControlType
+ CASE CTRL_FORM: wszText = "wfxForm"
+ CASE CTRL_LABEL: wszText = "wfxLabel"
+ CASE CTRL_BUTTON: wszText = "wfxButton"
+ CASE CTRL_TEXTBOX: wszText = "wfxTextBox"
+ CASE CTRL_CHECKBOX: wszText = "wfxCheckBox"
+ CASE CTRL_OPTION: wszText = "wfxOptionButton"
+ CASE CTRL_FRAME: wszText = "wfxFrame"
+ CASE CTRL_PICTUREBOX: wszText = "wfxPictureBox"
+ CASE CTRL_COMBOBOX: wszText = "wfxComboBox"
+ CASE CTRL_LISTBOX: wszText = "wfxListBox"
+ case CTRL_RICHEDIT: wszText = "wfxRichEdit"
+ case CTRL_MASKEDEDIT: wszText = "wfxMaskedEdit"
+ case CTRL_PROGRESSBAR: wszText = "wfxProgressBar"
+ case CTRL_LISTVIEW: wszText = "wfxListView"
+ case CTRL_TREEVIEW: wszText = "wfxTreeView"
+ case CTRL_MONTHCALENDAR: wszText = "wfxMonthCalendar"
+ case CTRL_DATETIMEPICKER: wszText = "wfxDateTimePicker"
+ case CTRL_TABCONTROL: wszText = "wfxTabControl"
+ case CTRL_UPDOWN: wszText = "wfxUpDown"
+ case CTRL_TIMER: wszText = "wfxTimer"
+ case CTRL_HSCROLL
+ case CTRL_VSCROLL
+ case CTRL_SLIDER
+ case CTRL_WEBBROWSER
+ case CTRL_CUSTOM
+ case CTRL_OCX
+ END SELECT
+
+ return wszText
+end function
+
+
+' ========================================================================================
+' Get the RECT of the specified control
+' ========================================================================================
+public function GetControlRECT( byval pCtrl as clsControl ptr ) as RECT
+ if pCtrl = 0 then exit function
+ dim as long lb = lbound(pCtrl->Properties)
+ dim as long ub = ubound(pCtrl->Properties)
+ dim as long nLeft, nTop, nWidth, nHeight
+ dim as RECT rc
+
+ for i as long = lb to ub
+ select CASE ucase(pCtrl->Properties(i).wszPropName)
+ case "LEFT": nLeft = val(pCtrl->Properties(i).wszPropValue)
+ case "TOP": nTop = val(pCtrl->Properties(i).wszPropValue)
+ case "WIDTH": nWidth = val(pCtrl->Properties(i).wszPropValue)
+ case "HEIGHT": nHeight = val(pCtrl->Properties(i).wszPropValue)
+ END SELECT
+ NEXT
+ SetRect(@rc, nLeft, nTop, nLeft+nWidth, nTop+nHeight)
+ function = rc
+end function
+
diff --git a/src/modVDToolbox.bi b/src/modVDToolbox.bi
index 4d6b485c..710ca758 100644
--- a/src/modVDToolbox.bi
+++ b/src/modVDToolbox.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDToolbox.bi.bak b/src/modVDToolbox.bi.bak
new file mode 100644
index 00000000..4d6b485c
--- /dev/null
+++ b/src/modVDToolbox.bi.bak
@@ -0,0 +1,31 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#pragma once
+
+#Define IDC_FRMVDTOOLBOX_LSTTOOLBOX 1000
+#Define IDC_FRMVDTOOLBOX_LSTPROPERTIES 1001
+#Define IDC_FRMVDTOOLBOX_LSTEVENTS 1002
+#Define IDC_FRMVDTOOLBOX_TABCONTROL 1003
+#Define IDC_FRMVDTOOLBOX_COMBOCONTROLS 1004
+#Define IDC_FRMVDTOOLBOX_TEXTEDIT 1005
+#Define IDC_FRMVDTOOLBOX_COMBO 1006
+#Define IDC_FRMVDTOOLBOX_COMBOLIST 1007
+#Define IDC_FRMVDTOOLBOX_LBLPROPNAME 1008
+#Define IDC_FRMVDTOOLBOX_LBLPROPDESCRIBE 1009
+
+#define FRMVDTOOLBOX_LISTBOX_LINEHEIGHT 20
+
+declare function HidePropertyListControls() as long
+declare Function DisplayPropertyList( byval pDoc as clsDocument ptr ) as Long
+declare Function frmVDToolbox_Show( ByVal hWndParent As HWnd, ByVal nCmdShow As Long = 0 ) As LRESULT
diff --git a/src/modVDToolbox.inc b/src/modVDToolbox.inc
index ffdc20cb..89bc0e3c 100644
--- a/src/modVDToolbox.inc
+++ b/src/modVDToolbox.inc
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/modVDToolbox.inc.bak b/src/modVDToolbox.inc.bak
new file mode 100644
index 00000000..ffdc20cb
--- /dev/null
+++ b/src/modVDToolbox.inc.bak
@@ -0,0 +1,1682 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+#include once "modVDToolbox.bi"
+#include once "modGenerateCode.bi"
+#include once "frmImageManager.bi"
+#include once "frmVDTabChild.bi"
+#include once "clsApp.bi"
+#include once "clsDocument.bi"
+
+' PropertyList divider globals
+dim shared as long gPropDivPos
+dim shared as boolean gPropDivTracking
+
+
+' ========================================================================================
+' Load the dropdown PropertyList listbox that shows chocies for the current property
+' ========================================================================================
+function LoadPropertyComboListbox( _
+ byval pDoc as clsDocument ptr, _
+ byval pCtrl as clsControl ptr, _
+ byval pProp as clsProperty ptr _
+ ) as Long
+
+ if pDoc = 0 then exit function
+ if pCtrl = 0 then exit function
+ if pProp = 0 then exit function
+
+ ListBox_ResetContent(HWND_PROPLIST_COMBOLIST)
+
+ if pProp->PropType = PropertyType.TrueFalse then
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @WSTR("True"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @WSTR("False"))
+ exit function
+ end if
+
+ select case ucase(pProp->wszPropName)
+ case "ACCEPTBUTTON", "CANCELBUTTON"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("(none)"))
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl then
+ if pCtrl->ControlType = CTRL_BUTTON then
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, GetControlProperty(pCtrl, "NAME").sptr)
+ end if
+ END if
+ NEXT
+
+ case "BACKGROUNDIMAGELAYOUT"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageLayout.None"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageLayout.Tile"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageLayout.Center"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageLayout.Stretch"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageLayout.Zoom"))
+
+ CASE "BORDERSTYLE"
+ select case pCtrl->ControlType
+ case CTRL_FORM
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormBorderStyle.None"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormBorderStyle.Sizable"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormBorderStyle.Fixed3D"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormBorderStyle.FixedSingle"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormBorderStyle.FixedDialog"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormBorderStyle.FixedToolWindow"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormBorderStyle.SizableToolWindow"))
+ case else
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ControlBorderStyle.None"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ControlBorderStyle.FixedSingle"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ControlBorderStyle.Fixed3D"))
+ end select
+
+ case "CHARACTERCASING"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("CharacterCase.Normal"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("CharacterCase.Upper"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("CharacterCase.Lower"))
+
+ case "CHECKSTATE"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("CheckBoxState.Checked"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("CheckBoxState.Unchecked"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("CheckBoxState.Indeterminate"))
+
+ case "CHILDFORMPARENT"
+ dim pDoc as clsDocument ptr = gApp.pDocList
+ dim pCtrl as clsControl ptr
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @"")
+ do until pDoc = 0
+ pCtrl = GetFormCtrlPtr(pDoc)
+ if pCtrl then
+ dim as CWSTR wszFormName = GetControlProperty(pCtrl, "NAME")
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, wszFormName.sptr)
+ end if
+ pDoc = pDoc->pDocNext
+ loop
+
+ case "DATEFORMAT"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("DateTimePickerFormat.LongDate"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("DateTimePickerFormat.ShortDate"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("DateTimePickerFormat.ShortDateCentury"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("DateTimePickerFormat.TimeFormat"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("DateTimePickerFormat.CustomFormat"))
+
+ CASE "HEADERSTYLE"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ColumnHeaderStyle.Clickable"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ColumnHeaderStyle.NonClickable"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ColumnHeaderStyle.None"))
+
+ case "DROPDOWNSTYLE"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ComboBoxStyle.Simple"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ComboBoxStyle.DropDown"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ComboBoxStyle.DropDownList"))
+
+ case "IMAGEALIGN"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageAlignment.BottomCenter"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageAlignment.BottomLeft"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageAlignment.BottomRight"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageAlignment.MiddleCenter"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageAlignment.MiddleLeft"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageAlignment.MiddleRight"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageAlignment.TopCenter"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageAlignment.TopLeft"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageAlignment.TopRight"))
+
+ case "IMAGESCALING"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageScale.None"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageScale.AutoSize"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageScale.FitWidth"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageScale.FitHeight"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ImageScale.Stretch"))
+
+ CASE "TABIMAGESIZE"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ControlImageSize.Size16"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ControlImageSize.Size24"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ControlImageSize.Size32"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ControlImageSize.Size48"))
+
+ CASE "STARTPOSITION"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormStartPosition.CenterParent"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormStartPosition.CenterScreen"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormStartPosition.Manual"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormStartPosition.WindowsDefaultLocation"))
+
+ CASE "SELECTIONMODE"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ListSelectionMode.None"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ListSelectionMode.One"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ListSelectionMode.MultiSimple"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ListSelectionMode.MultiExtended"))
+
+ CASE "SORTING"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("SortOrder.Ascending"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("SortOrder.Descending"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("SortOrder.None"))
+
+ case "TEXTALIGN"
+ select case pCtrl->ControlType
+ case CTRL_BUTTON, CTRL_CHECKBOX, CTRL_OPTION, CTRL_FRAME
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ButtonAlignment.BottomCenter"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ButtonAlignment.BottomLeft"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ButtonAlignment.BottomRight"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ButtonAlignment.MiddleCenter"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ButtonAlignment.MiddleLeft"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ButtonAlignment.MiddleRight"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ButtonAlignment.TopCenter"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ButtonAlignment.TopLeft"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ButtonAlignment.TopRight"))
+ case CTRL_LABEL, CTRL_LISTBOX
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("LabelAlignment.BottomCenter"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("LabelAlignment.BottomLeft"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("LabelAlignment.BottomRight"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("LabelAlignment.MiddleCenter"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("LabelAlignment.MiddleLeft"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("LabelAlignment.MiddleRight"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("LabelAlignment.TopCenter"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("LabelAlignment.TopLeft"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("LabelAlignment.TopRight"))
+ case CTRL_TEXTBOX, CTRL_RICHEDIT
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("TextAlignment.Left"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("TextAlignment.Right"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("TextAlignment.Center"))
+ end select
+
+ case "TEXTSCROLLBARS"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ScrollBars.None"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ScrollBars.Horizontal"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ScrollBars.Vertical"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("ScrollBars.Both"))
+
+ case "WINDOWSTATE"
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormWindowState.Maximized"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormWindowState.Minimized"))
+ ListBox_AddString(HWND_PROPLIST_COMBOLIST, @wstr("FormWindowState.Normal"))
+
+ END SELECT
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Show the popup font selection dialog for the current property
+' ========================================================================================
+function ChooseFontForProperty( byval pProp as clsProperty ptr ) as long
+ if pProp = 0 then exit function
+
+ dim cf as CHOOSEFONT
+ dim lf as LOGFONT
+ cf.lStructSize = sizeof(cf)
+ cf.hwndOwner = HWND_FRMVDTOOLBOX
+ cf.lpLogFont = @lf
+ cf.Flags = CF_SCREENFONTS or CF_EFFECTS or CF_INITTOLOGFONTSTRUCT
+
+ lf = SetLogFontFromPropValue(pProp->wszPropValue)
+
+ EnableWindow(HWND_FRMMAIN, false)
+ if ChooseFont(@cf) then
+ pProp->wszPropValuePrev = pProp->wszPropValue
+ pProp->wszPropValue = SetPropValueFromLogFont(*cf.lpLogFont)
+ AfxRedrawWindow(GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES))
+ END IF
+ EnableWindow(HWND_FRMMAIN, true)
+
+ function = 0
+end function
+
+' ========================================================================================
+' Display the last selected property for the control (or it's default property). This
+' allows the user to switch between controls always accessing a common property like 'Text'
+' rather than having to seach the PropertyList every time for the property.
+' ========================================================================================
+function ShowDefaultPropertyForControl( byval pCtrl as clsControl ptr ) as Long
+
+ dim as hwnd hList
+ dim as long idx
+ dim as CWSTR wszDefaultProp, wszDefaultEvent
+
+ select case pCtrl->ControlType
+ CASE CTRL_FORM, CTRL_BUTTON, CTRL_LABEL, CTRL_CHECKBOX, _
+ CTRL_OPTION, CTRL_FRAME
+ wszDefaultProp = "Text"
+ wszDefaultEvent = "Click"
+ case CTRL_TEXTBOX, CTRL_MASKEDEDIT, CTRL_RICHEDIT
+ wszDefaultProp = "Text"
+ wszDefaultEvent = "KeyPress"
+ case CTRL_LISTBOX, CTRL_COMBOBOX, CTRL_PROGRESSBAR, _
+ CTRL_LISTVIEW, CTRL_TREEVIEW, CTRL_MONTHCALENDAR, _
+ CTRL_DATETIMEPICKER, CTRL_UPDOWN
+ wszDefaultProp = "Name"
+ wszDefaultEvent = "Click"
+ case CTRL_PICTUREBOX
+ wszDefaultProp = "Image"
+ wszDefaultEvent = "Click"
+ case CTRL_TABCONTROL
+ wszDefaultProp = "Name"
+ wszDefaultEvent = "Selected"
+ case CTRL_TIMER
+ wszDefaultProp = "Name"
+ wszDefaultEvent = "Elapsed"
+
+
+ ' CTRL_HSCROLL
+ ' CTRL_VSCROLL
+ ' CTRL_SLIDER
+ ' CTRL_WEBBROWSER
+ ' CTRL_CUSTOM
+ ' CTRL_OCX
+ END SELECT
+
+
+ ' Try to match the last accessed property/event name for this control. This allows
+ ' you to switch between common properties/events of controls more quickly. If there
+ ' is no match on the last accessed, then use the default value instead.
+ wszDefaultProp = iif(IsPropertyExists(pCtrl, gApp.PreviousPropName), gApp.PreviousPropName, wszDefaultProp)
+ wszDefaultEvent = iif(IsEventExists(pCtrl, gApp.PreviousEventName), gApp.PreviousEventName, wszDefaultEvent)
+
+
+ ' Match the default names in the properties and events lists
+ hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES)
+ for i as long = 0 to ListBox_GetCount(hList) - 1
+ idx = ListBox_GetItemData(hList, i)
+ if ucase(pCtrl->Properties(idx).wszPropName) = ucase(wszDefaultProp) then
+ ListBox_SetCurSel(hList, i)
+ exit for
+ end if
+ NEXT
+
+ hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTEVENTS)
+ for i as long = 0 to ListBox_GetCount(hList) - 1
+ idx = ListBox_GetItemData(hList, i)
+ if ucase(pCtrl->Events(idx).wszEventName) = ucase(wszDefaultEvent) then
+ ListBox_SetCurSel(hList, i)
+ exit for
+ end if
+ NEXT
+
+ ' Finally, show the selected name details visually in the description labels.
+ DisplayPropertyDetails
+ DisplayEventDetails
+
+ function = 0
+end function
+
+
+' ========================================================================================
+' Display the properties/events for the current active control/form.
+' ========================================================================================
+function DisplayPropertyList( byval pDoc as clsDocument ptr ) as Long
+ if pDoc = 0 then exit function
+
+ ' If the ToolBox has not been created yet then exit.
+ if IsWindow(HWND_FRMVDTOOLBOX) = 0 then exit function
+
+ dim pCtrl as clsControl ptr
+ dim pCtrlActive as clsControl ptr = pDoc->Controls.GetActiveControl
+
+ dim as long idx, nCurSel
+
+ ' Hide any active textboxes, dropdowns, etc
+ HidePropertyListControls
+
+ ' Always clear the controls combobox and repopuplate it. Do this even
+ ' if the active control has not changed. It is possible that that a
+ ' group of controls may have been deleted.
+ dim as hwnd hCombo = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_COMBOCONTROLS)
+ Combobox_ResetContent(hCombo)
+ ' Iterate through all controls and add them to the combobox
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrl = pDoc->Controls.ItemAt(i)
+ if pCtrl then
+ idx = Combobox_AddString(hCombo, GetControlProperty(pCtrl, "NAME").sptr)
+ Combobox_SetItemData(hCombo, idx, i) ' store array index in combobox item
+ END if
+ NEXT
+ for i as long = 0 to ComboBox_GetCount(hCombo) - 1
+ pCtrl = pDoc->Controls.ItemAt(Combobox_GetItemData(hCombo, i))
+ if pCtrl = pCtrlActive then
+ ComboBox_SetCurSel(hCombo, i)
+ exit for
+ end if
+ next
+
+ if pCtrlActive = 0 THEN exit function
+
+ ' If the current control property being displayed has not changed then do not
+ ' clear the listboxes. It only causes flicker. Instead, simply invalidate them
+ ' to cause them to repaint and show most up to date property values (for example,
+ ' when controls are being moved or resized).
+ static pCtrlDisplayed as clsControl ptr
+ if pCtrlDisplayed = pCtrlActive then
+ AfxRedrawWindow(GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES))
+ exit function
+ END IF
+ pCtrlDisplayed = pCtrlActive
+
+
+ ' clear the listbox (PROPERTIES)
+ dim as hwnd hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES)
+ ListBox_ResetContent(hList)
+
+ dim as CWSTR wszPropName
+
+ for i as long = lbound(pCtrlActive->Properties) to ubound(pCtrlActive->Properties)
+ wszPropName = pCtrlActive->Properties(i).wszPropName
+ select case ucase(wszPropName)
+ case "NAME" ' ensure it sorts to first position
+ wszPropName = " " & wszPropName
+ case "(CUSTOM)" ' ensure it sorts after the first position
+ wszPropName = " Z" & wszPropName
+ case "WIDTH", "HEIGHT"
+ ' Do not output these properties to the listbox for Timers because
+ ' their size is always 16x16.
+ if pCtrlActive->ControlType = CTRL_TIMER then
+ continue for
+ end if
+ END SELECT
+
+ idx = Listbox_AddString(hList, wszPropName.sptr)
+ ListBox_SetItemData(hList, idx, i) ' store array index in listbox item
+ NEXT
+
+ ' clear the listbox (EVENTS)
+ hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTEVENTS)
+ ListBox_ResetContent(hList)
+ ' Iterate through all events and add them to the listbox
+ for i as long = lbound(pCtrlActive->Events) to ubound(pCtrlActive->Events)
+ dim as CWSTR wszBlank = ""
+ idx = Listbox_AddString(hList, wszBlank.sptr)
+ ListBox_SetItemData(hList, idx, i) ' store array index in listbox item
+ NEXT
+
+ ' Set the Property and Events listboxes to their default matches for the specified control
+ ' or to the most previously accessed property/event should that exist.
+ ShowDefaultPropertyForControl(pCtrlActive)
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Hide the PropetyList controls for edit, combobox, etc.
+' ========================================================================================
+function HidePropertyListControls() as long
+ dim as hwnd hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES)
+ ShowWindow(HWND_PROPLIST_EDIT, SW_HIDE)
+ ShowWindow(HWND_PROPLIST_COMBO, SW_HIDE)
+ ShowWindow(HWND_PROPLIST_COMBOLIST, SW_HIDE)
+ AfxRedrawWindow(hList)
+ function = 0
+end function
+
+' ========================================================================================
+' Property value was manually changed... initiate the value change.
+' ========================================================================================
+function InitiatePropertyValueChange() as Long
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr = pDoc->Controls.GetActiveControl
+ dim pProp as clsProperty ptr = GetActivePropertyPtr()
+ dim pCtrlForm as clsControl ptr = GetFormCtrlPtr(pDoc)
+ dim as CWSTR wszValue, wszOldValue
+ dim txtFind(3) as string
+ dim txtReplace(3) as string
+ dim as long startPos, endPos, r
+
+ if pProp THEN
+ wszOldValue = pProp->wszPropValue
+ select case pProp->PropType
+ CASE PropertyType.EditEnter, PropertyType.EditEnterNumericOnly
+ if IsWindowVisible(HWND_PROPLIST_EDIT) = false then exit function
+ wszValue = AfxGetWindowText(HWND_PROPLIST_EDIT)
+ case PropertyType.ComboPicker, PropertyType.TrueFalse
+ wszValue = AfxGetListBoxText(HWND_PROPLIST_COMBOLIST, ListBox_GetCurSel(HWND_PROPLIST_COMBOLIST) )
+ case PropertyType.ImagePicker
+ ' Image changes are never handled here. They are dealt with when the popup Image Manager dialog
+ ' closes. Exit out of this function now otherwise the property value will be deleted.
+ exit function
+ case PropertyType.CustomDialog
+ ' Custom changes are never handled here. They are dealt with when the popup custom dialog
+ ' closes. Exit out of this function now otherwise the property value will be deleted.
+ exit function
+ case PropertyType.FontPicker
+ ' Font changes are never handled here. They are dealt with when the popup Font dialog
+ ' closes. Exit out of this function now otherwise the property value will be deleted.
+ exit function
+ case PropertyType.ColorPicker
+ ' Color changes are handled when the popup color selector loses focus.
+ exit function
+ END SELECT
+
+ if wszValue <> wszOldValue then
+ select case ucase(pProp->wszPropName)
+ CASE "NAME"
+ wszValue = trim(wszValue)
+ ' The name can only be alphanumeric
+ static wszRetain as CWSTR = "abcdefghijklmnopqrstuvwxyz0123456789"
+ wszValue = AfxStrRetainAnyI(wszValue, wszRetain)
+ ' Do a check to ensure that the name does not already exist.
+ if pCtrl->ControlType = CTRL_FORM then
+ if IsFormNameExists(wszValue) then
+ ' Don't put a messagebox here because it will cause the propertylist to
+ ' lose focus and therefore trigger the propertyvalue change.
+ wszValue = wszOldValue
+ else
+ txtFind(1) = wszOldValue ' "Form1" ' must use SCFIND_WHOLEWORD for this one
+ txtFind(2) = wszOldValue & "."
+ txtFind(3) = " " & wszOldValue & "_"
+ txtReplace(1) = wszValue ' "Form2"
+ txtReplace(2) = wszValue & "."
+ txtReplace(3) = " " & wszValue & "_"
+ end if
+ else
+ if IsControlNameExists(pDoc, wszValue) then
+ ' Don't put a messagebox here because it will cause the propertylist to
+ ' lose focus and therefore trigger the propertyvalue change.
+ wszValue = wszOldValue
+ else
+ dim as CWSTR wszFormName
+ if pCtrlForm then wszFormName = GetControlProperty(pCtrlForm, "NAME")
+ txtFind(1) = ""
+ txtFind(2) = wszFormName & "." & wszOldValue & "."
+ txtFind(3) = " " & wszFormName & "_" & wszOldValue & "_"
+ txtReplace(1) = ""
+ txtReplace(2) = wszFormName & "." & wszValue & "."
+ txtReplace(3) = " " & wszFormName & "_" & wszValue & "_"
+ end if
+ END IF
+
+ ' If the form or control name has changed then update all source code
+ dim pDocParse as clsDocument ptr
+ dim as hwnd hEdit
+ dim as Boolean bReparse
+
+ for i as long = 1 to 3
+ if len(txtReplace(i)) = 0 then continue for
+
+ pDocParse = gApp.pDocList
+ do until pDocParse = 0
+ bReparse = false
+ hEdit = pDocParse->hWndActiveScintilla
+ if hEdit then
+ if i = 1 then
+ SendMessage( hEdit, SCI_SETSEARCHFLAGS, SCFIND_WHOLEWORD, 0)
+ else
+ SendMessage( hEdit, SCI_SETSEARCHFLAGS, 0, 0)
+ end if
+ SciExec( hEdit, SCI_TARGETWHOLEDOCUMENT, 0, 0)
+ startPos = SciExec( hEdit, SCI_GETTARGETSTART, 0, 0)
+ endPos = SciExec( hEdit, SCI_GETTARGETEND, 0, 0)
+ do
+ r = SciExec( hEdit, SCI_SEARCHINTARGET, Len(txtFind(i)), Strptr(txtFind(i)))
+ if r = -1 THEN exit do
+ bReparse = true
+ SciExec( hEdit, SCI_REPLACETARGET, len(txtReplace(i)), Strptr(txtReplace(i)) )
+ startPos = r + len(txtFind(i))
+ ' Adjust the searching positions
+ SciExec( hEdit, SCI_SETTARGETSTART, startPos, 0)
+ SciExec( hEdit, SCI_SETTARGETEND, endPos, 0)
+ loop
+ if bReparse then pDocParse->ParseDocument()
+ end if
+ pDocParse = pDocParse->pDocNext
+ loop
+ next
+ end select
+
+' TODO: Corruption in output string occurs if I simply try to assign CWSTR as below.
+ ' Need to assign to intermediary wstring first for some reason.
+ 'pProp->wszPropValue = wszValue
+ '***** WORKAROUND *****
+ dim wst as wstring * 1000 = **wszValue
+ pProp->wszPropValue = wst
+ pProp->wszPropValuePrev = wszOldValue
+ '**********************
+
+ select case ucase(pProp->wszPropName)
+ CASE "NAME"
+ ' If this was a NAME property change then we need to potentially update the form ACCEPTBUTTON
+ ' or CANCELBUTTON properties that depend on this button name.
+ ' Ensure that the controls combox is repainted to show any changes
+ AfxRedrawWindow(GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_COMBOCONTROLS ))
+ pCtrlForm = GetFormCtrlPtr(pDoc)
+ if pCtrlForm then
+ If GetControlProperty(pCtrlForm, "ACCEPTBUTTON") = wszOldValue then
+ SetControlProperty(pCtrlForm, "ACCEPTBUTTON", wszValue)
+ end if
+ If GetControlProperty(pCtrlForm, "CANCELBUTTON") = wszOldValue then
+ SetControlProperty(pCtrlForm, "CANCELBUTTON", wszValue)
+ end if
+ end if
+ case "ACCEPTBUTTON", "CANCELBUTTON"
+ ' If (none) was selected then ensure that the property value is set to blank
+ if pProp->wszPropValue = "(none)" then pProp->wszPropValue = ""
+ case "TABINDEX"
+ ' Now that a new TabIndex has been entered, ensure that there are no duplicates
+ ' amongst all of the controls. Bypass the active control but increase the TabIndex
+ ' value of all controls with a higher TabIndex number should a duplicate exist.
+ dim as long nTabIndex = val(wst)
+ dim as long nCurTabIndex
+ dim pCtrlLoop as clsControl ptr
+ dim pCtrlFound as clsControl ptr = 0
+
+ ' Text to see if TabIndex value already exists
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrlLoop = pDoc->Controls.ItemAt(i)
+ if pCtrl <> pCtrlLoop then
+ nCurTabIndex = val(GetControlProperty(pCtrlLoop, "TABINDEX"))
+ if nCurTabIndex = nTabIndex then
+ pCtrlFound = pCtrlLoop
+ exit for
+ end if
+ END if
+ NEXT
+ ' If exists then increase TabIndex for
+ if pCtrlFound then
+ for i as long = pDoc->Controls.ItemFirst to pDoc->Controls.ItemLast
+ pCtrlLoop = pDoc->Controls.ItemAt(i)
+ if pCtrl <> pCtrlLoop then
+ nCurTabIndex = val(GetControlProperty(pCtrlLoop, "TABINDEX"))
+ if nCurTabIndex >= nTabIndex then
+ SetControlProperty(pCtrlLoop, "TABINDEX", wstr(nCurTabIndex + 1))
+ end if
+ END if
+ NEXT
+ end if
+
+ end select
+
+ ApplyControlProperties(pDoc, pCtrl)
+ ' Indicate that the file is now dirty and will need to be saved
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+ frmMain_SetStatusbar
+ end if
+ END IF
+
+ function = 0
+END FUNCTION
+
+
+' ========================================================================================
+' Show the propertylist control related to the current selected propertylist row.
+' ========================================================================================
+function ShowPropertyListControl() as Long
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMVDTOOLBOX)
+ if pWindow = 0 THEN exit function
+
+ dim pCtrl as clsControl ptr
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ if pDoc then pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl = 0 THEN exit function
+
+ ' Get the rectangle related to the textbox edit area and then display the edit control
+ dim as hwnd hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES)
+ dim as long nCurSel = ListBox_GetCurSel(hList)
+ dim as long nItemData = ListBox_GetItemData(hList, nCurSel)
+ dim as RECT rc, rcLine, rcList
+ dim as CWSTR wszPropValue
+
+ if nCurSel = -1 then exit function
+
+ ' ItemRect coordinates are client relative to the Listbox.
+ ListBox_GetItemRect(hList, nCurSel, @rcLine)
+ rc = rcLine
+ GetClientRect(hList, @rcList)
+
+ select case pCtrl->Properties(nItemData).PropType
+ CASE PropertyType.EditEnter, PropertyType.EditEnterNumericOnly
+ rc.left = rc.left + gPropDivPos
+ rc.top = rc.top + pWindow->ScaleY(2)
+ rc.bottom = rc.bottom - pWindow->ScaleY(2)
+ rc.left = rc.left + pWindow->ScaleX(1)
+ SetWindowPos(HWND_PROPLIST_EDIT, HWND_TOP, rc.left, rc.top, _
+ rc.right-rc.left, rc.bottom-rc.top, SWP_SHOWWINDOW)
+ AfxSetWindowText(HWND_PROPLIST_EDIT, pCtrl->Properties(nItemData).wszPropValue)
+ ' If the user clicked in the right hand side of the propertylist line then also
+ ' set the focus immediately to the edit box. Saves the user from having to
+ ' click there a second time.
+ rcLine.left = rcLine.left + gPropDivPos
+ dim as POINT pt: GetCursorPos(@pt)
+ MapWindowPoints(0, hList, cast(POINT ptr, @pt), 1)
+ If PtInRect(@rcLine, pt) then
+ dim as long nPos = len(pCtrl->Properties(nItemData).wszPropValue)
+ SendMessage(HWND_PROPLIST_EDIT, EM_SETSEL, nPos, nPos)
+ SetFocus(HWND_PROPLIST_EDIT)
+ END IF
+
+ CASE PropertyType.ComboPicker, PropertyType.TrueFalse
+ rc.left = rc.right - (rc.bottom-rc.top)
+ SetWindowPos(HWND_PROPLIST_COMBO, HWND_TOP, rc.left, rc.top, _
+ rc.right-rc.left, rc.bottom-rc.top, SWP_SHOWWINDOW)
+ ' Fill the listbox with the correct options
+ LoadPropertyComboListbox(pDoc, pCtrl, @pCtrl->Properties(nItemData))
+ ' Set the active line based on the current stored value for the property
+ dim as long nCurSel = ListBox_FindStringExact(HWND_PROPLIST_COMBOLIST, -1, _
+ pCtrl->Properties(nItemData).wszPropValue.sptr)
+ if nCurSel = -1 then
+ pCtrl->Properties(nItemData).wszPropValue = pCtrl->Properties(nItemData).wszPropDefault
+ nCurSel = ListBox_FindStringExact( HWND_PROPLIST_COMBOLIST, -1, _
+ pCtrl->Properties(nItemData).wszPropValue.sptr)
+ END IF
+ ListBox_SetCurSel(HWND_PROPLIST_COMBOLIST, nCurSel)
+ ' Calculate height of the Listbox
+ rcLine.left = rcLine.left + gPropDivPos
+ dim as long numItems = ListBox_GetCount(HWND_PROPLIST_COMBOLIST)
+ dim as long nLineHeight = SendMessage(HWND_PROPLIST_COMBOLIST, LB_GETITEMHEIGHT, 0, 0)
+ dim as long nListHeight = (numItems * nLineHeight) + 4
+
+ if rcLine.bottom + nListHeight > rcList.bottom then
+ SetWindowPos(HWND_PROPLIST_COMBOLIST, HWND_TOP, rcLine.left, rcLine.top - nListHeight, _
+ rcLine.right-rcLine.left, nListHeight, 0)
+ else
+ SetWindowPos(HWND_PROPLIST_COMBOLIST, HWND_TOP, rcLine.left, rcLine.bottom, _
+ rcLine.right-rcLine.left, nListHeight, 0)
+ end if
+ ' If the user clicked in the right hand side of the propertylist line then also
+ ' display the dropdown listbox rather than having the user click on the combo box
+ ' icon as well.
+ dim as POINT pt: GetCursorPos(@pt)
+ MapWindowPoints(0, hList, cast(POINT ptr, @pt), 1)
+ If PtInRect(@rcLine, pt) then ShowWindow(HWND_PROPLIST_COMBOLIST, SW_SHOW)
+
+ CASE PropertyType.FontPicker, _
+ PropertyType.ImagePicker, _
+ PropertyType.CustomDialog
+ rc.left = rc.right - (rc.bottom-rc.top)
+ SetWindowPos(HWND_PROPLIST_COMBO, HWND_TOP, rc.left, rc.top, _
+ rc.right-rc.left, rc.bottom-rc.top, SWP_SHOWWINDOW)
+
+ CASE PropertyType.ColorPicker, PropertyType.AnchorPicker
+ rc.left = rc.right - (rc.bottom-rc.top)
+ SetWindowPos(HWND_PROPLIST_COMBO, HWND_TOP, rc.left, rc.top, _
+ rc.right-rc.left, rc.bottom-rc.top, SWP_SHOWWINDOW)
+ ' If the user clicked in the right hand side of the propertylist line then also
+ ' display the dropdown listbox rather than having the user click on the combo box
+ ' icon as well.
+ rcLine.left = rcLine.left + gPropDivPos
+ dim as POINT pt: GetCursorPos(@pt)
+ MapWindowPoints(0, hList, cast(POINT ptr, @pt), 1)
+ If PtInRect(@rcLine, pt) then
+ MapWindowPoints(hList, 0, cast(POINT ptr, @rc), 2)
+ dim as HWND hForm
+ if pCtrl->Properties(nItemData).PropType = PropertyType.ColorPicker then
+ frmVDColors_Show(hList, pCtrl->Properties(nItemData).wszPropValue) ' initialize the color popup if not already done so
+ hForm = HWND_FRMVDCOLORS
+ elseif pCtrl->Properties(nItemData).PropType = PropertyType.AnchorPicker then
+ frmVDAnchors_Show(hList, pCtrl->Properties(nItemData).wszPropValue) ' initialize the Anchors popup if not already done so
+ hForm = HWND_FRMVDANCHORS
+ end if
+ dim as long nWidth = AfxGetWindowWidth(hForm)
+ SetWindowPos(hForm, HWND_TOP, rc.right - nWidth, rc.bottom, 0, 0, SWP_NOSIZE or SWP_SHOWWINDOW)
+ end if
+
+ END SELECT
+
+ function = 0
+END FUNCTION
+
+
+' ========================================================================================
+' Process WM_COMMAND message for window/dialog: frmVDToolbox
+' ========================================================================================
+function frmVDToolbox_OnCommand( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal hwndCtl As HWnd, _
+ ByVal codeNotify As UINT _
+ ) As LRESULT
+
+ select case id
+ case IDC_FRMVDTOOLBOX_COMBOCONTROLS
+ if codeNotify = CBN_SELCHANGE then
+ dim as long nCurSel = Combobox_GetCurSel(hwndCtl)
+ if nCurSel = -1 then exit function
+ dim as long idx = Combobox_GetItemData(hwndCtl, nCurSel)
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr
+ pCtrl = pDoc->Controls.ItemAt(idx)
+ if pCtrl then
+ pDoc->Controls.DeselectAllControls
+ pDoc->Controls.SetActiveControl(pCtrl->hWindow)
+ frmMain_SetStatusbar
+ AfxRedrawWindow(pDoc->hWndFrame)
+ AfxRedrawWindow(pDoc->hWndForm)
+ DisplayPropertyList(pDoc)
+ end if
+ END IF
+
+ case IDC_FRMVDTOOLBOX_LSTPROPERTIES
+ if codeNotify = LBN_SELCHANGE then
+ HidePropertyListControls
+ ShowPropertyListControl
+ DisplayPropertyDetails
+ end if
+
+ case IDC_FRMVDTOOLBOX_LSTEVENTS
+ if codeNotify = LBN_SELCHANGE then
+ DisplayEventDetails
+ end if
+ if codeNotify = LBN_DBLCLK then
+ ' If doubleclicking an Event then we select that event and automatically
+ ' switch to the code editor and insert that Event code if needed.
+ dim as long nCurSel = ListBox_GetCurSel(hwndCtl)
+ if nCurSel = -1 then exit function
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr
+ if pDoc then
+ pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl then
+ pCtrl->Events(nCurSel).bIsSelected = true
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+ GenerateFormCode(pDoc)
+ ' position code to the new Event
+ dim as CWSTR wszFunctionName = GetControlProperty(pCtrl, "NAME") & "_" & pCtrl->Events(nCurSel).wszEventName
+ if pCtrl->ControlType <> CTRL_FORM then
+ wszFunctionName = GetFormName(pDoc) & "_" & wszFunctionName
+ end if
+ OpenSelectedDocument( pDoc->DiskFilename, wszFunctionName, -1 )
+ end if
+ end if
+ end if
+
+ end select
+
+ function = 0
+End Function
+
+' ========================================================================================
+' Process WM_NOTIFY message for window/dialog: frmVDToolbox
+' ========================================================================================
+function frmVDToolbox_OnNotify( _
+ ByVal HWnd As HWnd, _
+ ByVal id As Long, _
+ ByVal pNMHDR As NMHDR Ptr _
+ ) As LRESULT
+
+ SELECT CASE id
+ CASE IDC_FRMVDTOOLBOX_TABCONTROL
+ dim as long iPage = TabCtrl_GetCurSel(pNMHDR->hwndFrom)
+ SELECT CASE pNMHDR->code
+ CASE TCN_SELCHANGE
+ ' Show the selected page controls
+ if iPage = 0 then
+ ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_COMBOCONTROLS), SW_HIDE)
+ ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_LSTTOOLBOX), SW_SHOW)
+ end if
+ if iPage = 1 then
+ ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_COMBOCONTROLS), SW_SHOW)
+ ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_LSTPROPERTIES), SW_SHOW)
+ ShowWindow( GetDlgItem(HWnd, IDC_FRMVDTOOLBOX_LBLPROPNAME), SW_SHOW)
+ ShowWindow( GetDlgItem(HWnd, IDC_FRMVDTOOLBOX_LBLPROPDESCRIBE), SW_SHOW)
+ END IF
+ if iPage = 2 then
+ ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_COMBOCONTROLS), SW_SHOW)
+ ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_LSTEVENTS), SW_SHOW)
+ ShowWindow( GetDlgItem(HWnd, IDC_FRMVDTOOLBOX_LBLPROPNAME), SW_SHOW)
+ ShowWindow( GetDlgItem(HWnd, IDC_FRMVDTOOLBOX_LBLPROPDESCRIBE), SW_SHOW)
+ END IF
+ ' Ensure that we reset the ToolBox Tool to the Pointer
+ SetActiveToolboxControl(CTRL_POINTER)
+ DisplayPropertyDetails
+ DisplayEventDetails
+
+ CASE TCN_SELCHANGING
+ ' Hide the current page
+ ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_COMBOCONTROLS), SW_HIDE)
+ if iPage = 0 then ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_LSTTOOLBOX), SW_HIDE)
+ if (iPage = 1) or (iPage = 2) then
+ ShowWindow( GetDlgItem(HWnd, IDC_FRMVDTOOLBOX_LBLPROPNAME), SW_HIDE)
+ ShowWindow( GetDlgItem(HWnd, IDC_FRMVDTOOLBOX_LBLPROPDESCRIBE), SW_HIDE)
+ end if
+ if iPage = 1 then ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_LSTPROPERTIES), SW_HIDE)
+ if iPage = 2 then ShowWindow( GetDlgItem(HWND, IDC_FRMVDTOOLBOX_LSTEVENTS), SW_HIDE)
+ END SELECT
+
+ END SELECT
+
+ function = 0
+end function
+
+' ========================================================================================
+' Position all child windows. Called manually and/or by WM_SIZE
+' ========================================================================================
+function frmVDToolbox_PositionWindows() As LRESULT
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMVDTOOLBOX)
+ if pWindow = 0 THEN exit function
+
+ ' Get the entire client area
+ Dim As Rect rc
+ GetClientRect(HWND_FRMVDTOOLBOX, @rc)
+
+ Dim As HWnd hList1 = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTTOOLBOX )
+ Dim As HWnd hList2 = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES )
+ Dim As HWnd hList3 = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTEVENTS )
+ Dim As HWnd hTabCtl = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_TABCONTROL )
+ Dim As HWnd hCombo = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_COMBOCONTROLS )
+ Dim As HWnd hPropName = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LBLPROPNAME)
+ Dim As HWnd hPropDescribe = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LBLPROPDESCRIBE )
+
+ SetWindowPos( hTabCtl, 0, 0, 0, rc.Right-rc.Left, pWindow->ScaleY(24), SWP_SHOWWINDOW Or SWP_NOZORDER )
+
+ ' TAB 1: ToolBox
+ SetWindowPos( hList1, 0, 0, pWindow->ScaleY(24), rc.Right-rc.Left, rc.Bottom-rc.top-pWindow->ScaleY(24), SWP_NOZORDER )
+
+ ' TAB 2 & 3: Properties & Events
+ ' Combolist of controls
+ SetWindowPos( hCombo, 0, 0, pWindow->ScaleY(24), rc.Right-rc.Left, pWindow->ScaleY(20), SWP_NOZORDER )
+ ' Bold label for Property/Event name
+ SetWindowPos( hPropName, 0, pWindow->ScaleX(4), rc.Bottom - pWindow->ScaleY(90), _
+ rc.Right-rc.Left-pWindow->ScaleX(8), pWindow->ScaleY(20), SWP_NOZORDER )
+ ' Multiline label for Property/Event description
+ SetWindowPos( hPropDescribe, 0, pWindow->ScaleX(4), rc.Bottom - pWindow->ScaleY(70), _
+ rc.Right-rc.Left-pWindow->ScaleX(8), pWindow->ScaleY(70), SWP_NOZORDER )
+
+ ' TAB 2: Properties
+ SetWindowPos( hList2, 0, 0, pWindow->ScaleY(48), rc.Right-rc.Left, rc.Bottom-rc.top-pWindow->ScaleY(138), SWP_NOZORDER )
+
+ ' TAB 3: Events
+ SetWindowPos( hList3, 0, 0, pWindow->ScaleY(48), rc.Right-rc.Left, rc.Bottom-rc.top-pWindow->ScaleY(138), SWP_NOZORDER )
+
+ ShowPropertyListControl
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_SIZE message for window/dialog: frmVDToolbox
+' ========================================================================================
+function frmVDToolbox_OnSize( _
+ ByVal HWnd As HWnd, _
+ ByVal state As UINT, _
+ ByVal cx As Long, _
+ ByVal cy As Long _
+ ) As LRESULT
+ If state <> SIZE_MINIMIZED Then
+ frmVDToolbox_PositionWindows
+ End If
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_CLOSE message for window/dialog: frmVDToolbox
+' ========================================================================================
+function frmVDToolbox_OnClose( ByVal HWnd As HWnd ) As LRESULT
+ ' Never close the window; simply hide it.
+ ShowWindow( HWnd, SW_HIDE )
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_MEASUREITEM message for window/dialog: frmVDToolbox
+' ========================================================================================
+function frmVDToolbox_OnMeasureItem( _
+ ByVal HWnd As HWnd, _
+ ByVal lpmis As MEASUREITEMSTRUCT Ptr _
+ ) As Long
+ ' Set the height of the List box items.
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ lpmis->itemHeight = pWindow->ScaleY(FRMVDTOOLBOX_LISTBOX_LINEHEIGHT)
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DRAWITEM message for window/dialog: frmVDToolbox
+' ========================================================================================
+function frmVDToolbox_OnDrawItem( _
+ ByVal HWnd As HWnd, _
+ ByVal lpdis As Const DRAWITEMSTRUCT Ptr _
+ ) As Long
+
+ Dim As HBRUSH hBrush
+ dim as HANDLE hImage
+ dim as HFONT hFont, hFontNormal, hFontBold
+ Dim As RECT rc, rc2
+ Dim wzText As WString * MAX_PATH
+
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(HWnd)
+ if pWindow = 0 THEN exit function
+
+ If lpdis->itemID = -1 Then Exit Function
+
+ Select Case lpdis->itemAction
+ Case ODA_DRAWENTIRE, ODA_SELECT
+
+ hFontNormal = pWindow->CreateFont( pWindow->DefaultFontName, _
+ pWindow->DefaultFontSize, _
+ FW_NORMAL, FALSE, FALSE, FALSE, DEFAULT_CHARSET)
+
+ hFontBold = pWindow->CreateFont( pWindow->DefaultFontName, _
+ pWindow->DefaultFontSize, _
+ FW_BOLD, FALSE, FALSE, FALSE, DEFAULT_CHARSET)
+
+ SaveDC(lpdis->hDC)
+
+ ' COMBOBOX LIST OF CONTROLS ON FORM
+ if lpdis->CtlID = IDC_FRMVDTOOLBOX_COMBOCONTROLS then
+ ' CLEAR BACKGROUND
+ If (lpdis->itemState And ODS_SELECTED) Then
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHT))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHTTEXT))
+ hBrush = GetSysColorBrush(COLOR_HIGHLIGHT)
+ else
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_WINDOW))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT))
+ hBrush = GetSysColorBrush(COLOR_WINDOW)
+ end if
+ SelectObject(lpdis->hDC, hBrush)
+ FillRect(lpdis->hDC, @lpdis->rcItem, hBrush)
+
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+
+ if (pDoc <> 0) andalso (lpdis->itemData < pDoc->Controls.Count) then
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr
+ pCtrl = pDoc->Controls.ItemAt(lpdis->itemData)
+ if pCtrl then
+ SelectObject(lpdis->hDC, hFontBold)
+ rc = lpdis->rcItem
+ dim as CWSTR wszCtrlName = GetControlProperty(pCtrl, "NAME")
+ ' Get the size of this string because the Control type string must be drawn after this.
+ Dim nSize As SIZE
+ GetTextExtentPoint32( lpdis->hDC, wszCtrlName, Len(wszCtrlName), @nSIZE)
+ rc.left = rc.left + pWindow->ScaleX(4)
+ DrawText( lpdis->hDC, _
+ wszCtrlName, _
+ -1, Cast(lpRect, @rc), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER or DT_NOPREFIX)
+
+ ' Determine the Control Type
+ SelectObject(lpdis->hDC, hFontNormal)
+ wszCtrlName = GetToolBoxName(pCtrl->ControlType) & " (" & GetWinformsXClassName(pCtrl->ControlType) & ")"
+ ' Text is drawn immediately after the Control Name
+ rc.left = rc.left + nSize.cx + pWindow->ScaleX(4)
+ DrawText( lpdis->hDC, _
+ wszCtrlName, _
+ -1, Cast(lpRect, @rc), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER or DT_NOPREFIX)
+ end if
+ end if
+ end if
+
+
+ ' TOOLBOX OF CONTROLS
+ if lpdis->CtlID = IDC_FRMVDTOOLBOX_LSTTOOLBOX then
+ ' CLEAR BACKGROUND
+ If (lpdis->itemState And ODS_SELECTED) Then
+ hBrush = GetSysColorBrush(COLOR_HIGHLIGHT)
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHT))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHTTEXT))
+ else
+ hBrush = GetSysColorBrush(COLOR_WINDOW)
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_WINDOW))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT))
+ end if
+ SelectObject(lpdis->hDC, hBrush)
+ FillRect(lpdis->hDC, @lpdis->rcItem, hBrush)
+ ' The index into the gToolBox array is stored in the itemData of the line.
+
+ ' DRAW IMAGE
+ dim as HDC hdcMem = CreateCompatibleDC(lpdis->hDC)
+ hImage = LoadImage(pWindow->InstanceHandle, gToolBox(lpdis->itemData).wszImage, IMAGE_BITMAP, _
+ pWindow->ScaleX(16), pWindow->ScaleX(16), LR_LOADTRANSPARENT)
+ SelectObject(hdcMem, hImage)
+ BitBlt( lpdis->hDC, _
+ lpdis->rcItem.left + pWindow->ScaleX(6), _
+ lpdis->rcItem.top + pWindow->ScaleY(2), _
+ pWindow->ScaleX(16), pWindow->ScaleY(16), _
+ hdcMem, 0, 0, SRCCOPY)
+ DeleteDC(hdcMem)
+
+ ' DRAW TEXT
+ rc = lpdis->rcItem: rc.left = rc.left + pWindow->ScaleX(30)
+ if (lpdis->itemData >= lbound(gToolBox)) andalso (lpdis->itemData <= ubound(gToolBox)) then
+ DrawText( lpdis->hDC, gToolBox(lpdis->itemData).wszToolBoxName, -1, Cast(lpRect, @rc), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER )
+ end if
+ end if
+
+
+ ' PROPERTYLIST
+ if lpdis->CtlID = IDC_FRMVDTOOLBOX_LSTPROPERTIES then
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr
+ if pDoc then
+ pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl THEN
+ rc = lpdis->rcItem
+ rc2 = lpdis->rcItem
+ rc.right = rc.left + gPropDivPos
+ rc2.left = rc.right
+
+ ' CLEAR BACKGROUND
+ If (lpdis->itemState And ODS_SELECTED) Then
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHT))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHTTEXT))
+ hBrush = GetSysColorBrush(COLOR_HIGHLIGHT)
+ else
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_WINDOW))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT))
+ hBrush = GetSysColorBrush(COLOR_WINDOW)
+ end if
+
+ ' Draw the property name
+ SelectObject(lpdis->hDC, hBrush)
+ FillRect(lpdis->hDC, @rc, hBrush)
+ rc.left = rc.left + pWindow->ScaleX(4)
+
+
+ dim as CWSTR wszPropName, wszPropValue
+ dim as PropertyType nPropType
+
+ if (lpdis->itemData >= lbound(pCtrl->Properties)) and _
+ (lpdis->itemData <= ubound(pCtrl->Properties)) then
+ wszPropName = pCtrl->Properties(lpdis->itemData).wszPropName
+ wszPropValue = pCtrl->Properties(lpdis->itemData).wszPropValue
+ nPropType = pCtrl->Properties(lpdis->itemData).PropType
+ else
+ exit function
+ end if
+
+ DrawText( lpdis->hDC, _
+ wszPropName, _
+ -1, Cast(lpRect, @rc), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER )
+
+ ' Draw the current value
+ hBrush = GetSysColorBrush(COLOR_WINDOW)
+ SelectObject(lpdis->hDC, hBrush)
+ FillRect(lpdis->hDC, @rc2, hBrush)
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_WINDOW))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT))
+ rc2.left = rc2.left + pWindow->ScaleX(4)
+
+ ' Some properties that are blank will show "(none)"
+ if len(wszPropValue) = 0 then
+ select case ucase(wszPropName)
+ CASE "ACCEPTBUTTON", "BACKGROUNDIMAGE", "CANCELBUTTON", "ICON", "IMAGE", "ANCHOR"
+ wszPropValue = "(none)"
+ END SELECT
+ end if
+
+ if ucase(wszPropName) = "(CUSTOM)" then
+ wszPropValue = "" ' Ensure that nothing displays for the property value
+ end if
+
+ if ucase(wszPropName) = "FONT" then
+ dim as LOGFONT lf
+ GetObject(hFontNormal, sizeof(lf), @lf)
+ dim as CWSTR wszFaceName = lf.lfFaceName
+ dim as long nHeight = lf.lfHeight
+ dim as long nCharSet = lf.lfCharSet
+ lf = SetLogFontFromPropValue(wszPropValue) ' create font with bold, underline, strikeout
+ lf.lfFaceName = wszFaceName
+ lf.lfHeight = nHeight
+ lf.lfCharSet = nCharSet
+ hFont = CreateFontIndirect(@lf)
+ SelectObject(lpdis->hDC, hFont)
+ dim as CWSTR wszFont = AfxStrParse(wszPropValue, 1, ",") & ", " & _
+ AfxStrParse(wszPropValue, 2, ",") & "pt"
+ wszPropValue = wszFont
+ end if
+
+ if nPropType = PropertyType.ColorPicker then
+ dim as CWSTR wszList, wszValue
+ wszList = AfxStrParse(wszPropValue, 1, "|")
+ wszValue = AfxStrParse(wszPropValue, 2, "|")
+ wszPropValue = wszValue
+ if wszList = "CUSTOM" then wszPropValue = "Custom Color"
+
+ dim as HBRUSH hBrushColor, hBrushOld
+ dim as RECT rcColor = rc2
+ rcColor.left = rcColor.left
+ rcColor.right = rcColor.left + pWindow->ScaleX(18)
+ rcColor.top = rcColor.top + pWindow->ScaleY(1)
+ rcColor.bottom = rcColor.bottom - pWindow->ScaleY(4)
+
+ dim as COLORREF rgbClr = GetRGBColorFromProperty(pCtrl->Properties(lpdis->itemData).wszPropValue)
+ hBrushColor = CreateSolidBrush(rgbClr)
+
+ ' DRAW COLOR RECT
+ hBrushOld = SelectObject(lpdis->hDC, hBrushColor)
+ Rectangle( lpdis->hDC, rcColor.Left, rcColor.Top, rcColor.Right, rcColor.Bottom)
+ SelectObject( lpdis->hDC, hBrushOld)
+ rc2.left = rcColor.right + pWindow->ScaleX(6)
+ DeleteObject(hBrushColor)
+ end if
+
+ DrawText( lpdis->hDC, _
+ wszPropValue, _
+ -1, Cast(lpRect, @rc2), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER )
+ SelectObject(lpdis->hDC, hFontNormal)
+ if hFont then DeleteFont(hFont)
+
+
+ ' Draw the border edges
+ SetBkMode(lpdis->hDC, TRANSPARENT)
+ rc = lpdis->rcItem: rc.right = rc.left + gPropDivPos
+ rc2 = lpdis->rcItem: rc2.left = rc.right
+ DrawEdge( lpdis->hDC, @rc, EDGE_SUNKEN, BF_BOTTOMRIGHT)
+ DrawEdge( lpdis->hDC, @rc2, EDGE_SUNKEN, BF_BOTTOMRIGHT)
+
+ end if
+ END IF
+ end if
+
+ ' EVENTS ASSOCIATED WITH A CONTROL
+ if lpdis->CtlID = IDC_FRMVDTOOLBOX_LSTEVENTS then
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr
+ if pDoc then
+ pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl THEN
+ rc = lpdis->rcItem
+ rc2 = lpdis->rcItem: rc2.Left = pWindow->ScaleX(20)
+
+ ' CLEAR BACKGROUND
+ If (lpdis->itemState And ODS_SELECTED) Then
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHT))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHTTEXT))
+ hBrush = GetSysColorBrush(COLOR_HIGHLIGHT)
+ else
+ SetBkColor(lpdis->hDC, GetSysColor(COLOR_WINDOW))
+ SetTextColor(lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT))
+ hBrush = GetSysColorBrush(COLOR_WINDOW)
+ end if
+
+ ' Draw the tick/untick image
+ ' The line height is FRMVDTOOLBOX_LISTBOX_LINEHEIGHT so center the 16x16 icon vertically and horizontally
+ FillRect(lpdis->hDC, @rc, GetSysColorBrush(COLOR_WINDOW))
+ DrawIconEx( lpdis->hDC, _
+ rc.Left + pWindow->ScaleX(2), _
+ rc.Top + pWindow->ScaleY(2), _
+ iIf( pCtrl->Events(lpdis->itemData).bIsSelected, ghIconTick, ghIconNoTick), _
+ pWindow->ScaleX(16), pWindow->ScaleY(16), 0, 0, DI_NORMAL)
+
+ ' Draw the event name
+ SelectObject(lpdis->hDC, hBrush)
+ FillRect(lpdis->hDC, @rc2, hBrush)
+ DrawText( lpdis->hDC, _
+ pCtrl->Events(lpdis->itemData).wszEventName, _
+ -1, Cast(lpRect, @rc2), _
+ DT_LEFT Or DT_SINGLELINE Or DT_VCENTER )
+
+ ' Draw the border edges
+ SetBkMode(lpdis->hDC, TRANSPARENT)
+ rc = lpdis->rcItem
+ DrawEdge( lpdis->hDC, @rc, EDGE_SUNKEN, BF_BOTTOMRIGHT)
+ end if
+ END IF
+
+ end if
+ RestoreDC(lpdis->hDC, -1)
+
+ if hFontNormal then DeleteFont(hFontNormal)
+ if hFontBold then DeleteFont(hFontBold)
+
+ Function = True : Exit Function
+
+ End Select
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Process WM_DESTROY message for window/dialog: frmVDToolbox
+' ========================================================================================
+function frmVDToolbox_OnDestroy( byval HWnd As HWnd ) As LRESULT
+
+ ' Determine the current ToolBox positioning
+ Dim WinPla As WINDOWPLACEMENT
+ WinPla.Length = Sizeof(WinPla)
+ GetWindowPlacement(HWND_FRMVDTOOLBOX, @WinPla)
+ With gConfig
+ .ToolBoxLeft = WinPla.rcNormalPosition.Left
+ .ToolBoxTop = WinPla.rcNormalPosition.Top
+ .ToolBoxRight = WinPla.rcNormalPosition.Right
+ .ToolBoxBottom = WinPla.rcNormalPosition.Bottom
+ End With
+
+ ' Delete the manually created bold font
+ dim as hFONT hFontBold = AfxGetWindowFont( GetDlgItem(hwnd, IDC_FRMVDTOOLBOX_LBLPROPNAME ))
+ if hFontBold then DeleteFont(hFontBold)
+ HWND_FRMVDTOOLBOX = 0
+
+ Function = 0
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed ListBox window.
+' ========================================================================================
+function frmVDToolbox_ListBox_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ Select Case uMsg
+
+ case WM_ERASEBKGND
+ ' Only erase the bottom portion of the listbox that extends from the last item
+ ' to the bottom edge of the listbox. All other lines are already drawn. This helps
+ ' reduce screen flicker.
+ dim as RECT rc = GetListBoxEmptyClientArea( HWND, FRMVDTOOLBOX_LISTBOX_LINEHEIGHT )
+ if rc.top < rc.bottom then
+ dim as HDC hDC = cast(HDC, wParam)
+ FillRect(hDC, @rc, GetSysColorBrush(COLOR_WINDOW))
+ end if
+ return TRUE
+
+
+ case WM_COMMAND
+ if loword(wParam) = IDC_FRMVDTOOLBOX_COMBO then
+ if hiword(wParam) = BN_CLICKED then
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr()
+ dim pProp as clsProperty ptr = GetActivePropertyPtr()
+ if pProp then
+ if pProp->PropType = PropertyType.FontPicker then
+ ChooseFontForProperty(pProp)
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+ frmMain_SetStatusbar
+ PostMessage(HWND_FRMVDCOLORS, WM_ACTIVATE, WA_INACTIVE, 0) ' to apply properties
+ elseif pProp->PropType = PropertyType.CustomDialog then
+ ' Show the Custom dialog for this control
+ frmVDTabChild_Show(HWND_FRMMAIN, pProp->wszPropValue)
+ elseif pProp->PropType = PropertyType.ImagePicker then
+ frmImageManager_Show(HWND_FRMMAIN, pProp)
+ elseif pProp->PropType = PropertyType.ColorPicker then
+ dim as hwnd hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES)
+ dim as long nCurSel = ListBox_GetCurSel(hList)
+ dim as RECT rcLine
+ ListBox_GetItemRect(hList, nCurSel, @rcLine)
+ MapWindowPoints(hList, 0, cast(POINT ptr, @rcLine), 2)
+ frmVDColors_Show(hList, pProp->wszPropValue) ' initialize the color popup if not already done so
+ dim as long nWidth = AfxGetWindowWidth(HWND_FRMVDCOLORS)
+ SetWindowPos(HWND_FRMVDCOLORS, HWND_TOP, rcLine.right - nWidth, rcLine.bottom, 0, 0, SWP_NOSIZE or SWP_SHOWWINDOW)
+ elseif pProp->PropType = PropertyType.AnchorPicker then
+ dim as hwnd hList = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES)
+ dim as long nCurSel = ListBox_GetCurSel(hList)
+ dim as RECT rcLine
+ ListBox_GetItemRect(hList, nCurSel, @rcLine)
+ MapWindowPoints(hList, 0, cast(POINT ptr, @rcLine), 2)
+ frmVDAnchors_Show(hList, pProp->wszPropValue) ' initialize the Anchor popup if not already done so
+ dim as long nWidth = AfxGetWindowWidth(HWND_FRMVDANCHORS)
+ SetWindowPos(HWND_FRMVDANCHORS, HWND_TOP, rcLine.right - nWidth, rcLine.bottom, 0, 0, SWP_NOSIZE or SWP_SHOWWINDOW)
+ else
+ ' Show the ListBox portion of our "combo" control
+ ShowWindow(HWND_PROPLIST_COMBOLIST, SW_SHOW)
+ end if
+ end if
+ end if
+ END IF
+ if loword(wParam) = IDC_FRMVDTOOLBOX_COMBOLIST then
+ if (hiword(wParam) = LBN_SELCHANGE) then
+ ShowWindow(HWND_PROPLIST_COMBOLIST, SW_HIDE)
+ InitiatePropertyValueChange
+ end if
+ END IF
+
+ Case WM_GETDLGCODE
+ ' All keyboard input
+ Function = DLGC_WANTALLKEYS
+ Exit Function
+
+ Case WM_KEYUP
+ Select Case Loword(wParam)
+ Case VK_RETURN
+ ' Simulate the sending of a LBN_DBLCLK to the control.
+ SendMessage( GetParent(HWnd), WM_COMMAND, MAKEWPARAM(hwnd, LBN_DBLCLK), Cast(LPARAM,HWnd) )
+ Exit Function
+ End Select
+
+ case WM_LBUTTONDOWN
+ ' Hit test to see if the mouse is over the vertical splitter bar
+ if hwnd = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES) THEN
+ dim as long hPos = loword(lParam)
+ dim as RECT rc: GetClientRect(hwnd, @rc)
+ if (hPos >= gPropDivPos - 2) andalso (hPos <= gPropDivPos + 2) THEN
+ SetCursor( LoadCursor(0, ByVal IDC_SIZEWE) )
+ 'InvertLine(hwnd, gPropDivPos, rc.top, gPropDivPos, rc.bottom)
+ gPropDivTracking = true
+ SetCapture(hwnd)
+ else
+ SetCursor( LoadCursor(0, ByVal IDC_ARROW) )
+ END IF
+ else
+ SetCursor( LoadCursor(0, ByVal IDC_ARROW) )
+ END IF
+
+ case WM_LBUTTONUP
+ if hwnd = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES) THEN
+ if gPropDivTracking = true THEN
+ gPropDivTracking = false
+ ReleaseCapture
+ AfxRedrawWindow(hwnd)
+ end if
+ end if
+
+ if hwnd = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTEVENTS) THEN
+ ' Handle if the Events checkbox is clicked
+ dim as long nCurSel = ListBox_GetCurSel(hwnd)
+ if nCurSel = -1 then exit function
+ dim pDoc as clsDocument ptr = gTTabCtl.GetActiveDocumentPtr
+ dim pCtrl as clsControl ptr
+ if pDoc then
+ pCtrl = pDoc->Controls.GetActiveControl
+ if pCtrl THEN
+ Dim pWindow As CWindow Ptr = AfxCWindowPtr(GetParent(HWnd))
+ if pWindow = 0 THEN exit function
+ dim as RECT rc: SendMessage(hwnd, LB_GETITEMRECT, nCurSel, cast(LPARAM, @rc))
+ ' The checkbox is the first 20x20 area (16x16 icon)
+ rc.Left = rc.Left + pWindow->ScaleX(2)
+ rc.Top = rc.Top + pWindow->ScaleY(2)
+ rc.Right = rc.Left + pWindow->ScaleX(16)
+ rc.Bottom = rc.Top + pWindow->ScaleY(16)
+ dim as POINT pt = (loword(lParam), Hiword(lParam))
+ if PtInRect(@rc, pt) then
+ pCtrl->Events(nCurSel).bIsSelected = not pCtrl->Events(nCurSel).bIsSelected
+ InvalidateRect(hwnd, @rc, true): UpdateWindow(hwnd)
+ pDoc->UserModified = true
+ pDoc->bRegenerateCode = true
+ frmMain_SetStatusbar
+ end if
+ end if
+ end if
+ end if
+
+
+ case WM_MOUSEMOVE
+ if hwnd = GetDlgItem(HWND_FRMVDTOOLBOX, IDC_FRMVDTOOLBOX_LSTPROPERTIES) THEN
+ ' Hit test to see if the mouse is over the vertical splitter bar
+ dim as long hPos = loword(lParam)
+ dim as RECT rc: GetClientRect(hwnd, @rc)
+ if (hPos >= gPropDivPos - 2) andalso (hPos <= gPropDivPos + 2) THEN
+ SetCursor( LoadCursor(0, ByVal IDC_SIZEWE) )
+ if gPropDivTracking = true THEN
+ gPropDivPos = loword(lParam)
+ AfxRedrawWindow(hwnd)
+ end if
+ else
+ SetCursor( LoadCursor(0, ByVal IDC_ARROW) )
+ END IF
+ end if
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass HWnd, @frmVDToolBox_ListBox_SubclassProc, uIdSubclass
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' Processes messages for the subclassed TextEdit window.
+' ========================================================================================
+function frmVDToolbox_TextEdit_SubclassProc ( _
+ ByVal HWnd As HWnd, _ ' // Control window handle
+ ByVal uMsg As UINT, _ ' // Type of message
+ ByVal wParam As WPARAM, _ ' // First message parameter
+ ByVal lParam As LPARAM, _ ' // Second message parameter
+ ByVal uIdSubclass As UINT_PTR, _ ' // The subclass ID
+ ByVal dwRefData As DWORD_PTR _ ' // Pointer to reference data
+ ) As LRESULT
+
+ Select Case uMsg
+
+ Case WM_GETDLGCODE
+ ' All keyboard input
+ Function = DLGC_WANTALLKEYS
+ Exit Function
+
+ case WM_KILLFOCUS
+ InitiatePropertyValueChange
+ HidePropertyListControls
+
+ Case WM_CHAR ' filter characters and also prevent the annoying beep!
+ dim as clsProperty ptr pProp = GetActivePropertyPtr()
+ if pProp then
+ if pProp->PropType = PropertyType.EditEnterNumericOnly then
+ select case wParam
+ case 48 to 57 ' 0 to 9 (only allow these characters)
+ case 8 ' allow backspace
+ case else ' Filter out all other characters
+ return 0
+ end select
+ end if
+ end if
+ if wParam = 13 then return 0 ' ENTER
+ if wParam = 27 then return 0 ' ESC
+
+ Case WM_KEYUP
+ Select Case Loword(wParam)
+ Case VK_RETURN
+ ' Hide the edit control. WM_KILLFOCUS will be fired.
+ InitiatePropertyValueChange ' must do here otherwise edit control is not visible and change property will fail
+ HidePropertyListControls
+
+ Case VK_ESCAPE
+ ' Reset the edit value to original value
+ dim as clsProperty ptr pProp = GetActivePropertyPtr()
+ if pProp then AfxSetWindowText(HWND_PROPLIST_EDIT, pProp->wszPropValue)
+ HidePropertyListControls
+ End Select
+
+ Case WM_DESTROY
+ ' REQUIRED: Remove control subclassing
+ RemoveWindowSubclass HWnd, @frmVDToolBox_TextEdit_SubclassProc, uIdSubclass
+
+ End Select
+
+ ' Default processing of Windows messages
+ Function = DefSubclassProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmVDToolbox Window procedure
+' ========================================================================================
+function frmVDToolbox_WndProc( _
+ ByVal HWnd As HWnd, _
+ ByVal uMsg As UINT, _
+ ByVal wParam As WPARAM, _
+ ByVal lParam As LPARAM _
+ ) As LRESULT
+
+ Select Case uMsg
+ HANDLE_MSG (HWnd, WM_COMMAND, frmVDToolbox_OnCommand)
+ HANDLE_MSG (HWnd, WM_NOTIFY, frmVDToolbox_OnNotify)
+ HANDLE_MSG (HWnd, WM_SIZE, frmVDToolbox_OnSize)
+ HANDLE_MSG (HWnd, WM_CLOSE, frmVDToolbox_OnClose)
+ HANDLE_MSG (HWnd, WM_DESTROY, frmVDToolbox_OnDestroy)
+ HANDLE_MSG (HWnd, WM_MEASUREITEM, frmVDToolbox_OnMeasureItem)
+ HANDLE_MSG (HWnd, WM_DRAWITEM, frmVDToolbox_OnDrawItem)
+ End Select
+
+ ' for messages that we don't deal with
+ Function = DefWindowProc(HWnd, uMsg, wParam, lParam)
+
+End Function
+
+
+' ========================================================================================
+' frmVDToolbox_Show
+' ========================================================================================
+function frmVDToolbox_Show( _
+ ByVal hWndParent As HWnd, _
+ ByVal nCmdShow As Long = 0 _
+ ) As LRESULT
+
+ ' If Toolbox already exists then toggle its visibility
+ ' unless nCmdShow is explicitly set to show it.
+ If IsWindow(HWND_FRMVDTOOLBOX) Then
+ If nCmdShow <> SW_SHOW Then nCmdShow = Iif(IsWindowVisible(HWND_FRMVDTOOLBOX), SW_HIDE, SW_SHOW)
+ ShowWindow HWND_FRMVDTOOLBOX, nCmdShow
+ Exit Function
+ Else
+ ' If the window does not exist yet then ensure that it becomes visible after creation.
+ nCmdShow = SW_SHOW
+ End If
+
+ Dim pMainWindow As CWindow Ptr = AfxCWindowPtr(HWND_FRMMAIN)
+ Dim rcWork As RECT = pMainWindow->GetWorkArea
+ ' The rcWork rectangle is not high DPI aware
+
+ ' SET STARTUP POSITION
+ Dim WinPla As WINDOWPLACEMENT
+
+ ' If no valid window size exists then set to the default working area of the screen
+ If (gConfig.ToolBoxRight = 0) OrElse (gConfig.ToolBoxBottom = 0) Then
+ ' Retrieve the size of the working area (not high dpi aware)
+ ' ensure all of the values are high dpi aware
+ dim as long nHeight = pMainWindow->ScaleY( (rcWork.Bottom - rcWork.Top) * .70 )
+ dim as long nWidth = pMainWindow->ScaleX( 300 )
+ gConfig.ToolBoxLeft = pMainWindow->ScaleX( rcWork.Right - 360 )
+ gConfig.ToolBoxTop = (pMainWindow->ScaleY( rcWork.bottom ) - nHeight ) / 2
+ gConfig.ToolBoxRight = gConfig.ToolBoxLeft + nWidth
+ gConfig.ToolBoxBottom = gConfig.ToolBoxTop + nHeight
+ End If
+
+ With WinPla
+ .Length = Sizeof(WinPla)
+ .rcNormalPosition.Left = gConfig.ToolBoxLeft
+ .rcNormalPosition.Top = gConfig.ToolBoxTop
+ .rcNormalPosition.Right = gConfig.ToolBoxRight
+ .rcNormalPosition.Bottom = gConfig.ToolBoxBottom
+ .showCmd = SW_SHOWNORMAL
+ End With
+
+
+ ' Create the main window and child controls
+ Dim pWindow As CWindow Ptr = New CWindow
+ pWindow->DPI = AfxCWindowOwnerPtr(hwndParent)->DPI
+
+ HWND_FRMVDTOOLBOX = _
+ pWindow->Create( hWndParent, L(352,"Toolbox"), @frmVDToolbox_WndProc, 0, 0, 0, 0, _
+ WS_POPUP Or WS_CAPTION or WS_SYSMENU or WS_THICKFRAME or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN, _
+ WS_EX_CLIENTEDGE)
+ ' We will set our own mouse pointer as needed
+ SetClassLongPtr(HWND_FRMVDTOOLBOX, GCLP_HCURSOR, 0)
+
+ SetWindowPlacement(HWND_FRMVDTOOLBOX, @WinPla)
+
+ ' Set the small and large icon for the main window (must be set after main window is created)
+ pWindow->BigIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 32, 32, LR_SHARED)
+ pWindow->SmallIcon = LoadImage( pWindow->InstanceHandle, "IMAGE_AAA_MAINICON", IMAGE_ICON, 16, 16, LR_SHARED)
+
+ Dim As HWnd hTabCtl = _
+ pWindow->AddControl("TAB", , IDC_FRMVDTOOLBOX_TABCONTROL, "", 0, 0, 0, 0)
+
+ TabCtrl_AddTab(hTabCtl, 0, L(351,"Tools"))
+ TabCtrl_AddTab(hTabCtl, 0, L(350,"Properties"))
+ TabCtrl_AddTab(hTabCtl, 0, L(353,"Events"))
+
+ Dim As HWnd hCombo = _
+ pWindow->AddControl("COMBOBOX", , IDC_FRMVDTOOLBOX_COMBOCONTROLS, "", 0, 0, 0, 0, _
+ WS_CHILD or WS_TABSTOP Or CBS_DROPDOWNLIST or CBS_SORT or CBS_OWNERDRAWFIXED or CBS_HASSTRINGS Or WS_VSCROLL, _
+ WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR)
+
+ Dim As HWnd hList1 = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMVDTOOLBOX_LSTTOOLBOX, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_VISIBLE or WS_TABSTOP Or LBS_NOINTEGRALHEIGHT Or WS_VSCROLL or _
+ LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS Or LBS_NOTIFY, WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmVDToolbox_ListBox_SubclassProc), IDC_FRMVDTOOLBOX_LSTTOOLBOX, Cast(DWORD_PTR, @pWindow))
+
+ Dim As HWnd hList2 = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMVDTOOLBOX_LSTPROPERTIES, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or LBS_NOINTEGRALHEIGHT Or WS_VSCROLL or _
+ LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS Or LBS_SORT or LBS_NOTIFY, WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmVDToolbox_ListBox_SubclassProc), IDC_FRMVDTOOLBOX_LSTPROPERTIES, Cast(DWORD_PTR, @pWindow))
+
+ Dim As HWnd hLabel = _
+ pWindow->AddControl("LABEL", , IDC_FRMVDTOOLBOX_LBLPROPNAME, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, WS_EX_LEFT Or WS_EX_LTRREADING)
+ dim as HFONT hFontBold = pWindow->CreateFont( pWindow->DefaultFontName, pWindow->DefaultFontSize, FW_BOLD )
+ AfxSetWindowFont(hLabel, hFontBold)
+
+ pWindow->AddControl("LABEL", , IDC_FRMVDTOOLBOX_LBLPROPDESCRIBE, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or SS_LEFT, WS_EX_LEFT Or WS_EX_LTRREADING)
+
+ Dim As HWnd hList3 = _
+ pWindow->AddControl("LISTBOX", , IDC_FRMVDTOOLBOX_LSTEVENTS, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or LBS_NOINTEGRALHEIGHT Or WS_VSCROLL or _
+ LBS_OWNERDRAWFIXED Or LBS_HASSTRINGS Or LBS_NOTIFY, WS_EX_CLIENTEDGE Or WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR, , _
+ Cast(SUBCLASSPROC, @frmVDToolbox_ListBox_SubclassProc), IDC_FRMVDTOOLBOX_LSTEVENTS, Cast(DWORD_PTR, @pWindow))
+
+ HWND_PROPLIST_EDIT = _
+ pWindow->AddControl("TEXTBOX", hList2, IDC_FRMVDTOOLBOX_TEXTEDIT, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or ES_LEFT Or ES_AUTOHSCROLL, _
+ 0, , _
+ Cast(SUBCLASSPROC, @frmVDToolbox_TextEdit_SubclassProc), IDC_FRMVDTOOLBOX_TEXTEDIT, Cast(DWORD_PTR, @pWindow))
+
+ DIM hBitmap AS HBITMAP
+ HWND_PROPLIST_COMBO = _
+ pWindow->AddControl("BITMAPBUTTON", hList2, IDC_FRMVDTOOLBOX_COMBO, "", 0, 0, 0, 0, _
+ WS_CHILD Or WS_TABSTOP Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or BS_BITMAP Or BS_PUSHBUTTON Or BS_NOTIFY Or BS_CENTER Or BS_VCENTER Or LR_DEFAULTCOLOR Or LR_LOADMAP3DCOLORS Or LR_LOADTRANSPARENT Or LR_SHARED, _
+ WS_EX_LEFT Or WS_EX_LTRREADING)
+ dim wszImage as wstring * 100
+ wszImage = iif(pWindow->DPI > 96, "IMAGE_ARROWDOWN", "IMAGE_ARROWDOWN16")
+ hBitmap = AfxGdipImageFromRes(pWindow->InstanceHandle, wszImage, 0, false, IMAGE_BITMAP, 0)
+ SendMessage(HWND_PROPLIST_COMBO, BM_SETIMAGE, IMAGE_BITMAP, cast(LPARAM, hBitmap))
+ IF hBitmap THEN DeleteObject(hBitmap)
+
+
+ HWND_PROPLIST_COMBOLIST = _
+ pWindow->AddControl("LISTBOX", hList2, IDC_FRMVDTOOLBOX_COMBOLIST, "", 0, 0, 0, 120, _
+ WS_CHILD Or WS_BORDER or WS_VSCROLL or LBS_NOINTEGRALHEIGHT or LBS_HASSTRINGS Or LBS_NOTIFY, WS_EX_LEFT Or WS_EX_RIGHTSCROLLBAR)
+
+
+ ' Set the default position for the vertical sizing bar
+ gPropDivPos = pWindow->ScaleY(0.4 * 300)
+
+ ' Add the Tools to the toolbox
+ dim as long ndx
+ for i as long = lbound(gToolBox) to ubound(gToolBox)
+ ndx = ListBox_AddString(hList1, gToolBox(i).wszToolBoxName.sptr)
+ ListBox_SetItemData(hList1, ndx, i)
+ NEXT
+ SetActiveToolboxControl(CTRL_POINTER)
+
+ ' Initialize the popup Colors selection dialog
+ frmVDColors_Show(hList2, "")
+
+ frmVDToolbox_PositionWindows
+
+ ' Ensure the window is placed on screen should the user had changed
+ ' the logical ordering of a multiple display setup.
+ AfxForceVisibleDisplay(HWND_FRMVDTOOLBOX)
+
+
+ TabCtrl_SetCurSel(hTabCtl, 0)
+ ShowWindow HWND_FRMVDTOOLBOX, nCmdShow
+ ListBox_SetCurSel(hList1, 0)
+ SetFocus hList1
+
+ Function = 0
+End Function
+
diff --git a/src/windowsxx.bi b/src/windowsxx.bi
index 02c32ab4..16ceb5b3 100644
--- a/src/windowsxx.bi
+++ b/src/windowsxx.bi
@@ -1,5 +1,5 @@
' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
-' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+' Copyright (C) 2016-2023 Paul Squires, PlanetSquires Software
'
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
diff --git a/src/windowsxx.bi.bak b/src/windowsxx.bi.bak
new file mode 100644
index 00000000..02c32ab4
--- /dev/null
+++ b/src/windowsxx.bi.bak
@@ -0,0 +1,581 @@
+' WinFBE - Programmer's Code Editor for the FreeBASIC Compiler
+' Copyright (C) 2016-2022 Paul Squires, PlanetSquires Software
+'
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT any WARRANTY; without even the implied warranty of
+' MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the
+' GNU General Public License for more details.
+
+
+'' FreeBASIC binding for mingw-w64-v4.0.4
+''
+'' based on the C header files:
+'' DISCLAIMER
+'' This file has no copyright assigned and is placed in the Public Domain.
+'' This file is part of the mingw-w64 runtime package.
+''
+'' The mingw-w64 runtime package and its code is distributed in the hope that it
+'' will be useful but WITHOUT ANY WARRANTY. ALL WARRANTIES, EXPRESSED OR
+'' IMPLIED ARE HEREBY DISCLAIMED. This includes but is not limited to
+'' warranties of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+''
+'' translated to FreeBASIC by:
+'' Copyright © 2015 FreeBASIC development team
+
+#pragma once
+
+#define _INC_WINDOWSX
+#Define GetInstanceModule(hInstance) Cast(HMODULE, (hInstance))
+#define GlobalPtrHandle(lp) cast(HGLOBAL, GlobalHandle(lp))
+#define GlobalLockPtr(lp) cast(WINBOOL, GlobalLock(GlobalPtrHandle(lp)))
+#define GlobalUnlockPtr(lp) GlobalUnlock(GlobalPtrHandle(lp))
+#define GlobalAllocPtr(flags, cb) GlobalLock(GlobalAlloc((flags), (cb)))
+#macro GlobalReAllocPtr(lp, cbNew, flags)
+ scope
+ GlobalUnlockPtr(lp)
+ GlobalLock(GlobalReAlloc(GlobalPtrHandle(lp), (cbNew), (flags)))
+ end scope
+#endmacro
+#macro GlobalFreePtr(lp)
+ scope
+ GlobalUnlockPtr(lp)
+ cast(WINBOOL, cast(ULONG_PTR, GlobalFree(GlobalPtrHandle(lp))))
+ end scope
+#endmacro
+#Define DeletePen(_hpen) DeleteObject(Cast(HGDIOBJ, Cast(HPEN, (_hpen))))
+#Define SelectPen(hdc, _hpen) Cast(HPEN, SelectObject((hdc), Cast(HGDIOBJ, Cast(HPEN, (_hpen)))))
+#define GetStockPen(i) cast(HPEN, GetStockObject(i))
+#define DeleteBrush(hbr) DeleteObject(cast(HGDIOBJ, cast(HBRUSH, (hbr))))
+#define SelectBrush(hdc, hbr) cast(HBRUSH, SelectObject((hdc), cast(HGDIOBJ, cast(HBRUSH, (hbr)))))
+#define GetStockBrush(i) cast(HBRUSH, GetStockObject(i))
+#Define DeleteRgn(_hrgn) DeleteObject(Cast(HGDIOBJ, Cast(HRGN, (_hrgn))))
+#define CopyRgn(hrgnDst, hrgnSrc) CombineRgn(hrgnDst, hrgnSrc, 0, RGN_COPY)
+#define IntersectRgn(hrgnResult, hrgnA, hrgnB) CombineRgn(hrgnResult, hrgnA, hrgnB, RGN_AND)
+#define SubtractRgn(hrgnResult, hrgnA, hrgnB) CombineRgn(hrgnResult, hrgnA, hrgnB, RGN_DIFF)
+#define UnionRgn(hrgnResult, hrgnA, hrgnB) CombineRgn(hrgnResult, hrgnA, hrgnB, RGN_OR)
+#define XorRgn(hrgnResult, hrgnA, hrgnB) CombineRgn(hrgnResult, hrgnA, hrgnB, RGN_XOR)
+#define DeletePalette(hpal) DeleteObject(cast(HGDIOBJ, cast(HPALETTE, (hpal))))
+#Define DeleteFont(_hfont) DeleteObject(Cast(HGDIOBJ, Cast(HFONT, (_hfont))))
+#Define SelectFont(hdc, _hfont) Cast(HFONT, SelectObject((hdc), Cast(HGDIOBJ, Cast(HFONT, (_hfont)))))
+#define GetStockFont(i) cast(HFONT, GetStockObject(i))
+#define DeleteBitmap(hbm) DeleteObject(cast(HGDIOBJ, cast(HBITMAP, (hbm))))
+#define SelectBitmap(hdc, hbm) cast(HBITMAP, SelectObject((hdc), cast(HGDIOBJ, cast(HBITMAP, (hbm)))))
+#define InsetRect(lprc, dx, dy) InflateRect((lprc), -(dx), -(dy))
+#define GetWindowInstance(hwnd) cast(HMODULE, GetWindowLongPtr(hwnd, GWLP_HINSTANCE))
+#define GetWindowStyle(hwnd) cast(DWORD, GetWindowLong(hwnd, GWL_STYLE))
+#define GetWindowExStyle(hwnd) cast(DWORD, GetWindowLong(hwnd, GWL_EXSTYLE))
+#define GetWindowOwner(hwnd) GetWindow(hwnd, GW_OWNER)
+#define GetFirstChild(hwnd) GetTopWindow(hwnd)
+#define GetFirstSibling(hwnd) GetWindow(hwnd, GW_HWNDFIRST)
+#define GetLastSibling(hwnd) GetWindow(hwnd, GW_HWNDLAST)
+#define GetNextSibling(hwnd) GetWindow(hwnd, GW_HWNDNEXT)
+#define GetPrevSibling(hwnd) GetWindow(hwnd, GW_HWNDPREV)
+#define GetWindowID(hwnd) GetDlgCtrlID(hwnd)
+#define SetWindowRedraw(hwnd, fRedraw) SNDMSG(hwnd, WM_SETREDRAW, cast(WPARAM, cast(WINBOOL, (fRedraw))), cast(LPARAM, 0))
+#define SubclassWindow(hwnd, lpfn) cast(WNDPROC, SetWindowLongPtr((hwnd), GWLP_WNDPROC, cast(LPARAM, cast(WNDPROC, (lpfn)))))
+#define IsMinimized(hwnd) IsIconic(hwnd)
+#define IsMaximized(hwnd) IsZoomed(hwnd)
+#define IsRestored(hwnd) ((GetWindowStyle(hwnd) and (WS_MINIMIZE or WS_MAXIMIZE)) = 0)
+#Define SetWindowFont(HWnd, _hfont, fRedraw) FORWARD_WM_SETFONT((HWnd), (_hfont), (fRedraw), SNDMSG)
+#define GetWindowFont(hwnd) FORWARD_WM_GETFONT((hwnd), SNDMSG)
+#define MapWindowRect(hwndFrom, hwndTo, lprc) MapWindowPoints((hwndFrom), (hwndTo), cptr(POINT ptr, (lprc)), 2)
+#define IsLButtonDown() (GetKeyState(VK_LBUTTON) < 0)
+#define IsRButtonDown() (GetKeyState(VK_RBUTTON) < 0)
+#define IsMButtonDown() (GetKeyState(VK_MBUTTON) < 0)
+#define SubclassDialog(hwndDlg, lpfn) SetWindowLongPtr(hwndDlg, DWLP_DLGPROC, cast(LPARAM, (lpfn)))
+'' TODO: #define SetDlgMsgResult(hwnd,msg,result) (((msg)==WM_CTLCOLORMSGBOX || (msg)==WM_CTLCOLOREDIT || (msg)==WM_CTLCOLORLISTBOX || (msg)==WM_CTLCOLORBTN || (msg)==WM_CTLCOLORDLG || (msg)==WM_CTLCOLORSCROLLBAR || (msg)==WM_CTLCOLORSTATIC || (msg)==WM_COMPAREITEM || (msg)==WM_VKEYTOITEM || (msg)==WM_CHARTOITEM || (msg)==WM_QUERYDRAGICON || (msg)==WM_INITDIALOG) ? (WINBOOL)(result) : (SetWindowLongPtr((hwnd),DWLP_MSGRESULT,(LPARAM)(LRESULT)(result)),TRUE))
+#macro DefDlgProcEx(hwnd, msg, wParam, lParam, pfRecursion)
+ scope
+ (*(pfRecursion)) = CTRUE
+ DefDlgProc(hwnd, msg, wParam, lParam)
+ end scope
+#endmacro
+#macro CheckDefDlgRecursion(pfRecursion)
+ if *(pfRecursion) then
+ (*(pfRecursion)) = FALSE
+ return FALSE
+ end if
+#endmacro
+
+#Define HANDLE_MSG(HWnd,message,fn) Case message: Return HANDLE_##message(HWnd,wParam,lParam,fn)
+#Define HANDLE_WM_COMPACTING(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)))
+#define FORWARD_WM_COMPACTING(hwnd, compactRatio, fn) fn((hwnd), WM_COMPACTING, cast(WPARAM, cast(UINT, (compactRatio))), cast(LPARAM, 0))
+#Define HANDLE_WM_WININICHANGE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(LPCTSTR, (lParam)))
+#define FORWARD_WM_WININICHANGE(hwnd, lpszSectionName, fn) fn((hwnd), WM_WININICHANGE, cast(WPARAM, 0), cast(LPARAM, cast(LPCTSTR, (lpszSectionName))))
+#Define HANDLE_WM_SYSCOLORCHANGE(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_SYSCOLORCHANGE(hwnd, fn) fn((hwnd), WM_SYSCOLORCHANGE, cast(WPARAM, 0), cast(LPARAM, 0))
+#define HANDLE_WM_QUERYNEWPALETTE(hwnd, wParam, lParam, fn) MAKELRESULT(cast(WINBOOL, fn(hwnd)), cast(LRESULT, 0))
+#define FORWARD_WM_QUERYNEWPALETTE(hwnd, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_QUERYNEWPALETTE, cast(WPARAM, 0), cast(LPARAM, 0))))
+#Define HANDLE_WM_PALETTEISCHANGING(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)))
+#define FORWARD_WM_PALETTEISCHANGING(hwnd, hwndPaletteChange, fn) fn((hwnd), WM_PALETTEISCHANGING, cast(WPARAM, cast(HWND, (hwndPaletteChange))), cast(LPARAM, 0))
+#Define HANDLE_WM_PALETTECHANGED(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)))
+#define FORWARD_WM_PALETTECHANGED(hwnd, hwndPaletteChange, fn) fn((hwnd), WM_PALETTECHANGED, cast(WPARAM, cast(HWND, (hwndPaletteChange))), cast(LPARAM, 0))
+#Define HANDLE_WM_FONTCHANGE(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_FONTCHANGE(hwnd, fn) fn((hwnd), WM_FONTCHANGE, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_SPOOLERSTATUS(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)), CLng(CShort(Loword(lParam))))
+#define FORWARD_WM_SPOOLERSTATUS(hwnd, status, cJobInQueue, fn) fn((hwnd), WM_SPOOLERSTATUS, cast(WPARAM, (status)), MAKELPARAM((cJobInQueue), 0))
+#Define HANDLE_WM_DEVMODECHANGE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(LPCTSTR, (lParam)))
+#define FORWARD_WM_DEVMODECHANGE(hwnd, lpszDeviceName, fn) fn((hwnd), WM_DEVMODECHANGE, cast(WPARAM, 0), cast(LPARAM, cast(LPCTSTR, (lpszDeviceName))))
+#Define HANDLE_WM_TIMECHANGE(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_TIMECHANGE(hwnd, fn) fn((hwnd), WM_TIMECHANGE, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_POWER(HWnd, wParam, lParam, fn) fn((HWnd), CLng(wParam))
+#define FORWARD_WM_POWER(hwnd, code, fn) fn((hwnd), WM_POWER, cast(WPARAM, clng(code)), cast(LPARAM, 0))
+#define HANDLE_WM_QUERYENDSESSION(hwnd, wParam, lParam, fn) MAKELRESULT(cast(WINBOOL, fn(hwnd)), cast(LRESULT, 0))
+#define FORWARD_WM_QUERYENDSESSION(hwnd, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_QUERYENDSESSION, cast(WPARAM, 0), cast(LPARAM, 0))))
+#Define HANDLE_WM_ENDSESSION(HWnd, wParam, lParam, fn) fn((HWnd), Cast(WINBOOL, (wParam)))
+#define FORWARD_WM_ENDSESSION(hwnd, fEnding, fn) fn((hwnd), WM_ENDSESSION, cast(WPARAM, cast(WINBOOL, (fEnding))), cast(LPARAM, 0))
+#Define HANDLE_WM_QUIT(HWnd, wParam, lParam, fn) fn((HWnd), CLng(wParam))
+#define FORWARD_WM_QUIT(hwnd, exitCode, fn) fn((hwnd), WM_QUIT, cast(WPARAM, (exitCode)), cast(LPARAM, 0))
+#define HANDLE_WM_SYSTEMERROR(hwnd, wParam, lParam, fn) cast(LRESULT, 0)
+#define FORWARD_WM_SYSTEMERROR(hwnd, errCode, fn) cast(LRESULT, 0)
+#define HANDLE_WM_CREATE(hwnd, wParam, lParam, fn) cast(LRESULT, iif(fn((hwnd), cast(LPCREATESTRUCT, (lParam))), 0, -1))
+#define FORWARD_WM_CREATE(hwnd, lpCreateStruct, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_CREATE, cast(WPARAM, 0), cast(LPARAM, cast(LPCREATESTRUCT, (lpCreateStruct))))))
+#define HANDLE_WM_NCCREATE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(WINBOOL, fn((hwnd), cast(LPCREATESTRUCT, (lParam))))))
+#define FORWARD_WM_NCCREATE(hwnd, lpCreateStruct, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_NCCREATE, cast(WPARAM, 0), cast(LPARAM, cast(LPCREATESTRUCT, (lpCreateStruct))))))
+#Define HANDLE_WM_DESTROY(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_DESTROY(hwnd, fn) fn((hwnd), WM_DESTROY, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_NCDESTROY(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_NCDESTROY(hwnd, fn) fn((hwnd), WM_NCDESTROY, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_SHOWWINDOW(HWnd, wParam, lParam, fn) fn((HWnd), Cast(WINBOOL, (wParam)), Cast(UINT, (lParam)))
+#define FORWARD_WM_SHOWWINDOW(hwnd, fShow, status, fn) fn((hwnd), WM_SHOWWINDOW, cast(WPARAM, cast(WINBOOL, (fShow))), cast(LPARAM, cast(UINT, (status))))
+#Define HANDLE_WM_SETREDRAW(HWnd, wParam, lParam, fn) fn((HWnd), Cast(WINBOOL, (wParam)))
+#define FORWARD_WM_SETREDRAW(hwnd, fRedraw, fn) fn((hwnd), WM_SETREDRAW, cast(WPARAM, cast(WINBOOL, (fRedraw))), cast(LPARAM, 0))
+#Define HANDLE_WM_ENABLE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(WINBOOL, (wParam)))
+#define FORWARD_WM_ENABLE(hwnd, fEnable, fn) fn((hwnd), WM_ENABLE, cast(WPARAM, cast(WINBOOL, (fEnable))), cast(LPARAM, 0))
+#Define HANDLE_WM_SETTEXT(HWnd, wParam, lParam, fn) fn((HWnd), Cast(LPCTSTR, (lParam)))
+#define FORWARD_WM_SETTEXT(hwnd, lpszText, fn) fn((hwnd), WM_SETTEXT, cast(WPARAM, 0), cast(LPARAM, cast(LPCTSTR, (lpszText))))
+#define HANDLE_WM_GETTEXT(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, clng(fn((hwnd), clng(wParam), cast(LPTSTR, (lParam))))))
+#define FORWARD_WM_GETTEXT(hwnd, cchTextMax, lpszText, fn) clng(cast(DWORD, fn((hwnd), WM_GETTEXT, cast(WPARAM, clng(cchTextMax)), cast(LPARAM, cast(LPTSTR, (lpszText))))))
+#define HANDLE_WM_GETTEXTLENGTH(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, clng(fn(hwnd))))
+#define FORWARD_WM_GETTEXTLENGTH(hwnd, fn) clng(cast(DWORD, fn((hwnd), WM_GETTEXTLENGTH, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define HANDLE_WM_WINDOWPOSCHANGING(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(WINBOOL, fn((hwnd), cast(LPWINDOWPOS, (lParam))))))
+#define FORWARD_WM_WINDOWPOSCHANGING(hwnd, lpwpos, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_WINDOWPOSCHANGING, cast(WPARAM, 0), cast(LPARAM, cast(LPWINDOWPOS, (lpwpos))))))
+#Define HANDLE_WM_WINDOWPOSCHANGED(HWnd, wParam, lParam, fn) fn((HWnd), Cast(Const LPWINDOWPOS, (lParam)))
+#define FORWARD_WM_WINDOWPOSCHANGED(hwnd, lpwpos, fn) fn((hwnd), WM_WINDOWPOSCHANGED, cast(WPARAM, 0), cast(LPARAM, cast(const LPWINDOWPOS, (lpwpos))))
+#Define HANDLE_WM_MOVE(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))))
+#define FORWARD_WM_MOVE(hwnd, x, y, fn) fn((hwnd), WM_MOVE, cast(WPARAM, 0), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_SIZE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))))
+#define FORWARD_WM_SIZE(hwnd, state, cx, cy, fn) fn((hwnd), WM_SIZE, cast(WPARAM, cast(UINT, (state))), MAKELPARAM((cx), (cy)))
+#Define HANDLE_WM_CLOSE(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_CLOSE(hwnd, fn) fn((hwnd), WM_CLOSE, cast(WPARAM, 0), cast(LPARAM, 0))
+#define HANDLE_WM_QUERYOPEN(hwnd, wParam, lParam, fn) MAKELRESULT(cast(WINBOOL, fn(hwnd)), 0)
+#define FORWARD_WM_QUERYOPEN(hwnd, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_QUERYOPEN, cast(WPARAM, 0), cast(LPARAM, 0))))
+#Define HANDLE_WM_GETMINMAXINFO(HWnd, wParam, lParam, fn) fn((HWnd), Cast(LPMINMAXINFO, (lParam)))
+#define FORWARD_WM_GETMINMAXINFO(hwnd, lpMinMaxInfo, fn) fn((hwnd), WM_GETMINMAXINFO, cast(WPARAM, 0), cast(LPARAM, cast(LPMINMAXINFO, (lpMinMaxInfo))))
+#Define HANDLE_WM_PAINT(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_PAINT(hwnd, fn) fn((hwnd), WM_PAINT, cast(WPARAM, 0), cast(LPARAM, 0))
+#define HANDLE_WM_ERASEBKGND(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(WINBOOL, fn((hwnd), cast(HDC, (wParam))))))
+#define FORWARD_WM_ERASEBKGND(hwnd, hdc, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_ERASEBKGND, cast(WPARAM, cast(HDC, (hdc))), cast(LPARAM, 0))))
+#define HANDLE_WM_ICONERASEBKGND(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(WINBOOL, fn((hwnd), cast(HDC, (wParam))))))
+#define FORWARD_WM_ICONERASEBKGND(hwnd, hdc, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_ICONERASEBKGND, cast(WPARAM, cast(HDC, (hdc))), cast(LPARAM, 0))))
+#Define HANDLE_WM_NCPAINT(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HRGN, (wParam)))
+#define FORWARD_WM_NCPAINT(hwnd, hrgn, fn) fn((hwnd), WM_NCPAINT, cast(WPARAM, cast(HRGN, (hrgn))), cast(LPARAM, 0))
+#define HANDLE_WM_NCCALCSIZE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(UINT, fn((hwnd), cast(WINBOOL, (wParam)), cptr(NCCALCSIZE_PARAMS ptr, (lParam))))))
+#define FORWARD_WM_NCCALCSIZE(hwnd, fCalcValidRects, lpcsp, fn) cast(UINT, cast(DWORD, fn((hwnd), WM_NCCALCSIZE, cast(WPARAM, (fCalcValidRects)), cast(LPARAM, cptr(NCCALCSIZE_PARAMS ptr, (lpcsp))))))
+#define HANDLE_WM_NCHITTEST(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(UINT, fn((hwnd), clng(cshort(LOWORD(lParam))), clng(cshort(HIWORD(lParam)))))))
+#define FORWARD_WM_NCHITTEST(hwnd, x, y, fn) cast(UINT, cast(DWORD, fn((hwnd), WM_NCHITTEST, cast(WPARAM, 0), MAKELPARAM((x), (y)))))
+#define HANDLE_WM_QUERYDRAGICON(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(UINT, fn(hwnd))))
+#define FORWARD_WM_QUERYDRAGICON(hwnd, fn) cast(HICON, cast(UINT, cast(DWORD, fn((hwnd), WM_QUERYDRAGICON, cast(WPARAM, 0), cast(LPARAM, 0)))))
+#Define HANDLE_WM_DROPFILES(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HDROP, (wParam)))
+#define FORWARD_WM_DROPFILES(hwnd, hdrop, fn) fn((hwnd), WM_DROPFILES, cast(WPARAM, cast(HDROP, (hdrop))), cast(LPARAM, 0))
+#Define HANDLE_WM_ACTIVATE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, Loword(wParam)), Cast(HWnd, (lParam)), Cast(WINBOOL, Hiword(wParam)))
+#define FORWARD_WM_ACTIVATE(hwnd, state, hwndActDeact, fMinimized, fn) fn((hwnd), WM_ACTIVATE, MAKEWPARAM((state), (fMinimized)), cast(LPARAM, cast(HWND, (hwndActDeact))))
+#Define HANDLE_WM_ACTIVATEAPP(HWnd, wParam, lParam, fn) fn((HWnd), Cast(WINBOOL, (wParam)), Cast(DWORD, (lParam)))
+#define FORWARD_WM_ACTIVATEAPP(hwnd, fActivate, dwThreadId, fn) fn((hwnd), WM_ACTIVATEAPP, cast(WPARAM, cast(WINBOOL, (fActivate))), cast(LPARAM, (dwThreadId)))
+#define HANDLE_WM_NCACTIVATE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(WINBOOL, fn((hwnd), cast(WINBOOL, (wParam)), cast(WPARAM, 0), cast(LPARAM, 0)))))
+#define FORWARD_WM_NCACTIVATE(hwnd, fActive, hwndActDeact, fMinimized, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_NCACTIVATE, cast(WPARAM, cast(WINBOOL, (fActive))), cast(LPARAM, 0))))
+#Define HANDLE_WM_SETFOCUS(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)))
+#define FORWARD_WM_SETFOCUS(hwnd, hwndOldFocus, fn) fn((hwnd), WM_SETFOCUS, cast(WPARAM, cast(HWND, (hwndOldFocus))), cast(LPARAM, 0))
+#Define HANDLE_WM_KILLFOCUS(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)))
+#define FORWARD_WM_KILLFOCUS(hwnd, hwndNewFocus, fn) fn((hwnd), WM_KILLFOCUS, cast(WPARAM, cast(HWND, (hwndNewFocus))), cast(LPARAM, 0))
+#Define HANDLE_WM_KEYDOWN(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)), CTRUE, CLng(CShort(Loword(lParam))), Cast(UINT, Hiword(lParam)))
+#define FORWARD_WM_KEYDOWN(hwnd, vk, cRepeat, flags, fn) fn((hwnd), WM_KEYDOWN, cast(WPARAM, cast(UINT, (vk))), MAKELPARAM((cRepeat), (flags)))
+#Define HANDLE_WM_KEYUP(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)), False, CLng(CShort(Loword(lParam))), Cast(UINT, Hiword(lParam)))
+#define FORWARD_WM_KEYUP(hwnd, vk, cRepeat, flags, fn) fn((hwnd), WM_KEYUP, cast(WPARAM, cast(UINT, (vk))), MAKELPARAM((cRepeat), (flags)))
+#Define HANDLE_WM_CHAR(HWnd, wParam, lParam, fn) fn((HWnd), Cast(TCHAR, (wParam)), CLng(CShort(Loword(lParam))))
+#define FORWARD_WM_CHAR(hwnd, ch, cRepeat, fn) fn((hwnd), WM_CHAR, cast(WPARAM, cast(TCHAR, (ch))), MAKELPARAM((cRepeat), 0))
+#Define HANDLE_WM_DEADCHAR(HWnd, wParam, lParam, fn) fn((HWnd), Cast(TCHAR, (wParam)), CLng(CShort(Loword(lParam))))
+#define FORWARD_WM_DEADCHAR(hwnd, ch, cRepeat, fn) fn((hwnd), WM_DEADCHAR, cast(WPARAM, cast(TCHAR, (ch))), MAKELPARAM((cRepeat), 0))
+#Define HANDLE_WM_SYSKEYDOWN(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)), CTRUE, CLng(CShort(Loword(lParam))), Cast(UINT, Hiword(lParam)))
+#define FORWARD_WM_SYSKEYDOWN(hwnd, vk, cRepeat, flags, fn) fn((hwnd), WM_SYSKEYDOWN, cast(WPARAM, cast(UINT, (vk))), MAKELPARAM((cRepeat), (flags)))
+#Define HANDLE_WM_SYSKEYUP(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)), False, CLng(CShort(Loword(lParam))), Cast(UINT, Hiword(lParam)))
+#define FORWARD_WM_SYSKEYUP(hwnd, vk, cRepeat, flags, fn) fn((hwnd), WM_SYSKEYUP, cast(WPARAM, cast(UINT, (vk))), MAKELPARAM((cRepeat), (flags)))
+#Define HANDLE_WM_SYSCHAR(HWnd, wParam, lParam, fn) fn((HWnd), Cast(TCHAR, (wParam)), CLng(CShort(Loword(lParam))))
+#define FORWARD_WM_SYSCHAR(hwnd, ch, cRepeat, fn) fn((hwnd), WM_SYSCHAR, cast(WPARAM, cast(TCHAR, (ch))), MAKELPARAM((cRepeat), 0))
+#Define HANDLE_WM_SYSDEADCHAR(HWnd, wParam, lParam, fn) fn((HWnd), Cast(TCHAR, (wParam)), CLng(CShort(Loword(lParam))))
+#define FORWARD_WM_SYSDEADCHAR(hwnd, ch, cRepeat, fn) fn((hwnd), WM_SYSDEADCHAR, cast(WPARAM, cast(TCHAR, (ch))), MAKELPARAM((cRepeat), 0))
+#Define HANDLE_WM_MOUSEMOVE(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_MOUSEMOVE(hwnd, x, y, keyFlags, fn) fn((hwnd), WM_MOUSEMOVE, cast(WPARAM, cast(UINT, (keyFlags))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_LBUTTONDOWN(HWnd, wParam, lParam, fn) fn((HWnd), False, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_LBUTTONDOWN(hwnd, fDoubleClick, x, y, keyFlags, fn) fn((hwnd), iif((fDoubleClick), WM_LBUTTONDBLCLK, WM_LBUTTONDOWN), cast(WPARAM, cast(UINT, (keyFlags))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_LBUTTONDBLCLK(HWnd, wParam, lParam, fn) fn((HWnd), CTRUE, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#Define HANDLE_WM_LBUTTONUP(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_LBUTTONUP(hwnd, x, y, keyFlags, fn) fn((hwnd), WM_LBUTTONUP, cast(WPARAM, cast(UINT, (keyFlags))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_RBUTTONDOWN(HWnd, wParam, lParam, fn) fn((HWnd), False, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_RBUTTONDOWN(hwnd, fDoubleClick, x, y, keyFlags, fn) fn((hwnd), iif((fDoubleClick), WM_RBUTTONDBLCLK, WM_RBUTTONDOWN), cast(WPARAM, cast(UINT, (keyFlags))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_RBUTTONDBLCLK(HWnd, wParam, lParam, fn) fn((HWnd), CTRUE, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#Define HANDLE_WM_RBUTTONUP(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_RBUTTONUP(hwnd, x, y, keyFlags, fn) fn((hwnd), WM_RBUTTONUP, cast(WPARAM, cast(UINT, (keyFlags))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_MBUTTONDOWN(HWnd, wParam, lParam, fn) fn((HWnd), False, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_MBUTTONDOWN(hwnd, fDoubleClick, x, y, keyFlags, fn) fn((hwnd), iif((fDoubleClick), WM_MBUTTONDBLCLK, WM_MBUTTONDOWN), cast(WPARAM, cast(UINT, (keyFlags))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_MBUTTONDBLCLK(HWnd, wParam, lParam, fn) fn((HWnd), CTRUE, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#Define HANDLE_WM_MBUTTONUP(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_MBUTTONUP(hwnd, x, y, keyFlags, fn) fn((hwnd), WM_MBUTTONUP, cast(WPARAM, cast(UINT, (keyFlags))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_MOUSEWHEEL(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), CLng(CShort(Hiword(wParam))), Cast(UINT, CShort(Loword(wParam))))
+#define FORWARD_WM_MOUSEWHEEL(hwnd, xPos, yPos, zDelta, fwKeys, fn) fn((hwnd), WM_MOUSEWHEEL, MAKEWPARAM((fwKeys), (zDelta)), MAKELPARAM(x, y))
+#Define HANDLE_WM_NCMOUSEMOVE(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_NCMOUSEMOVE(hwnd, x, y, codeHitTest, fn) fn((hwnd), WM_NCMOUSEMOVE, cast(WPARAM, cast(UINT, (codeHitTest))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_NCLBUTTONDOWN(HWnd, wParam, lParam, fn) fn((HWnd), False, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_NCLBUTTONDOWN(hwnd, fDoubleClick, x, y, codeHitTest, fn) fn((hwnd), iif((fDoubleClick), WM_NCLBUTTONDBLCLK, WM_NCLBUTTONDOWN), cast(WPARAM, cast(UINT, (codeHitTest))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_NCLBUTTONDBLCLK(HWnd, wParam, lParam, fn) fn((HWnd), CTRUE, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#Define HANDLE_WM_NCLBUTTONUP(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_NCLBUTTONUP(hwnd, x, y, codeHitTest, fn) fn((hwnd), WM_NCLBUTTONUP, cast(WPARAM, cast(UINT, (codeHitTest))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_NCRBUTTONDOWN(HWnd, wParam, lParam, fn) fn((HWnd), False, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_NCRBUTTONDOWN(hwnd, fDoubleClick, x, y, codeHitTest, fn) fn((hwnd), iif((fDoubleClick), WM_NCRBUTTONDBLCLK, WM_NCRBUTTONDOWN), cast(WPARAM, cast(UINT, (codeHitTest))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_NCRBUTTONDBLCLK(HWnd, wParam, lParam, fn) fn((HWnd), CTRUE, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#Define HANDLE_WM_NCRBUTTONUP(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_NCRBUTTONUP(hwnd, x, y, codeHitTest, fn) fn((hwnd), WM_NCRBUTTONUP, cast(WPARAM, cast(UINT, (codeHitTest))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_NCMBUTTONDOWN(HWnd, wParam, lParam, fn) fn((HWnd), False, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_NCMBUTTONDOWN(hwnd, fDoubleClick, x, y, codeHitTest, fn) fn((hwnd), iif((fDoubleClick), WM_NCMBUTTONDBLCLK, WM_NCMBUTTONDOWN), cast(WPARAM, cast(UINT, (codeHitTest))), MAKELPARAM((x), (y)))
+#Define HANDLE_WM_NCMBUTTONDBLCLK(HWnd, wParam, lParam, fn) fn((HWnd), CTRUE, CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#Define HANDLE_WM_NCMBUTTONUP(HWnd, wParam, lParam, fn) fn((HWnd), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))), Cast(UINT, (wParam)))
+#define FORWARD_WM_NCMBUTTONUP(hwnd, x, y, codeHitTest, fn) fn((hwnd), WM_NCMBUTTONUP, cast(WPARAM, cast(UINT, (codeHitTest))), MAKELPARAM((x), (y)))
+#define HANDLE_WM_MOUSEACTIVATE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, clng(fn((hwnd), cast(HWND, (wParam)), cast(UINT, LOWORD(lParam)), cast(UINT, HIWORD(lParam))))))
+#define FORWARD_WM_MOUSEACTIVATE(hwnd, hwndTopLevel, codeHitTest, msg, fn) clng(cast(DWORD, fn((hwnd), WM_MOUSEACTIVATE, cast(WPARAM, cast(HWND, (hwndTopLevel))), MAKELPARAM((codeHitTest), (msg)))))
+#Define HANDLE_WM_CANCELMODE(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_CANCELMODE(hwnd, fn) fn((hwnd), WM_CANCELMODE, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_TIMER(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)))
+#define FORWARD_WM_TIMER(hwnd, id, fn) fn((hwnd), WM_TIMER, cast(WPARAM, cast(UINT, (id))), cast(LPARAM, 0))
+#Define HANDLE_WM_INITMENU(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HMENU, (wParam)))
+#define FORWARD_WM_INITMENU(hwnd, hMenu, fn) fn((hwnd), WM_INITMENU, cast(WPARAM, cast(HMENU, (hMenu))), cast(LPARAM, 0))
+#Define HANDLE_WM_INITMENUPOPUP(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HMENU, (wParam)), Cast(UINT, Loword(lParam)), Cast(WINBOOL, Hiword(lParam)))
+#define FORWARD_WM_INITMENUPOPUP(hwnd, hMenu, item, fSystemMenu, fn) fn((hwnd), WM_INITMENUPOPUP, cast(WPARAM, cast(HMENU, (hMenu))), MAKELPARAM((item), (fSystemMenu)))
+#Define HANDLE_WM_MENUSELECT(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HMENU, (lParam)), Iif(Hiword(wParam) And MF_POPUP, 0, CLng(Loword(wParam))), Iif(Hiword(wParam) And MF_POPUP, GetSubMenu(Cast(HMENU, lParam), Loword(wParam)), Cast(HMENU, 0)), Cast(UINT, Iif(CShort(Hiword(wParam)) = (-1), &hFFFFFFFF, Hiword(wParam))))
+#define FORWARD_WM_MENUSELECT(hwnd, hmenu, item, hmenuPopup, flags, fn) fn((hwnd), WM_MENUSELECT, MAKEWPARAM((item), (flags)), cast(LPARAM, cast(HMENU, iif((hmenu), (hmenu), (hmenuPopup)))))
+#define HANDLE_WM_MENUCHAR(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, fn((hwnd), cast(UINT, LOWORD(wParam)), cast(UINT, HIWORD(wParam)), cast(HMENU, (lParam)))))
+#define FORWARD_WM_MENUCHAR(hwnd, ch, flags, hmenu, fn) cast(DWORD, fn((hwnd), WM_MENUCHAR, MAKEWPARAM(flags, cast(WORD, (ch))), cast(LPARAM, cast(HMENU, (hmenu)))))
+#Define HANDLE_WM_COMMAND(HWnd, wParam, lParam, fn) fn((HWnd), CLng(Loword(wParam)), Cast(HWnd, (lParam)), Cast(UINT, Hiword(wParam)))
+#define FORWARD_WM_COMMAND(hwnd, id, hwndCtl, codeNotify, fn) fn((hwnd), WM_COMMAND, MAKEWPARAM(cast(UINT, (id)), cast(UINT, (codeNotify))), cast(LPARAM, cast(HWND, (hwndCtl))))
+#Define HANDLE_WM_HSCROLL(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (lParam)), Cast(UINT, Loword(wParam)), CLng(CShort(Hiword(wParam))))
+#define FORWARD_WM_HSCROLL(hwnd, hwndCtl, code, pos, fn) fn((hwnd), WM_HSCROLL, MAKEWPARAM(cast(UINT, clng(code)), cast(UINT, clng(pos))), cast(LPARAM, cast(HWND, (hwndCtl))))
+#Define HANDLE_WM_VSCROLL(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (lParam)), Cast(UINT, Loword(wParam)), CLng(CShort(Hiword(wParam))))
+#define FORWARD_WM_VSCROLL(hwnd, hwndCtl, code, pos, fn) fn((hwnd), WM_VSCROLL, MAKEWPARAM(cast(UINT, clng(code)), cast(UINT, clng(pos))), cast(LPARAM, cast(HWND, (hwndCtl))))
+#Define HANDLE_WM_CUT(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_CUT(hwnd, fn) fn((hwnd), WM_CUT, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_COPY(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_COPY(hwnd, fn) fn((hwnd), WM_COPY, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_PASTE(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_PASTE(hwnd, fn) fn((hwnd), WM_PASTE, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_CLEAR(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_CLEAR(hwnd, fn) fn((hwnd), WM_CLEAR, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_UNDO(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_UNDO(hwnd, fn) fn((hwnd), WM_UNDO, cast(WPARAM, 0), cast(LPARAM, 0))
+#define HANDLE_WM_RENDERFORMAT(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HANDLE, fn((hwnd), cast(UINT, (wParam))))))
+#define FORWARD_WM_RENDERFORMAT(hwnd, fmt, fn) cast(HANDLE, cast(UINT_PTR, fn((hwnd), WM_RENDERFORMAT, cast(WPARAM, cast(UINT, (fmt))), cast(LPARAM, 0))))
+#Define HANDLE_WM_RENDERALLFORMATS(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_RENDERALLFORMATS(hwnd, fn) fn((hwnd), WM_RENDERALLFORMATS, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_DESTROYCLIPBOARD(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_DESTROYCLIPBOARD(hwnd, fn) fn((hwnd), WM_DESTROYCLIPBOARD, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_DRAWCLIPBOARD(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_DRAWCLIPBOARD(hwnd, fn) fn((hwnd), WM_DRAWCLIPBOARD, cast(WPARAM, 0), cast(LPARAM, 0))
+
+#Macro HANDLE_WM_PAINTCLIPBOARD(HWnd, wParam, lParam, fn)
+ scope
+ fn((hwnd), cast(HWND, (wParam)), cast(const LPPAINTSTRUCT, GlobalLock(cast(HGLOBAL, (lParam)))))
+ GlobalUnlock(cast(HGLOBAL, (lParam)))
+ cast(LRESULT, 0)
+ end scope
+#endmacro
+#define FORWARD_WM_PAINTCLIPBOARD(hwnd, hwndCBViewer, lpPaintStruct, fn) fn((hwnd), WM_PAINTCLIPBOARD, cast(WPARAM, cast(HWND, (hwndCBViewer))), cast(LPARAM, cast(LPPAINTSTRUCT, (lpPaintStruct))))
+#macro HANDLE_WM_SIZECLIPBOARD(hwnd, wParam, lParam, fn)
+ scope
+ fn((hwnd), cast(HWND, (wParam)), cast(const LPRECT, GlobalLock(cast(HGLOBAL, (lParam)))))
+ GlobalUnlock(cast(HGLOBAL, (lParam)))
+ cast(LRESULT, 0)
+ end scope
+#endmacro
+
+#Define FORWARD_WM_SIZECLIPBOARD(HWnd, hwndCBViewer, lprc, fn) fn((HWnd), WM_SIZECLIPBOARD, Cast(WPARAM, Cast(HWnd, (hwndCBViewer))), Cast(LPARAM, Cast(LPRECT, (lprc))))
+#Define HANDLE_WM_VSCROLLCLIPBOARD(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)), Cast(UINT, Loword(lParam)), CLng(CShort(Hiword(lParam))))
+#define FORWARD_WM_VSCROLLCLIPBOARD(hwnd, hwndCBViewer, code, pos, fn) fn((hwnd), WM_VSCROLLCLIPBOARD, cast(WPARAM, cast(HWND, (hwndCBViewer))), MAKELPARAM((code), (pos)))
+#Define HANDLE_WM_HSCROLLCLIPBOARD(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)), Cast(UINT, Loword(lParam)), CLng(CShort(Hiword(lParam))))
+#define FORWARD_WM_HSCROLLCLIPBOARD(hwnd, hwndCBViewer, code, pos, fn) fn((hwnd), WM_HSCROLLCLIPBOARD, cast(WPARAM, cast(HWND, (hwndCBViewer))), MAKELPARAM((code), (pos)))
+#Define HANDLE_WM_ASKCBFORMATNAME(HWnd, wParam, lParam, fn) fn((HWnd), CLng(wParam), Cast(LPTSTR, (lParam)))
+#define FORWARD_WM_ASKCBFORMATNAME(hwnd, cchMax, rgchName, fn) fn((hwnd), WM_ASKCBFORMATNAME, cast(WPARAM, clng(cchMax)), cast(LPARAM, (rgchName)))
+#Define HANDLE_WM_CHANGECBCHAIN(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)), Cast(HWnd, (lParam)))
+#define FORWARD_WM_CHANGECBCHAIN(hwnd, hwndRemove, hwndNext, fn) fn((hwnd), WM_CHANGECBCHAIN, cast(WPARAM, cast(HWND, (hwndRemove))), cast(LPARAM, cast(HWND, (hwndNext))))
+#define HANDLE_WM_SETCURSOR(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(WINBOOL, fn((hwnd), cast(HWND, (wParam)), cast(UINT, LOWORD(lParam)), cast(UINT, HIWORD(lParam))))))
+#define FORWARD_WM_SETCURSOR(hwnd, hwndCursor, codeHitTest, msg, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_SETCURSOR, cast(WPARAM, cast(HWND, (hwndCursor))), MAKELPARAM((codeHitTest), (msg)))))
+#Define HANDLE_WM_SYSCOMMAND(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)), CLng(CShort(Loword(lParam))), CLng(CShort(Hiword(lParam))))
+#define FORWARD_WM_SYSCOMMAND(hwnd, cmd, x, y, fn) fn((hwnd), WM_SYSCOMMAND, cast(WPARAM, cast(UINT, (cmd))), MAKELPARAM((x), (y)))
+#define HANDLE_WM_MDICREATE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(UINT, fn((hwnd), cast(LPMDICREATESTRUCT, (lParam))))))
+#define FORWARD_WM_MDICREATE(hwnd, lpmcs, fn) cast(HWND, cast(UINT, cast(DWORD, fn((hwnd), WM_MDICREATE, cast(WPARAM, 0), cast(LPARAM, cast(LPMDICREATESTRUCT, (lpmcs)))))))
+#Define HANDLE_WM_MDIDESTROY(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)))
+#define FORWARD_WM_MDIDESTROY(hwnd, hwndDestroy, fn) fn((hwnd), WM_MDIDESTROY, cast(WPARAM, (hwndDestroy)), cast(LPARAM, 0))
+#Define HANDLE_WM_MDIACTIVATE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(WINBOOL, -(lParam = Cast(LPARAM, HWnd))), Cast(HWnd, (lParam)), Cast(HWnd, (wParam)))
+#define FORWARD_WM_MDIACTIVATE(hwnd, fActive, hwndActivate, hwndDeactivate, fn) fn(hwnd, WM_MDIACTIVATE, cast(WPARAM, (hwndDeactivate)), cast(LPARAM, (hwndActivate)))
+#Define HANDLE_WM_MDIRESTORE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)))
+#define FORWARD_WM_MDIRESTORE(hwnd, hwndRestore, fn) fn((hwnd), WM_MDIRESTORE, cast(WPARAM, (hwndRestore)), cast(LPARAM, 0))
+#define HANDLE_WM_MDINEXT(hwnd, wParam, lParam, fn) cast(LRESULT, cast(HWND, fn((hwnd), cast(HWND, (wParam)), cast(WINBOOL, lParam))))
+#define FORWARD_WM_MDINEXT(hwnd, hwndCur, fPrev, fn) cast(HWND, cast(UINT_PTR, fn((hwnd), WM_MDINEXT, cast(WPARAM, (hwndCur)), cast(LPARAM, (fPrev)))))
+#Define HANDLE_WM_MDIMAXIMIZE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)))
+#define FORWARD_WM_MDIMAXIMIZE(hwnd, hwndMaximize, fn) fn((hwnd), WM_MDIMAXIMIZE, cast(WPARAM, (hwndMaximize)), cast(LPARAM, 0))
+#define HANDLE_WM_MDITILE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, fn((hwnd), cast(UINT, (wParam)))))
+#define FORWARD_WM_MDITILE(hwnd, cmd, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_MDITILE, cast(WPARAM, (cmd)), cast(LPARAM, 0))))
+#define HANDLE_WM_MDICASCADE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, fn((hwnd), cast(UINT, (wParam)))))
+#define FORWARD_WM_MDICASCADE(hwnd, cmd, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_MDICASCADE, cast(WPARAM, (cmd)), cast(LPARAM, 0))))
+#Define HANDLE_WM_MDIICONARRANGE(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_MDIICONARRANGE(hwnd, fn) fn((hwnd), WM_MDIICONARRANGE, cast(WPARAM, 0), cast(LPARAM, 0))
+#define HANDLE_WM_MDIGETACTIVE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, fn(hwnd)))
+#define FORWARD_WM_MDIGETACTIVE(hwnd, fn) cast(HWND, cast(UINT_PTR, fn((hwnd), WM_MDIGETACTIVE, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define HANDLE_WM_MDISETMENU(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, fn((hwnd), cast(WINBOOL, (wParam)), cast(HMENU, (wParam)), cast(HMENU, (lParam)))))
+#define FORWARD_WM_MDISETMENU(hwnd, fRefresh, hmenuFrame, hmenuWindow, fn) cast(HMENU, cast(UINT_PTR, fn((hwnd), WM_MDISETMENU, cast(WPARAM, iif((fRefresh), (hmenuFrame), 0)), cast(LPARAM, (hmenuWindow)))))
+#Define HANDLE_WM_CHILDACTIVATE(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_CHILDACTIVATE(hwnd, fn) fn((hwnd), WM_CHILDACTIVATE, cast(WPARAM, 0), cast(LPARAM, 0))
+#define HANDLE_WM_INITDIALOG(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(UINT, cast(WINBOOL, fn((hwnd), cast(HWND, (wParam)), lParam)))))
+#define FORWARD_WM_INITDIALOG(hwnd, hwndFocus, lParam, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_INITDIALOG, cast(WPARAM, cast(HWND, (hwndFocus))), (lParam))))
+#define HANDLE_WM_NEXTDLGCTL(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HWND, fn((hwnd), cast(HWND, (wParam)), cast(WINBOOL, (lParam))))))
+#define FORWARD_WM_NEXTDLGCTL(hwnd, hwndSetFocus, fNext, fn) cast(HWND, cast(UINT_PTR, fn((hwnd), WM_NEXTDLGCTL, cast(WPARAM, cast(HWND, (hwndSetFocus))), cast(LPARAM, (fNext)))))
+#Define HANDLE_WM_PARENTNOTIFY(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, Loword(wParam)), Cast(HWnd, (lParam)), Cast(UINT, Hiword(wParam)))
+#define FORWARD_WM_PARENTNOTIFY(hwnd, msg, hwndChild, idChild, fn) fn((hwnd), WM_PARENTNOTIFY, MAKEWPARAM(msg, idChild), cast(LPARAM, (hwndChild)))
+#Define HANDLE_WM_ENTERIDLE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)), Cast(HWnd, (lParam)))
+#define FORWARD_WM_ENTERIDLE(hwnd, source, hwndSource, fn) fn((hwnd), WM_ENTERIDLE, cast(WPARAM, cast(UINT, (source))), cast(LPARAM, cast(HWND, (hwndSource))))
+#define HANDLE_WM_GETDLGCODE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(UINT, fn(hwnd, cast(LPMSG, (lParam))))))
+#define FORWARD_WM_GETDLGCODE(hwnd, lpmsg, fn) cast(UINT, cast(DWORD, fn((hwnd), WM_GETDLGCODE, iif(lpmsg, lpmsg->wParam, 0), cast(LPARAM, cast(LPMSG, (lpmsg))))))
+#define HANDLE_WM_CTLCOLORMSGBOX(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HBRUSH, fn((hwnd), cast(HDC, (wParam)), cast(HWND, (lParam)), CTLCOLOR_MSGBOX))))
+#define FORWARD_WM_CTLCOLORMSGBOX(hwnd, hdc, hwndChild, fn) cast(HBRUSH, cast(UINT_PTR, fn((hwnd), WM_CTLCOLORMSGBOX, cast(WPARAM, cast(HDC, (hdc))), cast(LPARAM, cast(HWND, (hwndChild))))))
+#define HANDLE_WM_CTLCOLOREDIT(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HBRUSH, fn((hwnd), cast(HDC, (wParam)), cast(HWND, (lParam)), CTLCOLOR_EDIT))))
+#define FORWARD_WM_CTLCOLOREDIT(hwnd, hdc, hwndChild, fn) cast(HBRUSH, cast(UINT_PTR, fn((hwnd), WM_CTLCOLOREDIT, cast(WPARAM, cast(HDC, (hdc))), cast(LPARAM, cast(HWND, (hwndChild))))))
+#define HANDLE_WM_CTLCOLORLISTBOX(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HBRUSH, fn((hwnd), cast(HDC, (wParam)), cast(HWND, (lParam)), CTLCOLOR_LISTBOX))))
+#define FORWARD_WM_CTLCOLORLISTBOX(hwnd, hdc, hwndChild, fn) cast(HBRUSH, cast(UINT_PTR, fn((hwnd), WM_CTLCOLORLISTBOX, cast(WPARAM, cast(HDC, (hdc))), cast(LPARAM, cast(HWND, (hwndChild))))))
+#define HANDLE_WM_CTLCOLORBTN(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HBRUSH, fn((hwnd), cast(HDC, (wParam)), cast(HWND, (lParam)), CTLCOLOR_BTN))))
+#define FORWARD_WM_CTLCOLORBTN(hwnd, hdc, hwndChild, fn) cast(HBRUSH, cast(UINT_PTR, fn((hwnd), WM_CTLCOLORBTN, cast(WPARAM, cast(HDC, (hdc))), cast(LPARAM, cast(HWND, (hwndChild))))))
+#define HANDLE_WM_CTLCOLORDLG(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HBRUSH, fn((hwnd), cast(HDC, (wParam)), cast(HWND, (lParam)), CTLCOLOR_DLG))))
+#define FORWARD_WM_CTLCOLORDLG(hwnd, hdc, hwndChild, fn) cast(HBRUSH, cast(UINT_PTR, fn((hwnd), WM_CTLCOLORDLG, cast(WPARAM, cast(HDC, (hdc))), cast(LPARAM, cast(HWND, (hwndChild))))))
+#define HANDLE_WM_CTLCOLORSCROLLBAR(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HBRUSH, fn((hwnd), cast(HDC, (wParam)), cast(HWND, (lParam)), CTLCOLOR_SCROLLBAR))))
+#define FORWARD_WM_CTLCOLORSCROLLBAR(hwnd, hdc, hwndChild, fn) cast(HBRUSH, cast(UINT_PTR, fn((hwnd), WM_CTLCOLORSCROLLBAR, cast(WPARAM, cast(HDC, (hdc))), cast(LPARAM, cast(HWND, (hwndChild))))))
+#define HANDLE_WM_CTLCOLORSTATIC(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HBRUSH, fn((hwnd), cast(HDC, (wParam)), cast(HWND, (lParam)), CTLCOLOR_STATIC))))
+#define FORWARD_WM_CTLCOLORSTATIC(hwnd, hdc, hwndChild, fn) cast(HBRUSH, cast(UINT_PTR, fn((hwnd), WM_CTLCOLORSTATIC, cast(WPARAM, cast(HDC, (hdc))), cast(LPARAM, cast(HWND, (hwndChild))))))
+#Define HANDLE_WM_SETFONT(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HFONT, (wParam)), Cast(WINBOOL, (lParam)))
+#Define FORWARD_WM_SETFONT(HWnd, _hfont, fRedraw, fn) fn((HWnd), WM_SETFONT, Cast(WPARAM, Cast(HFONT, (_hfont))), Cast(LPARAM, Cast(WINBOOL, (fRedraw))))
+#define HANDLE_WM_GETFONT(hwnd, wParam, lParam, fn) cast(LRESULT, cast(UINT_PTR, cast(HFONT, fn(hwnd))))
+#define FORWARD_WM_GETFONT(hwnd, fn) cast(HFONT, cast(UINT_PTR, fn((hwnd), WM_GETFONT, cast(WPARAM, 0), cast(LPARAM, 0))))
+#Define HANDLE_WM_DRAWITEM(HWnd, wParam, lParam, fn) fn((HWnd), cptr(Const DRAWITEMSTRUCT Ptr, (lParam)))
+#define FORWARD_WM_DRAWITEM(hwnd, lpDrawItem, fn) fn((hwnd), WM_DRAWITEM, cast(WPARAM, cptr(const DRAWITEMSTRUCT ptr, lpDrawItem)->CtlID), cast(LPARAM, cptr(const DRAWITEMSTRUCT ptr, (lpDrawItem))))
+#Define HANDLE_WM_MEASUREITEM(HWnd, wParam, lParam, fn) fn((HWnd), cptr(MEASUREITEMSTRUCT Ptr, (lParam)))
+#define FORWARD_WM_MEASUREITEM(hwnd, lpMeasureItem, fn) fn((hwnd), WM_MEASUREITEM, cast(WPARAM, cptr(MEASUREITEMSTRUCT ptr, lpMeasureItem)->CtlID), cast(LPARAM, cptr(MEASUREITEMSTRUCT ptr, (lpMeasureItem))))
+#Define HANDLE_WM_DELETEITEM(HWnd, wParam, lParam, fn) fn((HWnd), cptr(Const DELETEITEMSTRUCT Ptr, (lParam)))
+#define FORWARD_WM_DELETEITEM(hwnd, lpDeleteItem, fn) fn((hwnd), WM_DELETEITEM, cast(WPARAM, cptr(const DELETEITEMSTRUCT ptr, (lpDeleteItem))->CtlID), cast(LPARAM, cptr(const DELETEITEMSTRUCT ptr, (lpDeleteItem))))
+#define HANDLE_WM_COMPAREITEM(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, clng(fn((hwnd), cptr(const COMPAREITEMSTRUCT ptr, (lParam))))))
+#define FORWARD_WM_COMPAREITEM(hwnd, lpCompareItem, fn) clng(cast(DWORD, fn((hwnd), WM_COMPAREITEM, cast(WPARAM, cptr(const COMPAREITEMSTRUCT ptr, (lpCompareItem))->CtlID), cast(LPARAM, cptr(const COMPAREITEMSTRUCT ptr, (lpCompareItem))))))
+#define HANDLE_WM_VKEYTOITEM(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, clng(fn((hwnd), cast(UINT, LOWORD(wParam)), cast(HWND, (lParam)), clng(cshort(HIWORD(wParam)))))))
+#define FORWARD_WM_VKEYTOITEM(hwnd, vk, hwndListBox, iCaret, fn) clng(cast(DWORD, fn((hwnd), WM_VKEYTOITEM, MAKEWPARAM((vk), (iCaret)), cast(LPARAM, (hwndListBox)))))
+#define HANDLE_WM_CHARTOITEM(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, clng(fn((hwnd), cast(UINT, LOWORD(wParam)), cast(HWND, (lParam)), clng(cshort(HIWORD(wParam)))))))
+#define FORWARD_WM_CHARTOITEM(hwnd, ch, hwndListBox, iCaret, fn) clng(cast(DWORD, fn((hwnd), WM_CHARTOITEM, MAKEWPARAM(cast(UINT, (ch)), cast(UINT, (iCaret))), cast(LPARAM, (hwndListBox)))))
+#Define HANDLE_WM_QUEUESYNC(HWnd, wParam, lParam, fn) fn(HWnd)
+#define FORWARD_WM_QUEUESYNC(hwnd, fn) fn((hwnd), WM_QUEUESYNC, cast(WPARAM, 0), cast(LPARAM, 0))
+#Define HANDLE_WM_COMMNOTIFY(HWnd, wParam, lParam, fn) fn((HWnd), CLng(wParam), Cast(UINT, Loword(lParam)))
+#define FORWARD_WM_COMMNOTIFY(hwnd, cid, flags, fn) fn((hwnd), WM_COMMNOTIFY, cast(WPARAM, (cid)), MAKELPARAM((flags), 0))
+#Define HANDLE_WM_DISPLAYCHANGE(HWnd, wParam, lParam, fn) fn((HWnd), Cast(UINT, (wParam)), Cast(UINT, Loword(lParam)), Cast(UINT, Hiword(wParam)))
+#define FORWARD_WM_DISPLAYCHANGE(hwnd, bitsPerPixel, cxScreen, cyScreen, fn) fn((hwnd), WM_DISPLAYCHANGE, cast(WPARAM, cast(UINT, (bitsPerPixel))), cast(LPARAM, MAKELPARAM(cast(UINT, (cxScreen)), cast(UINT, (cyScreen)))))
+#define HANDLE_WM_DEVICECHANGE(hwnd, wParam, lParam, fn) cast(LRESULT, cast(DWORD, cast(WINBOOL, fn((hwnd), cast(UINT, (wParam)), cast(DWORD, (wParam))))))
+#define FORWARD_WM_DEVICECHANGE(hwnd, uEvent, dwEventData, fn) cast(WINBOOL, cast(DWORD, fn((hwnd), WM_DEVICECHANGE, cast(WPARAM, cast(UINT, (uEvent))), cast(LPARAM, cast(DWORD, (dwEventData))))))
+#Define HANDLE_WM_CONTEXTMENU(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)), Cast(UINT, Loword(lParam)), Cast(UINT, Hiword(lParam)))
+#define FORWARD_WM_CONTEXTMENU(hwnd, hwndContext, xPos, yPos, fn) fn((hwnd), WM_CONTEXTMENU, cast(WPARAM, cast(HWND, (hwndContext))), MAKELPARAM(cast(UINT, (xPos)), cast(UINT, (yPos))))
+#Define HANDLE_WM_COPYDATA(HWnd, wParam, lParam, fn) fn((HWnd), Cast(HWnd, (wParam)), Cast(PCOPYDATASTRUCT, lParam))
+#define FORWARD_WM_COPYDATA(hwnd, hwndFrom, pcds, fn) cast(WINBOOL, cast(UINT, cast(DWORD, fn((hwnd), WM_COPYDATA, cast(WPARAM, (hwndFrom)), cast(LPARAM, (pcds))))))
+#Define HANDLE_WM_HOTKEY(HWnd, wParam, lParam, fn) fn((HWnd), CLng(wParam), Cast(UINT, Loword(lParam)), Cast(UINT, Hiword(lParam)))
+#define FORWARD_WM_HOTKEY(hwnd, idHotKey, fuModifiers, vk, fn) fn((hwnd), WM_HOTKEY, cast(WPARAM, (idHotKey)), MAKELPARAM((fuModifiers), (vk)))
+#define Static_Enable(hwndCtl, fEnable) EnableWindow((hwndCtl), (fEnable))
+#define Static_GetText(hwndCtl, lpch, cchMax) GetWindowText((hwndCtl), (lpch), (cchMax))
+#define Static_GetTextLength(hwndCtl) GetWindowTextLength(hwndCtl)
+#define Static_SetText(hwndCtl, lpsz) SetWindowText((hwndCtl), (lpsz))
+#Define Static_SetIcon(hwndCtl, _hIcon) Cast(HICON, Cast(UINT_PTR, SNDMSG((hwndCtl), STM_SETICON, Cast(WPARAM, Cast(HICON, (_hIcon))), Cast(LPARAM, 0))))
+#Define Static_GetIcon(hwndCtl, _hIcon) Cast(HICON, Cast(UINT_PTR, SNDMSG((hwndCtl), STM_GETICON, Cast(WPARAM, 0), Cast(LPARAM, 0))))
+#define Button_Enable(hwndCtl, fEnable) EnableWindow((hwndCtl), (fEnable))
+#define Button_GetText(hwndCtl, lpch, cchMax) GetWindowText((hwndCtl), (lpch), (cchMax))
+#define Button_GetTextLength(hwndCtl) GetWindowTextLength(hwndCtl)
+#define Button_SetText(hwndCtl, lpsz) SetWindowText((hwndCtl), (lpsz))
+#define Button_GetCheck(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), BM_GETCHECK, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define Button_SetCheck(hwndCtl, check) SNDMSG((hwndCtl), BM_SETCHECK, cast(WPARAM, clng(check)), cast(LPARAM, 0))
+#define Button_GetState(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), BM_GETSTATE, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define Button_SetState(hwndCtl, state) cast(UINT, cast(DWORD, SNDMSG((hwndCtl), BM_SETSTATE, cast(WPARAM, clng(state)), cast(LPARAM, 0))))
+#define Button_SetStyle(hwndCtl, style, fRedraw) SNDMSG((hwndCtl), BM_SETSTYLE, cast(WPARAM, LOWORD(style)), MAKELPARAM(iif((fRedraw), CTRUE, FALSE), 0))
+#define Edit_Enable(hwndCtl, fEnable) EnableWindow((hwndCtl), (fEnable))
+#define Edit_GetText(hwndCtl, lpch, cchMax) GetWindowText((hwndCtl), (lpch), (cchMax))
+#define Edit_GetTextLength(hwndCtl) GetWindowTextLength(hwndCtl)
+#define Edit_SetText(hwndCtl, lpsz) SetWindowText((hwndCtl), (lpsz))
+#define Edit_LimitText(hwndCtl, cchMax) SNDMSG((hwndCtl), EM_LIMITTEXT, cast(WPARAM, (cchMax)), cast(LPARAM, 0))
+#define Edit_GetLineCount(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), EM_GETLINECOUNT, cast(WPARAM, 0), cast(LPARAM, 0))))
+
+#Macro Edit_GetLine(hwndCtl, Line, lpch, cchMax)
+ scope
+ (*cptr(long ptr, (lpch))) = (cchMax)
+ clng(cast(DWORD, SNDMSG((hwndCtl), EM_GETLINE, cast(WPARAM, clng(line)), cast(LPARAM, cast(LPTSTR, (lpch))))))
+ end scope
+#endmacro
+#define Edit_GetRect(hwndCtl, lprc) SNDMSG((hwndCtl), EM_GETRECT, cast(LPARAM, 0), cast(LPARAM, cptr(RECT ptr, (lprc))))
+#define Edit_SetRect(hwndCtl, lprc) SNDMSG((hwndCtl), EM_SETRECT, cast(LPARAM, 0), cast(LPARAM, cptr(const RECT ptr, (lprc))))
+#define Edit_SetRectNoPaint(hwndCtl, lprc) SNDMSG((hwndCtl), EM_SETRECTNP, cast(LPARAM, 0), cast(LPARAM, cptr(const RECT ptr, (lprc))))
+#define Edit_GetSel(hwndCtl) cast(DWORD, SNDMSG((hwndCtl), EM_GETSEL, cast(WPARAM, 0), cast(LPARAM, 0)))
+#define Edit_SetSel(hwndCtl, ichStart, ichEnd) SNDMSG((hwndCtl), EM_SETSEL, (ichStart), (ichEnd))
+#define Edit_ReplaceSel(hwndCtl, lpszReplace) SNDMSG((hwndCtl), EM_REPLACESEL, cast(LPARAM, 0), cast(LPARAM, cast(LPCTSTR, (lpszReplace))))
+#define Edit_GetModify(hwndCtl) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), EM_GETMODIFY, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define Edit_SetModify(hwndCtl, fModified) SNDMSG((hwndCtl), EM_SETMODIFY, cast(WPARAM, cast(UINT, (fModified))), cast(LPARAM, 0))
+#define Edit_ScrollCaret(hwndCtl) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), EM_SCROLLCARET, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define Edit_LineFromChar(hwndCtl, ich) clng(cast(DWORD, SNDMSG((hwndCtl), EM_LINEFROMCHAR, cast(WPARAM, clng(ich)), cast(LPARAM, 0))))
+#define Edit_LineIndex(hwndCtl, line) clng(cast(DWORD, SNDMSG((hwndCtl), EM_LINEINDEX, cast(WPARAM, clng(line)), cast(LPARAM, 0))))
+#define Edit_LineLength(hwndCtl, line) clng(cast(DWORD, SNDMSG((hwndCtl), EM_LINELENGTH, cast(WPARAM, clng(line)), cast(LPARAM, 0))))
+#define Edit_Scroll(hwndCtl, dv, dh) SNDMSG((hwndCtl), EM_LINESCROLL, cast(WPARAM, (dh)), cast(LPARAM, (dv)))
+#define Edit_CanUndo(hwndCtl) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), EM_CANUNDO, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define Edit_Undo(hwndCtl) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), EM_UNDO, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define Edit_EmptyUndoBuffer(hwndCtl) SNDMSG((hwndCtl), EM_EMPTYUNDOBUFFER, cast(WPARAM, 0), cast(LPARAM, 0))
+#define Edit_SetPasswordChar(hwndCtl, ch) SNDMSG((hwndCtl), EM_SETPASSWORDCHAR, cast(WPARAM, cast(UINT, (ch))), cast(LPARAM, 0))
+#define Edit_SetTabStops(hwndCtl, cTabs, lpTabs) SNDMSG((hwndCtl), EM_SETTABSTOPS, cast(WPARAM, clng(cTabs)), cast(LPARAM, cptr(const long ptr, (lpTabs))))
+#define Edit_FmtLines(hwndCtl, fAddEOL) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), EM_FMTLINES, cast(WPARAM, cast(WINBOOL, (fAddEOL))), cast(LPARAM, 0))))
+#define Edit_GetHandle(hwndCtl) cast(HLOCAL, cast(UINT_PTR, SNDMSG((hwndCtl), EM_GETHANDLE, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define Edit_SetHandle(hwndCtl, h) SNDMSG((hwndCtl), EM_SETHANDLE, cast(WPARAM, cast(UINT_PTR, cast(HLOCAL, (h)))), cast(LPARAM, 0))
+#define Edit_GetFirstVisibleLine(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), EM_GETFIRSTVISIBLELINE, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define Edit_SetReadOnly(hwndCtl, fReadOnly) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), EM_SETREADONLY, cast(WPARAM, cast(WINBOOL, (fReadOnly))), cast(LPARAM, 0))))
+#define Edit_GetPasswordChar(hwndCtl) cast(TCHAR, cast(DWORD, SNDMSG((hwndCtl), EM_GETPASSWORDCHAR, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define Edit_SetWordBreakProc(hwndCtl, lpfnWordBreak) SNDMSG((hwndCtl), EM_SETWORDBREAKPROC, cast(LPARAM, 0), cast(LPARAM, cast(EDITWORDBREAKPROC, (lpfnWordBreak))))
+#define Edit_GetWordBreakProc(hwndCtl) cast(EDITWORDBREAKPROC, SNDMSG((hwndCtl), EM_GETWORDBREAKPROC, cast(WPARAM, 0), cast(LPARAM, 0)))
+#define ScrollBar_Enable(hwndCtl, flags) EnableScrollBar((hwndCtl), SB_CTL, (flags))
+#define ScrollBar_Show(hwndCtl, fShow) ShowWindow((hwndCtl), iif((fShow), SW_SHOWNORMAL, SW_HIDE))
+#define ScrollBar_SetPos(hwndCtl, pos, fRedraw) SetScrollPos((hwndCtl), SB_CTL, (pos), (fRedraw))
+#define ScrollBar_GetPos(hwndCtl) GetScrollPos((hwndCtl), SB_CTL)
+#define ScrollBar_SetRange(hwndCtl, posMin, posMax, fRedraw) SetScrollRange((hwndCtl), SB_CTL, (posMin), (posMax), (fRedraw))
+#define ScrollBar_GetRange(hwndCtl, lpposMin, lpposMax) GetScrollRange((hwndCtl), SB_CTL, (lpposMin), (lpposMax))
+#define ListBox_Enable(hwndCtl, fEnable) EnableWindow((hwndCtl), (fEnable))
+#define ListBox_GetCount(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETCOUNT, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ListBox_ResetContent(hwndCtl) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), LB_RESETCONTENT, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ListBox_AddString(hwndCtl, lpsz) clng(cast(DWORD, SNDMSG((hwndCtl), LB_ADDSTRING, cast(LPARAM, 0), cast(LPARAM, cast(LPCTSTR, (lpsz))))))
+#define ListBox_InsertString(hwndCtl, index, lpsz) clng(cast(DWORD, SNDMSG((hwndCtl), LB_INSERTSTRING, cast(WPARAM, clng(index)), cast(LPARAM, cast(LPCTSTR, (lpsz))))))
+#define ListBox_AddItemData(hwndCtl, data) clng(cast(DWORD, SNDMSG((hwndCtl), LB_ADDSTRING, cast(LPARAM, 0), cast(LPARAM, (data)))))
+#define ListBox_InsertItemData(hwndCtl, index, data) clng(cast(DWORD, SNDMSG((hwndCtl), LB_INSERTSTRING, cast(WPARAM, clng(index)), cast(LPARAM, (data)))))
+#define ListBox_DeleteString(hwndCtl, index) clng(cast(DWORD, SNDMSG((hwndCtl), LB_DELETESTRING, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ListBox_GetTextLen(hwndCtl, index) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETTEXTLEN, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ListBox_GetText(hwndCtl, index, lpszBuffer) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETTEXT, cast(WPARAM, clng(index)), cast(LPARAM, cast(LPCTSTR, (lpszBuffer))))))
+#define ListBox_GetItemData(hwndCtl, index) cast(LRESULT, cast(ULONG_PTR, SNDMSG((hwndCtl), LB_GETITEMDATA, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ListBox_SetItemData(hwndCtl, index, data) clng(cast(DWORD, SNDMSG((hwndCtl), LB_SETITEMDATA, cast(WPARAM, clng(index)), cast(LPARAM, (data)))))
+#define ListBox_FindString(hwndCtl, indexStart, lpszFind) clng(cast(DWORD, SNDMSG((hwndCtl), LB_FINDSTRING, cast(WPARAM, clng(indexStart)), cast(LPARAM, cast(LPCTSTR, (lpszFind))))))
+#define ListBox_FindItemData(hwndCtl, indexStart, data) clng(cast(DWORD, SNDMSG((hwndCtl), LB_FINDSTRING, cast(WPARAM, clng(indexStart)), cast(LPARAM, (data)))))
+#define ListBox_SetSel(hwndCtl, fSelect, index) clng(cast(DWORD, SNDMSG((hwndCtl), LB_SETSEL, cast(WPARAM, cast(WINBOOL, (fSelect))), cast(LPARAM, (index)))))
+#define ListBox_SelItemRange(hwndCtl, fSelect, first, last) clng(cast(DWORD, SNDMSG((hwndCtl), LB_SELITEMRANGE, cast(WPARAM, cast(WINBOOL, (fSelect))), MAKELPARAM((first), (last)))))
+#define ListBox_GetCurSel(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETCURSEL, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ListBox_SetCurSel(hwndCtl, index) clng(cast(DWORD, SNDMSG((hwndCtl), LB_SETCURSEL, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ListBox_SelectString(hwndCtl, indexStart, lpszFind) clng(cast(DWORD, SNDMSG((hwndCtl), LB_SELECTSTRING, cast(WPARAM, clng(indexStart)), cast(LPARAM, cast(LPCTSTR, (lpszFind))))))
+#define ListBox_SelectItemData(hwndCtl, indexStart, data) clng(cast(DWORD, SNDMSG((hwndCtl), LB_SELECTSTRING, cast(WPARAM, clng(indexStart)), cast(LPARAM, (data)))))
+#define ListBox_GetSel(hwndCtl, index) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETSEL, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ListBox_GetSelCount(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETSELCOUNT, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ListBox_GetTopIndex(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETTOPINDEX, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ListBox_GetSelItems(hwndCtl, cItems, lpItems) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETSELITEMS, cast(WPARAM, clng(cItems)), cast(LPARAM, cptr(long ptr, (lpItems))))))
+#define ListBox_SetTopIndex(hwndCtl, indexTop) clng(cast(DWORD, SNDMSG((hwndCtl), LB_SETTOPINDEX, cast(WPARAM, clng(indexTop)), cast(LPARAM, 0))))
+#define ListBox_SetColumnWidth(hwndCtl, cxColumn) SNDMSG((hwndCtl), LB_SETCOLUMNWIDTH, cast(WPARAM, clng(cxColumn)), cast(LPARAM, 0))
+#define ListBox_GetHorizontalExtent(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETHORIZONTALEXTENT, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ListBox_SetHorizontalExtent(hwndCtl, cxExtent) SNDMSG((hwndCtl), LB_SETHORIZONTALEXTENT, cast(WPARAM, clng(cxExtent)), cast(LPARAM, 0))
+#define ListBox_SetTabStops(hwndCtl, cTabs, lpTabs) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), LB_SETTABSTOPS, cast(WPARAM, clng(cTabs)), cast(LPARAM, cptr(long ptr, (lpTabs))))))
+#define ListBox_GetItemRect(hwndCtl, index, lprc) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETITEMRECT, cast(WPARAM, clng(index)), cast(LPARAM, cptr(RECT ptr, (lprc))))))
+#define ListBox_SetCaretIndex(hwndCtl, index) clng(cast(DWORD, SNDMSG((hwndCtl), LB_SETCARETINDEX, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ListBox_GetCaretIndex(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETCARETINDEX, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ListBox_FindStringExact(hwndCtl, indexStart, lpszFind) clng(cast(DWORD, SNDMSG((hwndCtl), LB_FINDSTRINGEXACT, cast(WPARAM, clng(indexStart)), cast(LPARAM, cast(LPCTSTR, (lpszFind))))))
+#define ListBox_SetItemHeight(hwndCtl, index, cy) clng(cast(DWORD, SNDMSG((hwndCtl), LB_SETITEMHEIGHT, cast(WPARAM, clng(index)), MAKELPARAM((cy), 0))))
+#define ListBox_GetItemHeight(hwndCtl, index) clng(cast(DWORD, SNDMSG((hwndCtl), LB_GETITEMHEIGHT, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ListBox_Dir(hwndCtl, attrs, lpszFileSpec) clng(cast(DWORD, SNDMSG((hwndCtl), LB_DIR, cast(WPARAM, cast(UINT, (attrs))), cast(LPARAM, cast(LPCTSTR, (lpszFileSpec))))))
+#define ComboBox_Enable(hwndCtl, fEnable) EnableWindow((hwndCtl), (fEnable))
+#define ComboBox_GetText(hwndCtl, lpch, cchMax) GetWindowText((hwndCtl), (lpch), (cchMax))
+#define ComboBox_GetTextLength(hwndCtl) GetWindowTextLength(hwndCtl)
+#define ComboBox_SetText(hwndCtl, lpsz) SetWindowText((hwndCtl), (lpsz))
+#define ComboBox_LimitText(hwndCtl, cchLimit) clng(cast(DWORD, SNDMSG((hwndCtl), CB_LIMITTEXT, cast(WPARAM, clng(cchLimit)), cast(LPARAM, 0))))
+#define ComboBox_GetEditSel(hwndCtl) cast(DWORD, SNDMSG((hwndCtl), CB_GETEDITSEL, cast(WPARAM, 0), cast(LPARAM, 0)))
+#define ComboBox_SetEditSel(hwndCtl, ichStart, ichEnd) clng(cast(DWORD, SNDMSG((hwndCtl), CB_SETEDITSEL, cast(LPARAM, 0), MAKELPARAM((ichStart), (ichEnd)))))
+#define ComboBox_GetCount(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), CB_GETCOUNT, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ComboBox_ResetContent(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), CB_RESETCONTENT, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ComboBox_AddString(hwndCtl, lpsz) clng(cast(DWORD, SNDMSG((hwndCtl), CB_ADDSTRING, cast(LPARAM, 0), cast(LPARAM, cast(LPCTSTR, (lpsz))))))
+#define ComboBox_InsertString(hwndCtl, index, lpsz) clng(cast(DWORD, SNDMSG((hwndCtl), CB_INSERTSTRING, cast(WPARAM, clng(index)), cast(LPARAM, cast(LPCTSTR, (lpsz))))))
+#define ComboBox_AddItemData(hwndCtl, data) clng(cast(DWORD, SNDMSG((hwndCtl), CB_ADDSTRING, cast(LPARAM, 0), cast(LPARAM, (data)))))
+#define ComboBox_InsertItemData(hwndCtl, index, data) clng(cast(DWORD, SNDMSG((hwndCtl), CB_INSERTSTRING, cast(WPARAM, clng(index)), cast(LPARAM, (data)))))
+#define ComboBox_DeleteString(hwndCtl, index) clng(cast(DWORD, SNDMSG((hwndCtl), CB_DELETESTRING, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ComboBox_GetLBTextLen(hwndCtl, index) clng(cast(DWORD, SNDMSG((hwndCtl), CB_GETLBTEXTLEN, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ComboBox_GetLBText(hwndCtl, index, lpszBuffer) clng(cast(DWORD, SNDMSG((hwndCtl), CB_GETLBTEXT, cast(WPARAM, clng(index)), cast(LPARAM, cast(LPCTSTR, (lpszBuffer))))))
+#define ComboBox_GetItemData(hwndCtl, index) cast(LRESULT, cast(ULONG_PTR, SNDMSG((hwndCtl), CB_GETITEMDATA, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ComboBox_SetItemData(hwndCtl, index, data) clng(cast(DWORD, SNDMSG((hwndCtl), CB_SETITEMDATA, cast(WPARAM, clng(index)), cast(LPARAM, (data)))))
+#define ComboBox_FindString(hwndCtl, indexStart, lpszFind) clng(cast(DWORD, SNDMSG((hwndCtl), CB_FINDSTRING, cast(WPARAM, clng(indexStart)), cast(LPARAM, cast(LPCTSTR, (lpszFind))))))
+#define ComboBox_FindItemData(hwndCtl, indexStart, data) clng(cast(DWORD, SNDMSG((hwndCtl), CB_FINDSTRING, cast(WPARAM, clng(indexStart)), cast(LPARAM, (data)))))
+#define ComboBox_GetCurSel(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), CB_GETCURSEL, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ComboBox_SetCurSel(hwndCtl, index) clng(cast(DWORD, SNDMSG((hwndCtl), CB_SETCURSEL, cast(WPARAM, clng(index)), cast(LPARAM, 0))))
+#define ComboBox_SelectString(hwndCtl, indexStart, lpszSelect) clng(cast(DWORD, SNDMSG((hwndCtl), CB_SELECTSTRING, cast(WPARAM, clng(indexStart)), cast(LPARAM, cast(LPCTSTR, (lpszSelect))))))
+#define ComboBox_SelectItemData(hwndCtl, indexStart, data) clng(cast(DWORD, SNDMSG((hwndCtl), CB_SELECTSTRING, cast(WPARAM, clng(indexStart)), cast(LPARAM, (data)))))
+#define ComboBox_Dir(hwndCtl, attrs, lpszFileSpec) clng(cast(DWORD, SNDMSG((hwndCtl), CB_DIR, cast(WPARAM, cast(UINT, (attrs))), cast(LPARAM, cast(LPCTSTR, (lpszFileSpec))))))
+#define ComboBox_ShowDropdown(hwndCtl, fShow) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), CB_SHOWDROPDOWN, cast(WPARAM, cast(WINBOOL, (fShow))), cast(LPARAM, 0))))
+#define ComboBox_FindStringExact(hwndCtl, indexStart, lpszFind) clng(cast(DWORD, SNDMSG((hwndCtl), CB_FINDSTRINGEXACT, cast(WPARAM, clng(indexStart)), cast(LPARAM, cast(LPCTSTR, (lpszFind))))))
+#define ComboBox_GetDroppedState(hwndCtl) cast(WINBOOL, cast(DWORD, SNDMSG((hwndCtl), CB_GETDROPPEDSTATE, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ComboBox_GetDroppedControlRect(hwndCtl, lprc) SNDMSG((hwndCtl), CB_GETDROPPEDCONTROLRECT, cast(LPARAM, 0), cast(LPARAM, cptr(RECT ptr, (lprc))))
+#define ComboBox_GetItemHeight(hwndCtl) clng(cast(DWORD, SNDMSG((hwndCtl), CB_GETITEMHEIGHT, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ComboBox_SetItemHeight(hwndCtl, index, cyItem) clng(cast(DWORD, SNDMSG((hwndCtl), CB_SETITEMHEIGHT, cast(WPARAM, clng(index)), cast(LPARAM, clng(cyItem)))))
+#define ComboBox_GetExtendedUI(hwndCtl) cast(UINT, cast(DWORD, SNDMSG((hwndCtl), CB_GETEXTENDEDUI, cast(WPARAM, 0), cast(LPARAM, 0))))
+#define ComboBox_SetExtendedUI(hwndCtl, flags) clng(cast(DWORD, SNDMSG((hwndCtl), CB_SETEXTENDEDUI, cast(WPARAM, cast(UINT, (flags))), cast(LPARAM, 0))))
+#define GET_WPARAM(wp, lp) (wp)
+#define GET_LPARAM(wp, lp) (lp)
+#define GET_X_LPARAM(lp) clng(cshort(LOWORD(lp)))
+#define GET_Y_LPARAM(lp) clng(cshort(HIWORD(lp)))
+#define GET_WM_ACTIVATE_STATE(wp, lp) LOWORD(wp)
+#define GET_WM_ACTIVATE_FMINIMIZED(wp, lp) cast(WINBOOL, HIWORD(wp))
+#define GET_WM_ACTIVATE_HWND(wp, lp) cast(HWND, (lp))
+'' TODO: #define GET_WM_ACTIVATE_MPS(s,fmin,hwnd) (WPARAM)MAKELONG((s),(fmin)),(LPARAM)(hwnd)
+#define GET_WM_CHARTOITEM_CHAR(wp, lp) cast(TCHAR, LOWORD(wp))
+#define GET_WM_CHARTOITEM_POS(wp, lp) HIWORD(wp)
+#define GET_WM_CHARTOITEM_HWND(wp, lp) cast(HWND, (lp))
+'' TODO: #define GET_WM_CHARTOITEM_MPS(ch,pos,hwnd) (WPARAM)MAKELONG((pos),(ch)),(LPARAM)(hwnd)
+#define GET_WM_COMMAND_ID(wp, lp) LOWORD(wp)
+#define GET_WM_COMMAND_HWND(wp, lp) cast(HWND, (lp))
+#define GET_WM_COMMAND_CMD(wp, lp) HIWORD(wp)
+'' TODO: #define GET_WM_COMMAND_MPS(id,hwnd,cmd) (WPARAM)MAKELONG(id,cmd),(LPARAM)(hwnd)
+const WM_CTLCOLOR = &h0019
+#define GET_WM_CTLCOLOR_HDC(wp, lp, msg) cast(HDC, (wp))
+#define GET_WM_CTLCOLOR_HWND(wp, lp, msg) cast(HWND, (lp))
+#define GET_WM_CTLCOLOR_TYPE(wp, lp, msg) cast(WORD, msg - WM_CTLCOLORMSGBOX)
+#define GET_WM_CTLCOLOR_MSG(type) cast(WORD, WM_CTLCOLORMSGBOX + (type))
+'' TODO: #define GET_WM_CTLCOLOR_MPS(hdc,hwnd,type) (WPARAM)(hdc),(LPARAM)(hwnd)
+#define GET_WM_MENUSELECT_CMD(wp, lp) LOWORD(wp)
+#define GET_WM_MENUSELECT_FLAGS(wp, lp) cast(UINT, clng(cshort(HIWORD(wp))))
+#define GET_WM_MENUSELECT_HMENU(wp, lp) cast(HMENU, (lp))
+'' TODO: #define GET_WM_MENUSELECT_MPS(cmd,f,hmenu) (WPARAM)MAKELONG(cmd,f),(LPARAM)(hmenu)
+#define GET_WM_MDIACTIVATE_FACTIVATE(hwnd, wp, lp) (lp = cast(LPARAM, hwnd))
+#define GET_WM_MDIACTIVATE_HWNDDEACT(wp, lp) cast(HWND, (wp))
+#define GET_WM_MDIACTIVATE_HWNDACTIVATE(wp, lp) cast(HWND, (lp))
+'' TODO: #define GET_WM_MDIACTIVATE_MPS(f,hwndD,hwndA) (WPARAM)(hwndA),0
+'' TODO: #define GET_WM_MDISETMENU_MPS(hmenuF,hmenuW) (WPARAM)hmenuF,(LPARAM)hmenuW
+#define GET_WM_MENUCHAR_CHAR(wp, lp) cast(TCHAR, LOWORD(wp))
+#define GET_WM_MENUCHAR_HMENU(wp, lp) cast(HMENU, (lp))
+#define GET_WM_MENUCHAR_FMENU(wp, lp) cast(WINBOOL, HIWORD(wp))
+'' TODO: #define GET_WM_MENUCHAR_MPS(ch,hmenu,f) (WPARAM)MAKELONG(ch,f),(LPARAM)(hmenu)
+#define GET_WM_PARENTNOTIFY_MSG(wp, lp) LOWORD(wp)
+#define GET_WM_PARENTNOTIFY_ID(wp, lp) HIWORD(wp)
+#define GET_WM_PARENTNOTIFY_HWNDCHILD(wp, lp) cast(HWND, (lp))
+#define GET_WM_PARENTNOTIFY_X(wp, lp) clng(cshort(LOWORD(lp)))
+#define GET_WM_PARENTNOTIFY_Y(wp, lp) clng(cshort(HIWORD(lp)))
+'' TODO: #define GET_WM_PARENTNOTIFY_MPS(msg,id,hwnd) (WPARAM)MAKELONG(id,msg),(LPARAM)(hwnd)
+'' TODO: #define GET_WM_PARENTNOTIFY2_MPS(msg,x,y) (WPARAM)MAKELONG(0,msg),MAKELONG(x,y)
+#define GET_WM_VKEYTOITEM_CODE(wp, lp) clng(cshort(LOWORD(wp)))
+#define GET_WM_VKEYTOITEM_ITEM(wp, lp) HIWORD(wp)
+#define GET_WM_VKEYTOITEM_HWND(wp, lp) cast(HWND, (lp))
+'' TODO: #define GET_WM_VKEYTOITEM_MPS(code,item,hwnd) (WPARAM)MAKELONG(item,code),(LPARAM)(hwnd)
+#define GET_EM_SETSEL_START(wp, lp) cast(INT_, (wp))
+#define GET_EM_SETSEL_END(wp, lp) (lp)
+'' TODO: #define GET_EM_SETSEL_MPS(iStart,iEnd) (WPARAM)(iStart),(LPARAM)(iEnd)
+'' TODO: #define GET_EM_LINESCROLL_MPS(vert,horz) (WPARAM)horz,(LPARAM)vert
+#define GET_WM_CHANGECBCHAIN_HWNDNEXT(wp, lp) cast(HWND, (lp))
+#define GET_WM_HSCROLL_CODE(wp, lp) LOWORD(wp)
+#define GET_WM_HSCROLL_POS(wp, lp) HIWORD(wp)
+#define GET_WM_HSCROLL_HWND(wp, lp) cast(HWND, (lp))
+'' TODO: #define GET_WM_HSCROLL_MPS(code,pos,hwnd) (WPARAM)MAKELONG(code,pos),(LPARAM)(hwnd)
+#define GET_WM_VSCROLL_CODE(wp, lp) LOWORD(wp)
+#define GET_WM_VSCROLL_POS(wp, lp) HIWORD(wp)
+#define GET_WM_VSCROLL_HWND(wp, lp) cast(HWND, (lp))
+'' TODO: #define GET_WM_VSCROLL_MPS(code,pos,hwnd) (WPARAM)MAKELONG(code,pos),(LPARAM)(hwnd)