diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..8ff2c056 --- /dev/null +++ b/.gitignore @@ -0,0 +1,30 @@ +# use glob syntax. +syntax: glob + +# VFP generated files +*.err +*.ERR +*.mpr +*.MPR + +# VFP compiled files +*.fxp +*.FXP +*.mpx +*.MPX +*.qpx +*.QPX + +# VFP backup files +*.bak +*.BAK +*.tbk +*.TBK + +# Misc backup files +*.orig +*.ORIG +*.save +*.SAVE +*.zip +*.ZIP diff --git a/Thor/Source/Procs/checkforupdates.sc2 b/Thor/Source/Procs/checkforupdates.sc2 new file mode 100644 index 00000000..96d4ac52 --- /dev/null +++ b/Thor/Source/Procs/checkforupdates.sc2 @@ -0,0 +1,535 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="checkforupdates.scx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="1" /> + + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + +ENDDEFINE + +DEFINE CLASS form1 AS form + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Grid1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column4.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column6.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column6.checkbox" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column6.Label" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column7.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column7.checkbox" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column9.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column9.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column9.Label" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdInstall" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="edtNotes" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Splitter" UniqueID="" Timestamp="" /> + + * + *p: ccolumnorder + *p: ccolumnwidths + *p: lnoupdates + *p: lresult + *p: nsplittertop + *p: _memberdata && XML Metadata for customizable properties + * + + Caption = "Thor: Update Status" + ccolumnorder = + ccolumnwidths = + Desktop = .T. + DoCreate = .T. + Height = 365 + Icon = thor.ico + Left = 0 + lnoupdates = .F. + lresult = .F. + Name = "Form1" + nsplittertop = 0 + Top = 0 + Visible = .T. + Width = 775 + WindowType = 1 + _memberdata = + + + + + + && XML Metadata for customizable properties + + ADD OBJECT 'cmdCancel' AS commandbutton WITH ; + Anchor = 12, ; + Cancel = .T., ; + Caption = "Cancel", ; + FontBold = .T., ; + FontSize = 10, ; + Height = 28, ; + Left = 680, ; + Name = "cmdCancel", ; + TabIndex = 2, ; + Top = 334, ; + Width = 77 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'cmdInstall' AS commandbutton WITH ; + Anchor = 4, ; + Caption = "Install Updates", ; + Default = .T., ; + FontBold = .T., ; + FontSize = 10, ; + Height = 28, ; + Left = 19, ; + Name = "cmdInstall", ; + TabIndex = 1, ; + Top = 334, ; + Width = 126 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'edtNotes' AS editbox WITH ; + Anchor = 14, ; + BorderColor = 192,192,192, ; + BorderStyle = 1, ; + ControlSource = "", ; + DisabledForeColor = 0,0,0, ; + FontSize = 8, ; + Height = 78, ; + IntegralHeight = .F., ; + Left = 12, ; + Name = "edtNotes", ; + ReadOnly = .T., ; + Top = 252, ; + Width = 751 + *< END OBJECT: BaseClass="editbox" /> + + ADD OBJECT 'Grid1' AS grid WITH ; + Anchor = 15, ; + ColumnCount = 6, ; + DeleteMark = .F., ; + GridLineColor = 192,192,192, ; + GridLines = 2, ; + HeaderHeight = 24, ; + Height = 236, ; + HighlightRowLineWidth = 1, ; + Left = 12, ; + Name = "Grid1", ; + Panel = 1, ; + RecordMark = .F., ; + RecordSource = "crsr_ThorUpdates", ; + RowHeight = 22, ; + TabIndex = 3, ; + Top = 6, ; + Width = 751, ; + Column1.ColumnOrder = 2, ; + Column1.ControlSource = "Trim(crsr_ThorUpdates.AppName)", ; + Column1.DynamicFontUnderline = "Not empty(crsr_ThorUpdates.Link)", ; + Column1.DynamicForeColor = "IIF(Empty(crsr_ThorUpdates.Link), RGB(0,0,0), RGB(0,0,255))", ; + Column1.FontSize = 9, ; + Column1.Name = "Column1", ; + Column1.ReadOnly = .T., ; + Column1.Width = 250, ; + Column2.ColumnOrder = 3, ; + Column2.ControlSource = "AllTrim(crsr_ThorUpdates.AvailableVerNumber)", ; + Column2.FontSize = 9, ; + Column2.Name = "Column2", ; + Column2.ReadOnly = .T., ; + Column2.Width = 200, ; + Column3.ColumnOrder = 4, ; + Column3.ControlSource = "Alltrim(crsr_ThorUpdates.Status)", ; + Column3.FontSize = 9, ; + Column3.Name = "Column4", ; + Column3.ReadOnly = .T., ; + Column3.Width = 120, ; + Column4.ColumnOrder = 1, ; + Column4.ControlSource = "crsr_ThorUpdates.UpdateNow", ; + Column4.DynamicCurrentControl = "", ; + Column4.FontSize = 9, ; + Column4.Name = "Column6", ; + Column4.Sparse = .F., ; + Column4.Width = 55, ; + Column5.ColumnOrder = 6, ; + Column5.ControlSource = "crsr_ThorUpdates.NeverUpdate", ; + Column5.FontSize = 9, ; + Column5.Name = "Column7", ; + Column5.Sparse = .F., ; + Column5.Width = 89, ; + Column6.ColumnOrder = 5, ; + Column6.ControlSource = "Alltrim(crsr_ThorUpdates.LinkPrompt)", ; + Column6.DynamicCurrentControl = 'Iif(Empty(crsr_ThorUpdates.LinkPrompt), "label", "text1")', ; + Column6.FontSize = 9, ; + Column6.FontUnderline = .T., ; + Column6.ForeColor = 0,0,255, ; + Column6.Name = "Column9", ; + Column6.Visible = .F., ; + Column6.Width = 180 + *< END OBJECT: BaseClass="grid" /> + + ADD OBJECT 'Grid1.Column1.Header1' AS header WITH ; + Caption = "Application / Link to home page", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BackStyle = 0, ; + BorderColor = 255,255,255, ; + BorderStyle = 0, ; + FontSize = 9, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Grid1.Column2.Header1' AS header WITH ; + Caption = "Available Version", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column2.Text1' AS textbox WITH ; + BackStyle = 0, ; + BorderColor = 255,255,255, ; + BorderStyle = 0, ; + FontSize = 9, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Grid1.Column4.Header1' AS header WITH ; + Caption = "Status", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column4.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontSize = 9, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Grid1.Column6.checkbox' AS checkbox WITH ; + Alignment = 2, ; + BackStyle = 0, ; + Caption = "", ; + Centered = .T., ; + DisabledForeColor = 255,255,255, ; + FontSize = 9, ; + Name = "checkbox", ; + SpecialEffect = 1 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'Grid1.Column6.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Update", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column6.Label' AS label WITH ; + BackStyle = 0, ; + Caption = "", ; + DisabledForeColor = 255,255,255, ; + Name = "Label" + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Grid1.Column7.checkbox' AS checkbox WITH ; + Alignment = 2, ; + BackStyle = 0, ; + Caption = "", ; + Centered = .T., ; + DisabledForeColor = 255,255,255, ; + FontSize = 9, ; + Name = "checkbox" + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'Grid1.Column7.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Never Update", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column9.Header1' AS header WITH ; + Caption = "Link", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column9.Label' AS label WITH ; + Caption = "", ; + Name = "Label" + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Grid1.Column9.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontSize = 9, ; + FontUnderline = .T., ; + ForeColor = 0,0,255, ; + Margin = 0, ; + MousePointer = 15, ; + Name = "Text1", ; + Visible = .F. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Label1' AS label WITH ; + Alignment = 2, ; + Anchor = 4, ; + Caption = "Warning: CLEAR ALL and CLOSE ALL are executed when you install updates", ; + FontBold = .T., ; + FontSize = 10, ; + Height = 18, ; + Left = 159, ; + Name = "Label1", ; + TabIndex = 4, ; + Top = 342, ; + Width = 500 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Splitter' AS thor_sfsplitterv WITH ; + cobject1name = Grid1, ; + cobject2name = edtNotes, ; + Height = 10, ; + Left = 12, ; + lshowgripper = .T., ; + Name = "Splitter", ; + nobject1minsize = 150, ; + nobject2minsize = 50, ; + Top = 242, ; + Visible = .T., ; + Width = 751, ; + GRIPPER.GripperDot1.Name = "GripperDot1", ; + GRIPPER.GripperDot1.ShapeDark.Name = "ShapeDark", ; + GRIPPER.GripperDot1.ShapeLight.Name = "ShapeLight", ; + GRIPPER.GripperDot1.ShapeMiddle.Name = "ShapeMiddle", ; + GRIPPER.GripperDot2.Name = "GripperDot2", ; + GRIPPER.GripperDot2.ShapeDark.Name = "ShapeDark", ; + GRIPPER.GripperDot2.ShapeLight.Name = "ShapeLight", ; + GRIPPER.GripperDot2.ShapeMiddle.Name = "ShapeMiddle", ; + GRIPPER.GripperDot3.Name = "GripperDot3", ; + GRIPPER.GripperDot3.ShapeDark.Name = "ShapeDark", ; + GRIPPER.GripperDot3.ShapeLight.Name = "ShapeLight", ; + GRIPPER.GripperDot3.ShapeMiddle.Name = "ShapeMiddle", ; + GRIPPER.GripperDot4.Name = "GripperDot4", ; + GRIPPER.GripperDot4.ShapeDark.Name = "ShapeDark", ; + GRIPPER.GripperDot4.ShapeLight.Name = "ShapeLight", ; + GRIPPER.GripperDot4.ShapeMiddle.Name = "ShapeMiddle", ; + GRIPPER.GripperDot5.Name = "GripperDot5", ; + GRIPPER.GripperDot5.ShapeDark.Name = "ShapeDark", ; + GRIPPER.GripperDot5.ShapeLight.Name = "ShapeLight", ; + GRIPPER.GripperDot5.ShapeMiddle.Name = "ShapeMiddle", ; + GRIPPER.Name = "GRIPPER" + *< END OBJECT: ClassLib="thor_sfsplitter.vcx" BaseClass="container" /> + + PROCEDURE Destroy + Local lnI + + If Not Isnull(This.oSettings) + This.cColumnWidths = '' + This.cColumnOrder = '' + This.nSplitterTop = This.Splitter.Top + + With This.grid1 + For lnI = 1 To .ColumnCount + With .Columns[lnI] + This.cColumnWidths = This.cColumnWidths + Transform (.Width) + ',' + This.cColumnOrder = This.cColumnOrder + Transform (.ColumnOrder ) + ',' + Endwith + Endfor + Endwith && this.grid1 + + This.oSettings.Save (This) + Endif + + This.oSettings = .Null. + + ENDPROC + + PROCEDURE Init + * ThorFormSettings home page = http://vfpx.codeplex.com/wikipage?title=Thor%20Framework%20FormSettings + Local laColumnOrder[1], laColumnWidths[1], lnI, loSettings + + loSettings = Execscript (_Screen.cThorDispatcher, 'Class= ThorFormSettings', 'Thor Install Updates Settings') + Thisform.AddProperty ('oSettings', loSettings) + + If Not Isnull(loSettings) + loSettings.Restore (Thisform) && Gets top, left, height, width + + loSettings.Restore (Thisform, 'cColumnWidths, cColumnOrder, nSplitterTop') && and two other propertie + + *!* * Removed 10/3/2012 / JRN + *!* If Not Empty (This.cColumnWidths) + *!* Alines (laColumnWidths, This.cColumnWidths, 5, ',') + *!* Alines (laColumnOrder, This.cColumnOrder, 5, ',') + *!* With This.grid1 + *!* For lnI = 1 To Min (.ColumnCount, Alen (laColumnWidths, 1)) + *!* With .Columns[lnI] + *!* .Width = Val (laColumnWidths[lnI]) + *!* .ColumnOrder = Val (laColumnOrder[lnI]) + *!* Endwith + *!* Endfor + *!* Endwith && this.grid1 + *!* Endif && not Empty(This.cColumnWidths) + + Endif + + + + ENDPROC + + PROCEDURE Load + *!* * Removed 11/11/2012 / JRN + *!* Local lnCount + *!* Calculate Sum(1) For Not Disabled To lnCount + + *!* This.lNoUpdates = lnCount = 0 + *!* Goto Top + + ENDPROC + + PROCEDURE Show + Lparameters nStyle + + DoDefault (nStyle) + If This.nSplitterTop # 0 + This.Splitter.MoveSplitterToPosition (This.nSplitterTop) + Endif + + ENDPROC + + PROCEDURE Unload + Return This.lResult + ENDPROC + + PROCEDURE cmdCancel.Click + Thisform.lResult = .F. + Thisform.Release() + + ENDPROC + + PROCEDURE cmdCancel.Init + If Thisform.lNoUpdates + This.Caption = 'Close' + Endif + + ENDPROC + + PROCEDURE cmdInstall.Click + Thisform.lResult = .T. + Thisform.Release() + + ENDPROC + + PROCEDURE cmdInstall.Init + This.Visible = Not Thisform.lNoUpdates + + + ENDPROC + + PROCEDURE edtNotes.Refresh + Local lcNote, lcVersion, lnPos + lcNote = crsr_ThorUpdates.Notes + + If Empty (lcNote) + lcVersion = Alltrim (Evl (crsr_ThorUpdates.AvailableVerNumber, crsr_ThorUpdates.InstalledVerNumber)) + If '(' $ lcVersion + lnPos = Rat ('(', lcVersion) + lcNote = 'Version ' + Trim (Left (lcVersion, lnPos - 1)) + ', released ' + Chrtran (Substr (lcVersion, lnPos), '()', '') + Else + lcNote = 'Version ' + lcNote + EndIf + lcNote = Alltrim(crsr_ThorUpdates.AppName) + ' ' + lcNote + Endif + + This.Value = lcNote + ENDPROC + + PROCEDURE Grid1.AfterRowColChange + LPARAMETERS nColIndex + + Thisform.edtNotes.Refresh() + + ENDPROC + + PROCEDURE Grid1.Column1.Text1.Click + Local lcLink, loLink + lcLink = Alltrim (Link) + If Not Empty (lcLink) + loLink = Newobject ('_ShellExecute', Home() + 'FFC\_Environ.vcx') + loLink.ShellExecute (lcLink) + Endif + + ENDPROC + + PROCEDURE Grid1.Column2.Text1.When + Return .f. + ENDPROC + + PROCEDURE Grid1.Column6.checkbox.Valid + This.Parent.Parent.Refresh() + + ENDPROC + + PROCEDURE Grid1.Column7.checkbox.Valid + Local lcFileName + This.Parent.Parent.Refresh() + lcFileName = Trim (NeverUpdateFile) + Do Case + Case This.Value And Not File (lcFileName) + Strtofile ('No more updating', lcFileName) + Case File (lcFileName) And Not (This.Value) + Erase (lcFileName) + Endcase + + ENDPROC + + PROCEDURE Grid1.Column9.Text1.Click + Local lcLink, loLink + lcLink = Alltrim (Link) + If Not Empty (lcLink) + loLink = Newobject ('_ShellExecute', Home() + 'FFC\_Environ.vcx') + loLink.ShellExecute (lcLink) + Endif + + ENDPROC + + PROCEDURE Grid1.Init + This.SetAll('DynamicFontBold', 'crsr_ThorUpdates.UpdateNow', 'Column') + This.SetAll('DynamicFontItalic', 'crsr_ThorUpdates.FromMyUpdates', 'Column') + This.SetAll('DynamicBackColor', 'ICase(crsr_ThorUpdates.SortKey="A", Rgb(255,255,0), crsr_ThorUpdates.SortKey="Z", Rgb(192,192,192), crsr_ThorUpdates.SortKey="B", Rgb(165, 203, 247), crsr_ThorUpdates.SortKey="D", Rgb(196, 240, 208), Rgb(255,255,255))', 'Column') + + ENDPROC + + PROCEDURE Label1.Init + If Thisform.lNoUpdates + This.Caption = 'No updates available' + Endif + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/Procs/thor_proc_projecthomepages.sc2 b/Thor/Source/Procs/thor_proc_projecthomepages.sc2 new file mode 100644 index 00000000..04c9db57 --- /dev/null +++ b/Thor/Source/Procs/thor_proc_projecthomepages.sc2 @@ -0,0 +1,462 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_proc_projecthomepages.scx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="2" /> + + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + +ENDDEFINE + +DEFINE CLASS form1 AS form + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Grid1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column4.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column6.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column6.checkbox" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column6.Label" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column7.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column7.checkbox" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column9.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column9.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column9.Label" UniqueID="" Timestamp="" /> + + * + *m: createupdatescursor + *p: ccolumnorder + *p: ccolumnwidths + *p: lnoupdates + *p: lresult + *p: nsplittertop + *p: _memberdata && XML Metadata for customizable properties + * + + BindControls = .F. + Caption = "Home Pages for VFPX Projects" + ccolumnorder = + ccolumnwidths = + DataSession = 2 + Desktop = .T. + DoCreate = .T. + Height = 365 + Icon = thor.ico + Left = 0 + lnoupdates = .F. + lresult = .F. + Name = "Form1" + nsplittertop = 0 + Top = 0 + Visible = .T. + Width = 351 + WindowType = 0 + _memberdata = + + + + + + + && XML Metadata for customizable properties + + ADD OBJECT 'Grid1' AS grid WITH ; + Anchor = 15, ; + ColumnCount = 6, ; + DeleteMark = .F., ; + GridLineColor = 192,192,192, ; + GridLines = 2, ; + HeaderHeight = 24, ; + Height = 353, ; + HighlightRowLineWidth = 1, ; + Left = 12, ; + Name = "Grid1", ; + Panel = 1, ; + RecordMark = .F., ; + RecordSource = "crsr_ThorUpdates", ; + RowHeight = 22, ; + TabIndex = 3, ; + Top = 6, ; + Width = 327, ; + Column1.ColumnOrder = 1, ; + Column1.ControlSource = "[]", ; + Column1.FontSize = 9, ; + Column1.Name = "Column1", ; + Column1.ReadOnly = .T., ; + Column1.Visible = .T., ; + Column1.Width = 0, ; + Column2.ColumnOrder = 3, ; + Column2.ControlSource = "AllTrim(crsr_ThorUpdates.AvailableVerNumber)", ; + Column2.FontSize = 9, ; + Column2.Name = "Column2", ; + Column2.ReadOnly = .T., ; + Column2.Visible = .F., ; + Column2.Width = 180, ; + Column3.Alignment = 2, ; + Column3.ColumnOrder = 4, ; + Column3.ControlSource = "Alltrim(crsr_ThorUpdates.Status)", ; + Column3.FontSize = 9, ; + Column3.Name = "Column4", ; + Column3.ReadOnly = .T., ; + Column3.Width = 80, ; + Column4.ColumnOrder = 5, ; + Column4.ControlSource = "crsr_ThorUpdates.UpdateNow", ; + Column4.DynamicCurrentControl = "", ; + Column4.FontSize = 9, ; + Column4.Name = "Column6", ; + Column4.Sparse = .F., ; + Column4.Visible = .F., ; + Column4.Width = 55, ; + Column5.ColumnOrder = 6, ; + Column5.ControlSource = "crsr_ThorUpdates.NeverUpdate", ; + Column5.FontSize = 9, ; + Column5.Name = "Column7", ; + Column5.Sparse = .F., ; + Column5.Visible = .F., ; + Column5.Width = 89, ; + Column6.ColumnOrder = 2, ; + Column6.ControlSource = "Alltrim(crsr_ThorUpdates.LinkPrompt)", ; + Column6.DynamicCurrentControl = 'Iif(Empty(crsr_ThorUpdates.LinkPrompt), "label", "text1")', ; + Column6.FontSize = 9, ; + Column6.FontUnderline = .T., ; + Column6.ForeColor = 0,0,255, ; + Column6.Name = "Column9", ; + Column6.Width = 175 + *< END OBJECT: BaseClass="grid" /> + + ADD OBJECT 'Grid1.Column1.Header1' AS header WITH ; + Caption = "", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BackStyle = 0, ; + BorderColor = 255,255,255, ; + BorderStyle = 0, ; + FontSize = 9, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T., ; + Visible = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Grid1.Column2.Header1' AS header WITH ; + Caption = "Available Version", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column2.Text1' AS textbox WITH ; + BackStyle = 0, ; + BorderColor = 255,255,255, ; + BorderStyle = 0, ; + FontSize = 9, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T., ; + Visible = .F. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Grid1.Column4.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Status", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column4.Text1' AS textbox WITH ; + Alignment = 2, ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontSize = 9, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Grid1.Column6.checkbox' AS checkbox WITH ; + Alignment = 2, ; + BackStyle = 0, ; + Caption = "", ; + Centered = .T., ; + DisabledForeColor = 255,255,255, ; + FontSize = 9, ; + Name = "checkbox", ; + SpecialEffect = 1, ; + Visible = .F. + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'Grid1.Column6.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Update", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column6.Label' AS label WITH ; + BackStyle = 0, ; + Caption = "", ; + DisabledForeColor = 255,255,255, ; + Name = "Label" + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Grid1.Column7.checkbox' AS checkbox WITH ; + Alignment = 2, ; + BackStyle = 0, ; + Caption = "", ; + Centered = .T., ; + DisabledForeColor = 255,255,255, ; + FontSize = 9, ; + Name = "checkbox", ; + Visible = .F. + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'Grid1.Column7.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Never Update", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column9.Header1' AS header WITH ; + Caption = "Project", ; + FontSize = 9, ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column9.Label' AS label WITH ; + Caption = "", ; + Name = "Label" + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Grid1.Column9.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontSize = 9, ; + FontUnderline = .T., ; + ForeColor = 0,0,255, ; + Margin = 0, ; + MousePointer = 15, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE createupdatescursor + Local laLines[1], lcPrompt, llAnyFound, lnI, lnLineCount, loUpdateList, loVersionInfo + + loUpdateList = Execscript(_Screen.cThorDispatcher, 'Thor_Proc_GetUpdateList', 0) + + Create Cursor crsr_ThorUpdates( ; + Recno N(4), ; + AppName C(20), ; + InstalledVersion C(100), ; + InstalledVerNumber C(100), ; + InstalledVerDate C(20), ; + AvailableVersion C(100), ; + AvailableVerNumber C(100), ; + AvailableVerDate C(20), ; + Status C(40), ; + UpdateNow L, ; + NeverUpdate L, ; + NeverUpdateFile C(250), ; + FromMyUpdates L, ; + Notes M, ; + Link M, ; + LinkPrompt C(100), ; + Disabled L, ; + SortKey C(100), ; + VerDate D ; + ) + + llAnyFound = .F. + For lnI = 1 To loUpdateList.Count + With loUpdateList[lnI] + + If Not Empty(.Link) + lcPrompt = Strtran(Transform(.LinkPrompt), 'Home Page', '') + Insert Into crsr_ThorUpdates ; + (Recno, AppName, InstalledVersion, AvailableVersion, Notes, FromMyUpdates, Link, LinkPrompt) ; + Values ; + (lnI, .ApplicationName, .CurrentVersion, .AvailableVersion, .Tag, .FromMyUpdates = 'Y', Transform(.Link), lcPrompt) + + If Empty(.CurrentVersion) + Replace SortKey With 'X' + Else + Replace Status With 'Installed' ; + SortKey With 'A' + Endif + Endif && not Empty(.Link) + + *!* * Removed 10/5/2012 / JRN + *!* loVersionInfo = GetVersionInfo (.CurrentVersion) + *!* Replace InstalledVerNumber With Alltrim (loVersionInfo.VerNumber) + Iif (loVersionInfo.VerDate <= EmptyVerDate, '', ' (' + Dtoc (loVersionInfo.VerDate) + ')') + *!* *!* Replace InstalledVerNumber With loVersionInfo.VerNumber ; + *!* *!* InstalledVerDate With loVersionInfo.VerDate + + *!* *!* * Removed 10/3/2012 / JRN + *!* *!* If (Not .CurrentVersion == .AvailableVersion) And Not Empty (.AvailableVersion) + *!* If Not Empty (.AvailableVersion) + *!* loVersionInfo = GetVersionInfo (.AvailableVersion) + *!* Replace AvailableVerNumber With Alltrim (loVersionInfo.VerNumber) + ' (' + Dtoc (loVersionInfo.VerDate) + ')' + *!* *!* Replace AvailableVerNumber With loVersionInfo.VerNumber ; + *!* *!* AvailableVerDate With loVersionInfo.VerDate + *!* Endif + + *!* Replace NeverUpdate With .NeverUpdate = 'Y' ; + *!* UpdateNow With (Not NeverUpdate) ; + *!* And (.AvailableVersion > EVL(.CurrentVersion, ' ') ) ; + *!* And (.UpdateNowIfNotInstalled = 'Yes' Or Not Empty (.CurrentVersion)) ; + *!* Disabled With .CurrentVersion == .AvailableVersion ; + *!* NeverUpdateFile With .NeverUpdateFile ; + *!* Notes With Transform(.Notes) ; + *!* Link With Transform(.Link) ; + *!* LinkPrompt With Transform(Evl (.LinkPrompt, .Link)) ; + *!* VerDate with loVersionInfo.VerDate + + *!* Replace SortKey With ; + *!* Icase(UpdateNow, 'A', ; + *!* NeverUpdate, 'Z', ; + *!* Empty(InstalledVerNumber) And VerDate > Date() - 100, 'C', ; + *!* Disabled, 'B', ; + *!* 'X') + ; + *!* Upper(AppName) + + *!* Replace Status With ; + *!* Icase(UpdateNow, 'Update available', ; + *!* Disabled, 'Current', ; + *!* 'Not Installed') + + *!* llAnyFound = llAnyFound Or UpdateNow + + Endwith + Endfor && lnI = 1 to loUpdateList.Count + + Select * ; + From crsr_ThorUpdates ; + Into Cursor crsr_ThorUpdates Readwrite ; + Order By SortKey + Goto Top + + Return llAnyFound + + ENDPROC + + PROCEDURE Destroy + Local lnI + + If Not Isnull(This.oSettings) + This.cColumnWidths = '' + This.cColumnOrder = '' + + With This.grid1 + For lnI = 1 To .ColumnCount + With .Columns[lnI] + This.cColumnWidths = This.cColumnWidths + Transform (.Width) + ',' + This.cColumnOrder = This.cColumnOrder + Transform (.ColumnOrder ) + ',' + Endwith + Endfor + Endwith && this.grid1 + + This.oSettings.Save (This) + Endif + + This.oSettings = .Null. + + ENDPROC + + PROCEDURE Init + * ThorFormSettings home page = http://vfpx.codeplex.com/wikipage?title=Thor%20Framework%20FormSettings + Local laColumnOrder[1], laColumnWidths[1], lnI, loSettings + + loSettings = Execscript (_Screen.cThorDispatcher, 'Class= ThorFormSettings', 'ProjectHomePages') + Thisform.AddProperty ('oSettings', loSettings) + Thisform.CreateUpdatesCursor() + Thisform.Bindcontrols = .t. + + If Not Isnull(loSettings) + loSettings.Restore (Thisform) && Gets top, left, height, width + + loSettings.Restore (Thisform, 'cColumnWidths, cColumnOrder, nSplitterTop') && and two other propertie + + *!* * Removed 10/3/2012 / JRN + *!* If Not Empty (This.cColumnWidths) + *!* Alines (laColumnWidths, This.cColumnWidths, 5, ',') + *!* Alines (laColumnOrder, This.cColumnOrder, 5, ',') + *!* With This.grid1 + *!* For lnI = 1 To Min (.ColumnCount, Alen (laColumnWidths, 1)) + *!* With .Columns[lnI] + *!* .Width = Val (laColumnWidths[lnI]) + *!* .ColumnOrder = Val (laColumnOrder[lnI]) + *!* Endwith + *!* Endfor + *!* Endwith && this.grid1 + *!* Endif && not Empty(This.cColumnWidths) + + Endif + + + + ENDPROC + + PROCEDURE Grid1.Column1.Text1.When + Return .f. + ENDPROC + + PROCEDURE Grid1.Column2.Text1.When + Return .f. + ENDPROC + + PROCEDURE Grid1.Column6.checkbox.Valid + This.Parent.Parent.Refresh() + + ENDPROC + + PROCEDURE Grid1.Column7.checkbox.Valid + Local lcFileName + This.Parent.Parent.Refresh() + lcFileName = Trim (NeverUpdateFile) + Do Case + Case This.Value And Not File (lcFileName) + Strtofile ('No more updating', lcFileName) + Case File (lcFileName) And Not (This.Value) + Erase (lcFileName) + Endcase + + ENDPROC + + PROCEDURE Grid1.Column9.Text1.Click + Local lcLink, loLink + lcLink = Alltrim (Link) + If Not Empty (lcLink) + loLink = Newobject ('_ShellExecute', Home() + 'FFC\_Environ.vcx') + loLink.ShellExecute (lcLink) + Endif + + ENDPROC + + PROCEDURE Grid1.Init + This.SetAll('DynamicFontBold', 'crsr_ThorUpdates.UpdateNow', 'Column') + This.SetAll('DynamicFontItalic', 'crsr_ThorUpdates.FromMyUpdates', 'Column') + This.SetAll('DynamicBackColor', 'ICase(crsr_ThorUpdates.UpdateNow, Rgb(255,255,0), crsr_ThorUpdates.NeverUpdate, Rgb(192,192,192), Empty(InstalledVerNumber) and VerDate > Date() - 100, Rgb(196, 240, 208), Rgb(255,255,255))', 'Column') + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/Procs/thor_sfsplitter.vc2 b/Thor/Source/Procs/thor_sfsplitter.vc2 new file mode 100644 index 00000000..39cf7a48 --- /dev/null +++ b/Thor/Source/Procs/thor_sfsplitter.vc2 @@ -0,0 +1,737 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_sfsplitter.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS gripper AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="GripperDot1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="GripperDot2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="GripperDot3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="GripperDot4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="GripperDot5" UniqueID="" Timestamp="" /> + + * + *m: setupforhorizontalsplitter && A method to set the positions of the dots to a vertical orientation. + *m: setupforverticalsplitter && A method to set the positions of the dots to a horizontal orientation. + *m: setupgripper && The setup method to positiosn the dots according to the orientation of the splitter, also sets up the number of dots. + *p: ndots && Enter a number from 0 to 5 to indicate how many gripper dots to show. Enter 0 for none. + *p: _memberdata && XML Metadata for customizable properties + * + + BackStyle = 0 + BorderWidth = 0 + Height = 19 + Name = "gripper" + ndots = 5 && Enter a number from 0 to 5 to indicate how many gripper dots to show. Enter 0 for none. + Width = 36 + _memberdata = + + + + + && XML Metadata for customizable properties + + ADD OBJECT 'GripperDot1' AS gripperdot WITH ; + Left = 2, ; + Name = "GripperDot1", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sfsplitter.vcx" BaseClass="container" /> + + ADD OBJECT 'GripperDot2' AS gripperdot WITH ; + Left = 6, ; + Name = "GripperDot2", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sfsplitter.vcx" BaseClass="container" /> + + ADD OBJECT 'GripperDot3' AS gripperdot WITH ; + Left = 10, ; + Name = "GripperDot3", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sfsplitter.vcx" BaseClass="container" /> + + ADD OBJECT 'GripperDot4' AS gripperdot WITH ; + Left = 14, ; + Name = "GripperDot4", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sfsplitter.vcx" BaseClass="container" /> + + ADD OBJECT 'GripperDot5' AS gripperdot WITH ; + Left = 18, ; + Name = "GripperDot5", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sfsplitter.vcx" BaseClass="container" /> + + PROCEDURE MouseMove + * If the user starts a drag on us, bubble it up to the splitter. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + + PROCEDURE setupforhorizontalsplitter && A method to set the positions of the dots to a vertical orientation. + local lnDotHeight, ; + lnI, ; + loDot + with This + + * Position the dots in a vertical orientation for a horizontal splitter. + + lnDotHeight = .GripperDot1.Height + for lnI = 1 to 5 + loDot = evaluate('.GripperDot' + transform(lnI)) + loDot.Left = 2 + loDot.Top = (lnDotHeight * lnI - 1) + 1 + next lnI + + * Adjust the container so it shows the correct number of dots. + + .Height = .nDots * lnDotHeight + .Width = lnDotHeight + 1 + + * Center the container and set Anchor so it stays centered. + + .Left = (.Parent.Width - .Width)/2 - 1 + .Top = (.Parent.Height - .Height)/2 + .Anchor = 512 + endwith + + ENDPROC + + PROCEDURE setupforverticalsplitter && A method to set the positions of the dots to a horizontal orientation. + local lnDotWidth, ; + lnI, ; + loDot + with This + + * Position the dots in a horizontal orientation for a vertical splitter. + + lnDotWidth = .GripperDot1.Width + for lnI = 1 to 5 + loDot = evaluate('.GripperDot' + transform(lnI)) + loDot.Left = (lnDotWidth * lnI - 1) + 1 + loDot.Top = 2 + next lnI + + * Adjust the container so it shows the correct number of dots. + + .Width = .nDots * lnDotWidth + .Height = lnDotWidth + 1 + + * Center the container and set Anchor so it stays centered. + + .Top = (.Parent.Height - .Height)/2 - 1 + .Left = (.Parent.Width - .Width)/2 + .Anchor = 256 + endwith + + ENDPROC + + PROCEDURE setupgripper && The setup method to positiosn the dots according to the orientation of the splitter, also sets up the number of dots. + local loDot + with This + + * Get the number of dots to use. + + .nDots = .Parent.nDots + + * Use the same MousePointer as the splitter, both for ourselves and each dot. + + .MousePointer = .Parent.MousePointer + for each loDot in .Controls foxobject + loDot.SetAll('MousePointer', .MousePointer) + next loDot + + * Adjust the gripper based on whether this is a vertical or horizontal + * splitter. + + if .Parent.Width > .Parent.Height + .SetupForVerticalSplitter() + else + .SetupForHorizontalSplitter() + endif .Parent.Width > .Parent.Height + endwith + + ENDPROC + +ENDDEFINE + +DEFINE CLASS gripperdot AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="ShapeDark" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ShapeLight" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ShapeMiddle" UniqueID="" Timestamp="" /> + + BackStyle = 0 + BorderWidth = 0 + Height = 4 + Name = "gripperdot" + Width = 4 + + ADD OBJECT 'ShapeDark' AS shape WITH ; + BackStyle = 1, ; + BorderStyle = 0, ; + BorderWidth = 0, ; + FillColor = 80,80,80, ; + FillStyle = 0, ; + Height = 2, ; + Left = 1, ; + Name = "ShapeDark", ; + Top = 1, ; + Width = 2 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'ShapeLight' AS shape WITH ; + BackStyle = 1, ; + BorderStyle = 0, ; + BorderWidth = 0, ; + FillColor = 250,250,250, ; + FillStyle = 0, ; + Height = 2, ; + Left = 2, ; + Name = "ShapeLight", ; + Top = 2, ; + Width = 2 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'ShapeMiddle' AS shape WITH ; + BackStyle = 1, ; + BorderStyle = 0, ; + BorderWidth = 0, ; + FillColor = 173,209,255, ; + FillStyle = 0, ; + Height = 1, ; + Left = 2, ; + Name = "ShapeMiddle", ; + Top = 2, ; + Width = 1 + *< END OBJECT: BaseClass="shape" /> + + PROCEDURE MouseMove + * If the user starts a drag on us, bubble it up to our container. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + + PROCEDURE ShapeDark.MouseMove + * If the user starts a drag on us, bubble it up to our container. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + + PROCEDURE ShapeLight.MouseMove + * If the user starts a drag on us, bubble it up to our container. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + + PROCEDURE ShapeMiddle.MouseMove + * If the user starts a drag on us, bubble it up to our container. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_sfsplitter AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Gripper" UniqueID="" Timestamp="" /> + + * + *m: adjustminimum && Adjusts the form so it can't be sized too small + *m: getobject1size && Gets the size for Object 1 + *m: getobject2size && Gets the size for Object 2 + *m: getposition && Returns the new position: X for a horizontal splitter and Y for a vertical splitter + *m: moveobject1 && Moves Object 1 to the new position + *m: moveobject2 && Moves Object 2 to the new position + *m: movesplittertoposition && Moves the splitter to the specified position + *m: setposition && Sets the new position for the splitter + *m: setupgripper && A method to setup various properties on the gripper to visually configure it for Vertical or Horizontal configuration. + *m: splittermoved && Called after the splitter is moved + *p: cobject1name && The name of the object above (for a vertical splitter) or to the left of (for a horizontal splitter) the splitter + *p: cobject2name && The name of the object below (for a vertical splitter) or to the right of (for a horizontal splitter) the splitter + *p: lshowgripper && .T. to display the splitter visually including the gripper control + *p: ndots && Enter a value between 0 and 5 for the number of dots to be shown on the gripper. Enter 0 for none. + *p: nobject1minsize && The minimum height (for a vertical splitter) or width (for a horizontal splitter) of Object 1 + *p: nobject2minsize && The minimum height (for a vertical splitter) or width (for a horizontal splitter) of Object 2 + *p: _memberdata && XML Metadata for customizable properties + * + + BackColor = 192,192,192 + BackStyle = 0 + BorderColor = 255,0,0 + BorderWidth = 2 + cobject1name = && The name of the object above (for a vertical splitter) or to the left of (for a horizontal splitter) the splitter + cobject2name = && The name of the object below (for a vertical splitter) or to the right of (for a horizontal splitter) the splitter + Height = 248 + lshowgripper = .F. && .T. to display the splitter visually including the gripper control + Name = "sfsplitter" + ndots = 5 && Enter a value between 0 and 5 for the number of dots to be shown on the gripper. Enter 0 for none. + nobject1minsize = 0 && The minimum height (for a vertical splitter) or width (for a horizontal splitter) of Object 1 + nobject2minsize = 0 && The minimum height (for a vertical splitter) or width (for a horizontal splitter) of Object 2 + Width = 10 + _memberdata = + + + + + + + + + + + + + + + + + && XML Metadata for customizable properties + + ADD OBJECT 'Gripper' AS gripper WITH ; + Height = 12, ; + Left = 1, ; + Name = "Gripper", ; + Top = -1, ; + Visible = .F., ; + Width = 20, ; + Gripperdot1.Name = "Gripperdot1", ; + Gripperdot1.ShapeDark.Name = "ShapeDark", ; + Gripperdot1.ShapeLight.Name = "ShapeLight", ; + Gripperdot1.ShapeMiddle.Name = "ShapeMiddle", ; + Gripperdot2.Name = "Gripperdot2", ; + Gripperdot2.ShapeDark.Name = "ShapeDark", ; + Gripperdot2.ShapeLight.Name = "ShapeLight", ; + Gripperdot2.ShapeMiddle.Name = "ShapeMiddle", ; + Gripperdot3.Name = "Gripperdot3", ; + Gripperdot3.ShapeDark.Name = "ShapeDark", ; + Gripperdot3.ShapeLight.Name = "ShapeLight", ; + Gripperdot3.ShapeMiddle.Name = "ShapeMiddle", ; + Gripperdot4.Name = "Gripperdot4", ; + Gripperdot4.ShapeDark.Name = "ShapeDark", ; + Gripperdot4.ShapeLight.Name = "ShapeLight", ; + Gripperdot4.ShapeMiddle.Name = "ShapeMiddle", ; + Gripperdot5.Name = "Gripperdot5", ; + Gripperdot5.ShapeDark.Name = "ShapeDark", ; + Gripperdot5.ShapeLight.Name = "ShapeLight", ; + Gripperdot5.ShapeMiddle.Name = "ShapeMiddle" + *< END OBJECT: ClassLib="thor_sfsplitter.vcx" BaseClass="container" /> + + PROCEDURE adjustminimum && Adjusts the form so it can't be sized too small + * Abstract method. + + ENDPROC + + PROTECTED PROCEDURE getobject1size && Gets the size for Object 1 + * Abstract method. + + lparameters toObject + + ENDPROC + + PROTECTED PROCEDURE getobject2size && Gets the size for Object 2 + * Abstract method. + + lparameters toObject + + ENDPROC + + PROTECTED PROCEDURE getposition && Returns the new position: X for a horizontal splitter and Y for a vertical splitter + * Abstract method. + + lparameters tnXCoord, ; + tnYCoord + + ENDPROC + + PROCEDURE Init + with This + + * Set BorderWidth to 0 so it doesn't appear at run time. + + .BorderWidth = 0 + + * If we're showing a gripper image (thanks to Matt Slay for the gripper + * controls), set BackStyle so we can see the color and set up the gripper. + + if .lShowGripper + .BackStyle = 1 + .SetupGripper() + endif .lShowGripper + + * Call AdjustMinimum to adjust the form so it can't be sized too small. + + .AdjustMinimum() + endwith + dodefault() + + ENDPROC + + PROCEDURE MouseMove + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + local lnPosition + with This + if tnButton = 1 and .Enabled + lnPosition = .GetPosition(tnXCoord, tnYCoord) + .MoveSplitterToPosition(lnPosition) + endif tnButton = 1 ... + endwith + + ENDPROC + + PROTECTED PROCEDURE moveobject1 && Moves Object 1 to the new position + * Abstract method. + + lparameters toObject + + ENDPROC + + PROTECTED PROCEDURE moveobject2 && Moves Object 2 to the new position + * Abstract method. + + lparameters toObject + + ENDPROC + + PROCEDURE movesplittertoposition && Moves the splitter to the specified position + lparameters tnPosition + local lnPosition, ; + laObjects1[1], ; + lnObjects1, ; + lnI, ; + loObject, ; + laObjects2[1], ; + lnObjects2, ; + lnAnchor + with This + + * Move the splitter to the specified position. Ensure it doesn't go too far, + * based on the nObject1MinSize and nObject2MinSize settings. + + lnPosition = tnPosition + lnObjects1 = alines(laObjects1, .cObject1Name, 4, ',') + for lnI = 1 to lnObjects1 + loObject = evaluate('.Parent.' + laObjects1[lnI]) + lnPosition = max(lnPosition, .GetObject1Size(loObject)) + next lnI + lnObjects2 = alines(laObjects2, .cObject2Name, 4, ',') + for lnI = 1 to lnObjects2 + loObject = evaluate('.Parent.' + laObjects2[lnI]) + lnPosition = min(lnPosition, .GetObject2Size(loObject)) + next lnI + lnAnchor = .Anchor + .Anchor = 0 + .SetPosition(lnPosition) + .Anchor = lnAnchor + + * Now move the objects as well. + + for lnI = 1 to lnObjects1 + loObject = evaluate('.Parent.' + laObjects1[lnI]) + with loObject + lnAnchor = .Anchor + .Anchor = 0 + This.MoveObject1(loObject) + .Anchor = lnAnchor + endwith + next lnI + for lnI = 1 to lnObjects2 + loObject = evaluate('.Parent.' + laObjects2[lnI]) + with loObject + lnAnchor = .Anchor + .Anchor = 0 + This.MoveObject2(loObject) + .Anchor = lnAnchor + endwith + next lnI + + * Since the object sizes have changed, we need to adjust the form as necessary. + + .AdjustMinimum() + + * Call a hook method. + + .SplitterMoved() + endwith + + ENDPROC + + PROTECTED PROCEDURE setposition && Sets the new position for the splitter + * Abstract method. + + lparameters tnPosition + + ENDPROC + + PROCEDURE setupgripper && A method to setup various properties on the gripper to visually configure it for Vertical or Horizontal configuration. + with This + .Gripper.Visible = .T. + .Gripper.SetupGripper() + endwith + + ENDPROC + + PROCEDURE splittermoved && Called after the splitter is moved + * Abstract method. + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_sfsplitterh AS thor_sfsplitter OF "thor_sfsplitter.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + Anchor = 13 + MousePointer = 9 + Name = "thor_sfsplitterh" + gripper.Gripperdot1.Name = "Gripperdot1" + gripper.Gripperdot1.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot1.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot1.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot2.Name = "Gripperdot2" + gripper.Gripperdot2.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot2.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot2.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot3.Name = "Gripperdot3" + gripper.Gripperdot3.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot3.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot3.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot4.Name = "Gripperdot4" + gripper.Gripperdot4.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot4.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot4.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot5.Name = "Gripperdot5" + gripper.Gripperdot5.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot5.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot5.ShapeMiddle.Name = "ShapeMiddle" + gripper.Name = "gripper" + + PROCEDURE adjustminimum && Adjusts the form so it can't be sized too small + * Don't allow the form to be sized smaller than the left object should be. + + local laObjects[1], ; + lnObjects, ; + lnWidth, ; + lnI, ; + loObject + with This + lnObjects = alines(laObjects, .cObject1Name, 4, ',') + lnWidth = -1 + for lnI = 1 to lnObjects + loObject = evaluate('.Parent.' + laObjects[lnI]) + lnWidth = max(lnWidth, loObject.Width) + next lnI + Thisform.MinWidth = lnWidth + .nObject2MinSize + endwith + + ENDPROC + + PROCEDURE getobject1size && Gets the size for Object 1 + lparameters toObject + return toObject.Left + This.nObject1MinSize + + ENDPROC + + PROCEDURE getobject2size && Gets the size for Object 2 + lparameters toObject + return toObject.Left + toObject.Width - This.nObject2MinSize - This.Width + + ENDPROC + + PROCEDURE getposition && Returns the new position: X for a horizontal splitter and Y for a vertical splitter + lparameters tnXCoord, ; + tnYCoord + return tnXCoord + This.Left - objtoclient(This, 2) + + ENDPROC + + PROCEDURE moveobject1 && Moves Object 1 to the new position + lparameters toObject + with toObject + .Move(.Left, .Top, This.Left - .Left, .Height) + endwith + + ENDPROC + + PROCEDURE moveobject2 && Moves Object 2 to the new position + lparameters toObject + with toObject + .Move(This.Left + This.Width, .Top, max(.Width + .Left - This.Left - ; + This.Width, 0), .Height) + endwith + + ENDPROC + + PROCEDURE setposition && Sets the new position for the splitter + lparameters tnPosition + This.Left = tnPosition + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_sfsplitterv AS thor_sfsplitter OF "thor_sfsplitter.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + Anchor = 14 + Height = 10 + MousePointer = 7 + Name = "sfsplitterv" + Width = 200 + gripper.Gripperdot1.Name = "Gripperdot1" + gripper.Gripperdot1.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot1.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot1.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot2.Name = "Gripperdot2" + gripper.Gripperdot2.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot2.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot2.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot3.Name = "Gripperdot3" + gripper.Gripperdot3.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot3.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot3.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot4.Name = "Gripperdot4" + gripper.Gripperdot4.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot4.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot4.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot5.Name = "Gripperdot5" + gripper.Gripperdot5.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot5.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot5.ShapeMiddle.Name = "ShapeMiddle" + gripper.Name = "gripper" + + PROCEDURE adjustminimum && Adjusts the form so it can't be sized too small + * Don't allow the form to be sized smaller than the top object should be. + + local laObjects[1], ; + lnObjects, ; + lnHeight, ; + lnI, ; + loObject + with This + lnObjects = alines(laObjects, .cObject1Name, 4, ',') + lnHeight = -1 + for lnI = 1 to lnObjects + loObject = evaluate('.Parent.' + laObjects[lnI]) + lnHeight = max(lnHeight, loObject.Height) + next lnI + Thisform.MinHeight = max(Thisform.MinHeight, Thisform.Height - lnHeight + ; + .nObject1MinSize) + endwith + + ENDPROC + + PROCEDURE getobject1size && Gets the size for Object 1 + lparameters toObject + return toObject.Top + This.nObject1MinSize + + ENDPROC + + PROCEDURE getobject2size && Gets the size for Object 2 + lparameters toObject + return toObject.Top + toObject.Height - This.nObject2MinSize - This.Height + + ENDPROC + + PROCEDURE getposition && Returns the new position: X for a horizontal splitter and Y for a vertical splitter + lparameters tnXCoord, ; + tnYCoord + return tnYCoord + This.Top - objtoclient(This, 1) + + ENDPROC + + PROCEDURE moveobject1 && Moves Object 1 to the new position + lparameters toObject + with toObject + .Move(.Left, .Top, .Width, This.Top - .Top) + endwith + + ENDPROC + + PROCEDURE moveobject2 && Moves Object 2 to the new position + lparameters toObject + with toObject + .Move(.Left, This.Top + This.Height, .Width, max(.Height + .Top - This.Top - ; + This.Height, 0)) + endwith + + ENDPROC + + PROCEDURE setposition && Sets the new position for the splitter + lparameters tnPosition + This.Top = tnPosition + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/Procs/thor_tool_thorinternalmanageplugins.sc2 b/Thor/Source/Procs/thor_tool_thorinternalmanageplugins.sc2 new file mode 100644 index 00000000..c732724d --- /dev/null +++ b/Thor/Source/Procs/thor_tool_thorinternalmanageplugins.sc2 @@ -0,0 +1,411 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_tool_thorinternalmanageplugins.scx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="2" /> + + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + +ENDDEFINE + +DEFINE CLASS manageplugins AS form + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Grid1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column3.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Column4.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Action.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Grid1.Action.cmdAction" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblLink" UniqueID="" Timestamp="" /> + + * + *m: addpluginstocursor + *m: createfile + *m: getactiveplugin + *m: openplugin + *m: setactioncaption + *p: chomefolder + *p: cprocfolder + *p: ctoolscollection + *p: ctoolsfolder + *p: _memberdata && XML Metadata for customizable properties + * + + Caption = "Manage Plug-in PRGs" + chomefolder = + cprocfolder = + ctoolscollection = + ctoolsfolder = + DataSession = 2 + DoCreate = .T. + Height = 458 + Left = 0 + Name = "ManagePlugIns" + Top = 0 + Width = 900 + _memberdata = + + + + + + + + + + && XML Metadata for customizable properties + + ADD OBJECT 'Grid1' AS grid WITH ; + Anchor = 15, ; + ColumnCount = 4, ; + DeleteMark = .F., ; + HeaderHeight = 28, ; + Height = 432, ; + Left = 6, ; + Name = "Grid1", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordSource = "PlugIns", ; + RowHeight = 48, ; + Top = 6, ; + Width = 888, ; + Column1.Alignment = 0, ; + Column1.ControlSource = "PlugIns.PlugIn", ; + Column1.Name = "Column1", ; + Column1.ReadOnly = .T., ; + Column1.Width = 150, ; + Column2.ColumnOrder = 3, ; + Column2.ControlSource = "PlugIns.Desc", ; + Column2.Name = "Column3", ; + Column2.ReadOnly = .T., ; + Column2.Sparse = .F., ; + Column2.Width = 351, ; + Column3.ColumnOrder = 4, ; + Column3.ControlSource = "PlugIns.Tools", ; + Column3.Name = "Column4", ; + Column3.ReadOnly = .T., ; + Column3.Sparse = .F., ; + Column3.Width = 250, ; + Column4.ColumnOrder = 2, ; + Column4.DynamicFontShadow = "Thisform.SetActionCaption()", ; + Column4.FontBold = .T., ; + Column4.Name = "Action", ; + Column4.ReadOnly = .T., ; + Column4.Sparse = .F., ; + Column4.Width = 100 + *< END OBJECT: BaseClass="grid" /> + + ADD OBJECT 'Grid1.Action.cmdAction' AS commandbutton WITH ; + BackColor = 255,255,255, ; + Caption = "Command1", ; + FontBold = .T., ; + ForeColor = 0,0,0, ; + Name = "cmdAction" + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Grid1.Action.Header1' AS header WITH ; + Caption = "Action", ; + FontBold = .T., ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column1.Header1' AS header WITH ; + Caption = "Plug In", ; + FontBold = .T., ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column1.Text1' AS textbox WITH ; + Alignment = 0, ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontBold = .F., ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Grid1.Column3.Header1' AS header WITH ; + Caption = "Description", ; + FontBold = .T., ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column3.Text1' AS editbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T., ; + ScrollBars = 0 + *< END OBJECT: BaseClass="editbox" /> + + ADD OBJECT 'Grid1.Column4.Header1' AS header WITH ; + Caption = "Applies to", ; + FontBold = .T., ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'Grid1.Column4.Text1' AS editbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontBold = .F., ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T., ; + ScrollBars = 0 + *< END OBJECT: BaseClass="editbox" /> + + ADD OBJECT 'lblLink' AS label WITH ; + Anchor = 12, ; + Caption = "Plug-ins Home Page", ; + FontUnderline = .T., ; + ForeColor = 0,0,255, ; + Height = 17, ; + Left = 12, ; + MousePointer = 15, ; + Name = "lblLink", ; + TabIndex = 5, ; + Top = 439, ; + Width = 136 + *< END OBJECT: BaseClass="label" /> + + PROCEDURE addpluginstocursor + Local laClasses[1], lcClass, lcPlugIn, lcToolFolder, lcToolName, lnCounter, lnI, lnJ, loClass + Local loThor, loTool, loToolsCollection + + loThor = Execscript(_Screen.cThorDispatcher, 'Thor Engine=') + lcToolFolder = Execscript(_Screen.cThorDispatcher, 'Tool Folder=') + loToolsCollection = loThor.GetToolsCollection(Addbs(lcToolFolder)) + + This.cToolsFolder = Justpath(Upper(lcToolFolder)) + This.cProcFolder = Upper(Addbs(lcToolFolder) + 'Procs') + + Create Cursor Crossref (PlugIn C(30), ToolName C(60)) + Index on PlugIn + ToolName tag order + + For lnI = 1 To loToolsCollection.Count + loTool = loToolsCollection[lnI] + If Not Empty(loTool.PlugInClasses) + lnCounter = Alines(laClasses, loTool.PlugInClasses, 5, ',') + For lnJ = 1 To lnCounter + lcClass = laClasses[lnJ] + loClass = Newobject(lcClass, loTool.FullFileName) + With loClass + Insert Into PlugIns(Source, PlugIn, Desc, Tools, FileNames, DefaultFileName, DefaultFileContents) ; + Values(.Source, .PlugIn, .Description, .Tools, .FileNames, .DefaultFileName, .DefaultFileContents) + Endwith + Endfor + Endif + If Not Empty(loTool.PlugIns) + lnCounter = Alines(laClasses, loTool.PlugIns, 5, ',') + If 'PEM EDITOR' $ Upper(loTool.Prompt) + lcToolName = 'PEM Editor' + Else + lcToolName = loTool.Prompt + Endif + + For lnJ = 1 To lnCounter + lcPlugIn = laClasses[lnJ] + Insert Into Crossref(PlugIn, ToolName) Values (lcPlugIn, lcToolName) + Endfor + Endif + Endfor + + Select PlugIns + ENDPROC + + PROCEDURE createfile + Lparameters lcDestFile, lcCliptext + Local loEditorWin As Editorwin Of 'c:\visual foxpro\programs\MyThor\thor\tools\apps\pem editor\source\peme_editorwin.vcx' + Local loTools As Pemeditor_tools Of 'c:\visual foxpro\programs\MyThor\thor\tools\apps\pem editor\source\peme_tools.vcx' + + * tools home page = http://vfpx.codeplex.com/wikipage?title=thor%20tools%20object + loTools = Execscript(_Screen.cThorDispatcher, 'Class= tools from pemeditor') + loTools.EditSourceX(lcDestFile) + + * editorwin home page = http://vfpx.codeplex.com/wikipage?title=thor%20editorwindow%20object + loEditorWin = Execscript(_Screen.cThorDispatcher, 'Class= editorwin from pemeditor') + loEditorWin.Paste(lcCliptext) + loEditorWin.SetInsertionPoint(0) + + ENDPROC + + PROCEDURE Destroy + This.oSettings.Save (This) + This.oSettings = .Null. + ENDPROC + + PROCEDURE getactiveplugin + Lparameters lcPlugIn + Local laFiles[1], lcFileName, lcResultFile, lnCount, lnI + + If Plugins.OldStyle + Return _oPEMEditor.oUtils.GetPlugInPath(Trim(lcPlugIn)) + Else + lnCount = Alines(laFiles, Alltrim(Plugins.FileNames), 5, ',') + For lnI = 1 To lnCount + lcFileName = laFiles[lnI] + If File(lcFileName) + Return lcFileName + Else + lcResultFile = Execscript(_Screen.cThorDispatcher, 'Full Path=' + lcFileName) + If File(lcResultFile) + Return lcResultFile + Endif + Endif + Endfor + Return .F. + Endif && Plugins.OldStyle + + + ENDPROC + + PROCEDURE Init + Lparameters tcPlugIns + + Local loSettings + + Thisform.AddPluginsToCursor() + If Not Empty(tcPlugIns) + Scan + If Atc(Trim(PlugIn), tcPlugIns) = 0 + Delete + Endif + Endscan + Endif + Goto Top + + * ThorFormSettings home page = http://vfpx.codeplex.com/wikipage?title=Thor%20Framework%20FormSettings + loSettings = Execscript (_Screen.cThorDispatcher, 'Class= ThorFormSettings', Thisform) + Thisform.AddProperty ('oSettings', loSettings) + loSettings.Restore (Thisform) && Gets top, left, height, width + + + ENDPROC + + PROCEDURE Load + * Set up the environment. + + Set Deleted On + Set Exact Off + Set Exclusive Off + Set Multilocks On + Set Safety Off + Set Talk Off + Sys(3054, 0) + + Local lcPlugInPRGFile, loThorInfo + + loThorInfo = Execscript(_Screen.cThorDispatcher, 'ToolInfo=', 'Thor_Tool_PEME_GoToDefinition') + This.cHomeFolder = Addbs(loThorInfo.FolderName) + lcPlugInPRGFile = This.cHomeFolder + 'Tables\PlugInPRGs' + + Select *, ; + .T. As OldStyle, ; + Cast('' As M) As DefaultFileName, ; + Cast('' As M) As DefaultFileContents ; + From(lcPlugInPRGFile) ; + Order By Order ; + Into Cursor PlugIns Readwrite + + Index On Source Tag Source + Index On PlugIn Tag PlugIn + Return + + + ENDPROC + + PROCEDURE openplugin + Local lcClipText, lcDestFile, lcFile, lcMyToolsFolder, lcPlugIn, lcProcsFolder, lcSourceFile + Local lcToolFolder + + lcPlugIn = Trim(PlugIns.PlugIn) + lcFile = Transform(This.GetActivePlugIn(lcPlugIn)) + lcToolFolder = Execscript(_Screen.cThorDispatcher, 'Tool Folder=') + lcProcsFolder = lcToolFolder + 'Procs' + lcMyToolsFolder = lcToolFolder + 'My Tools' + lcDestFile = Forcepath(lcFile, lcMyToolsFolder) + + Do Case + Case File(lcDestFile) + _oPEMEditor.oUtils.EditSourceX(lcDestFile) + + Case (Upper(lcFile) == Upper(Forcepath(lcFile, lcToolFolder)) ; + Or Upper(lcFile) == Upper(Forcepath(lcFile, lcProcsFolder))) ; + And Empty(PlugIns.DefaultFileContents) + lcClipText = Filetostr(lcFile) + This.CreateFile(lcDestFile, lcClipText) + + Case PlugIns.OldStyle + lcDestFile = Forcepath(Forceext('PEME_' + lcPlugIn, 'prg'), lcToolFolder + 'My Tools\') + lcSourceFile = This.cHomeFolder + Trim(PlugIns.Folder) + '\' + Forceext(PlugIns.PlugIn, 'prg') + lcClipText = Filetostr(lcSourceFile) + + This.CreateFile(lcDestFile, lcClipText) + + Otherwise + lcDestFile = Alltrim(PlugIns.DefaultFileName) + If '*' $ lcDestFile + lcDestFile = Forcepath(Strtran(lcDestFile, '*', ''), lcMyToolsFolder) + Endif + lcClipText = PlugIns.DefaultFileContents + + This.CreateFile(lcDestFile, lcClipText) + + Endcase + + ENDPROC + + PROCEDURE setactioncaption + Local lcPlugIn, lcPlugInFileName, lcPlugInPath, loCmdButton + loCmdButton = This.Grid1.Action.cmdAction + lcPlugIn = PlugIns.PlugIn + + With loCmdButton + lcPlugInFileName = Evl(This.GetActivePlugIn(lcPlugIn), '') + lcPlugInPath = Upper(Justpath(lcPlugInFileName)) + + If Empty(lcPlugInFileName) ; + Or lcPlugInPath == This.cToolsFolder ; + Or lcPlugInPath == This.cProcFolder + .Caption = 'Create' + .ForeColor = Rgb(255, 0, 0) + Else + .Caption = 'Edit' + .ForeColor = Rgb(0, 0, 255) + Endif + Endwith + ENDPROC + + PROCEDURE Grid1.Action.cmdAction.Click + Thisform.OpenPlugIn() + + ENDPROC + + PROCEDURE lblLink.Click + Local lcHomePage, loLink + lcHomePage = 'http://vfpx.codeplex.com/wikipage?title=PlugIns' + loLink = Newobject('_ShellExecute', Home() + 'FFC\_Environ.vcx') + loLink.ShellExecute(lcHomePage) + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/Tables/hotkeydefinitions.db2 b/Thor/Source/Tables/hotkeydefinitions.db2 new file mode 100644 index 00000000..46424e1e --- /dev/null +++ b/Thor/Source/Tables/hotkeydefinitions.db2 @@ -0,0 +1,1046 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="hotkeydefinitions.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000031 + Visual FoxPro, autoincrement enabled + + + + ID + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 114 + 1 + + + NKEYCODE + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + NSHIFTS + N + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + DESCRIPT + C + 40 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + FKYVALUE + C + 2 + 0 + .F. + .T. + + + + + + + + + + + 0 + 0 + + + + + HOTKEYDEFINITIONS.CDX + + + + ID + REGULAR + ID + + ASCENDING + MACHINE + + + + + + + + + 1 + 123 + 0 + F12 + hgE= + + + + 2 + 117 + 0 + F6 + QAE= + + + + 3 + 116 + 0 + F5 + PwE= + + + + 4 + 118 + 0 + F7 + QQE= + + + + 5 + 119 + 0 + F8 + QgE= + + + + 6 + 122 + 0 + F11 + hQE= + + + + 7 + 79 + 6 + Ctrl-Alt-O + GGE= + + + + 8 + 67 + 6 + Ctrl-Alt-C + LmE= + + + + 9 + 72 + 3 + Shift-Ctrl-H + CDA= + + + + 10 + 120 + 2 + Ctrl-F9 + ZiE= + + + + 11 + 69 + 3 + Shift-Ctrl-E + BTA= + + + + 12 + 86 + 3 + Shift-Ctrl-V + FjA= + + + + 13 + 67 + 3 + Shift-Ctrl-C + AzA= + + + + 14 + 77 + 3 + Shift-Ctrl-M + DTA= + + + + 15 + 79 + 3 + Shift-Ctrl-O + DzA= + + + + 16 + 77 + 6 + Ctrl-Alt-M + MmE= + + + + 17 + 87 + 6 + Ctrl-Alt-W + EWE= + + + + 18 + 119 + 1 + Shift-F8 + WxE= + + + + 19 + 89 + 4 + Alt-Y + FUE= + + + + 20 + 90 + 4 + Alt-Z + LEE= + + + + 21 + 88 + 2 + Ctrl-X + GCA= + + + + 22 + 117 + 1 + Shift-F6 + WRE= + + + + 23 + 117 + 3 + Shift-Ctrl-F6 + YzE= + + + + 24 + 80 + 3 + Shift-Ctrl-P + EDA= + + + + 25 + 90 + 3 + Shift-Ctrl-Z + GjA= + + + + 26 + 117 + 2 + Ctrl-F6 + YyE= + + + + 27 + 116 + 2 + Ctrl-F5 + YiE= + + + + 28 + 70 + 3 + Shift-Ctrl-F + BjA= + + + + 29 + 71 + 3 + Shift-Ctrl-G + BzA= + + + + 30 + 71 + 2 + Ctrl-G + ByA= + + + + 31 + 88 + 4 + Alt-X + LUE= + + + + 32 + 67 + 4 + Alt-C + LkE= + + + + 33 + 116 + 1 + Shift-F5 + WBE= + + + + 34 + 81 + 2 + Ctrl-Q + ESA= + + + + 35 + 87 + 3 + Shift-Ctrl-W + FzA= + + + + 36 + 84 + 3 + Shift-Ctrl-T + FDA= + + + + 37 + 119 + 2 + Ctrl-F8 + ZSE= + + + + 38 + 89 + 3 + Shift-Ctrl-Y + GTA= + + + + 39 + 123 + 3 + Shift-Ctrl-F12 + ijE= + + + + 40 + 120 + 4 + Alt-F9 + cEE= + + + + 41 + 71 + 5 + Shift-Alt-G + IlE= + + + + 42 + 74 + 5 + Shift-Alt-J + JFE= + + + + 43 + 122 + 1 + Shift-F11 + hxE= + + + + 44 + 80 + 5 + Shift-Alt-P + GVE= + + + + 45 + 88 + 5 + Shift-Alt-X + LVE= + + + + 46 + 90 + 5 + Shift-Alt-Z + LFE= + + + + 47 + 118 + 1 + Shift-F7 + WhE= + + + + 48 + 118 + 2 + Ctrl-F7 + ZCE= + + + + 49 + 118 + 4 + Alt-F7 + bkE= + + + + 50 + 69 + 5 + Shift-Alt-E + ElE= + + + + 51 + 85 + 3 + Shift-Ctrl-U + FTA= + + + + 52 + 75 + 5 + Shift-Alt-K + JVE= + + + + 53 + 73 + 5 + Shift-Alt-I + F1E= + + + + 54 + 85 + 4 + Alt-U + FkE= + + + + 55 + 85 + 5 + Shift-Alt-U + FlE= + + + + 56 + 120 + 1 + Shift-F9 + XBE= + + + + 57 + 121 + 0 + F10 + RAE= + + + + 58 + 121 + 2 + Ctrl-F10 + ZyE= + + + + 59 + 69 + 6 + Ctrl-Alt-E + EmE= + + + + 60 + 116 + 4 + Alt-F5 + bEE= + + + + 61 + 116 + 3 + Shift-Ctrl-F5 + YjE= + + + + 62 + 116 + 5 + Shift-Alt-F5 + bFE= + + + + 63 + 70 + 6 + Ctrl-Alt-F + IWE= + + + + 64 + 77 + 7 + Shift-Ctrl-Alt-M + MnE= + + + + 65 + 82 + 3 + Shift-Ctrl-R + EjA= + + + + 66 + 88 + 3 + Shift-Ctrl-X + GDA= + + + + 67 + 90 + 6 + Ctrl-Alt-Z + LGE= + + + + 68 + 79 + 2 + Ctrl-O + DyA= + + + + 69 + 79 + 5 + Shift-Alt-O + GFE= + + + + 70 + 67 + 5 + Shift-Alt-C + LlE= + + + + 71 + 70 + 5 + Shift-Alt-F + IVE= + + + + 72 + 77 + 5 + Shift-Alt-M + MlE= + + + + 73 + 71 + 6 + Ctrl-Alt-G + ImE= + + + + 74 + 72 + 6 + Ctrl-Alt-H + I2E= + + + + 75 + 83 + 6 + Ctrl-Alt-S + H2E= + + + + 76 + 83 + 5 + Shift-Alt-S + H1E= + + + + 77 + 73 + 6 + Ctrl-Alt-I + F2E= + + + + 78 + 118 + 6 + Ctrl-Alt-F7 + bmE= + + + + 79 + 113 + 1 + Shift-F2 + VRE= + + + + 80 + 70 + 4 + Alt-F + IUE= + + + + 81 + 113 + 6 + Ctrl-Alt-F2 + aWE= + + + + 82 + 69 + 4 + Alt-E + EkE= + + + + 83 + 69 + 2 + Ctrl-E + BSA= + + + + 84 + 84 + 2 + Ctrl-T + FCA= + + + + 85 + 84 + 4 + Alt-T + FEE= + + + + 86 + 89 + 6 + Ctrl-Alt-Y + FWE= + + + + 87 + 89 + 5 + Shift-Alt-Y + FVE= + + + + 88 + 77 + 2 + Ctrl-M + DSA= + + + + 89 + 87 + 4 + Alt-W + EUE= + + + + 90 + 119 + 6 + Ctrl-Alt-F8 + b2E= + + + + 91 + 119 + 4 + Alt-F8 + b0E= + + + + 92 + 84 + 6 + Ctrl-Alt-T + FGE= + + + + 93 + 117 + 6 + Ctrl-Alt-F6 + bWE= + + + + 94 + 74 + 2 + Ctrl-J + CiA= + + + + 95 + 7777 + 2 + Ctrl-H + fyA= + + + + 96 + 80 + 2 + Ctrl-P + ECA= + + + + 97 + 75 + 2 + Ctrl-K + CyA= + + + + 98 + 73 + 2 + Ctrl-I + CSA= + + + + 99 + 76 + 2 + Ctrl-L + DCA= + + + + 100 + 85 + 6 + Ctrl-Alt-U + FmE= + + + + 101 + 72 + 2 + Ctrl-H + CCA= + + + + 102 + 76 + 3 + Shift-Ctrl-L + DDA= + + + + 103 + 120 + 6 + Ctrl-Alt-F9 + cGE= + + + + 104 + 122 + 6 + Ctrl-Alt-F11 + i2E= + + + + 105 + 123 + 6 + Ctrl-Alt-F12 + jGE= + + + + 106 + 82 + 2 + Ctrl-R + EiA= + + + + 107 + 82 + 5 + Shift-Alt-R + E1E= + + + + 108 + 114 + 6 + Ctrl-Alt-F3 + amE= + + + + 109 + 81 + 3 + Shift-Ctrl-Q + ETA= + + + + 110 + 114 + 3 + Shift-Ctrl-F3 + YDE= + + + + 111 + 115 + 3 + Shift-Ctrl-F4 + YTE= + + + + 112 + 118 + 3 + Shift-Ctrl-F7 + ZDE= + + + + 113 + 119 + 3 + Shift-Ctrl-F8 + ZTE= + + + + + +
+ diff --git a/Thor/Source/Tables/logfile.db2 b/Thor/Source/Tables/logfile.db2 new file mode 100644 index 00000000..bf522659 --- /dev/null +++ b/Thor/Source/Tables/logfile.db2 @@ -0,0 +1,2344 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="logfile.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000030 + Visual FoxPro + + + + PRGNAME + C + 60 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + POSTED + T + 8 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + UPLOADED + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + + + + + PEMEditor_StartIDETools + 2011/09/23 13:44:47 + .F. + + + + PEMEditor_StartIDETools + 2011/09/23 13:44:47 + .F. + + + + Thor_Tool_Repository_CYCLEDESIGNERWINDOWS.PRG + 2011/09/23 13:44:47 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/09/23 14:48:36 + .F. + + + + Thor_Tool_ThorInternalEdit.PRG + 2011/09/24 12:46:54 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/09/24 12:47:50 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 12:49:23 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/09/24 12:49:23 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 12:50:24 + .F. + + + + Thor_Tool_PEME_DynamicSnippets.PRG + 2011/09/24 12:50:24 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 12:51:15 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/09/24 12:51:15 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 12:52:02 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/09/24 12:52:03 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 12:52:11 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 12:52:24 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 12:53:40 + .F. + + + + Thor_Tool_ThorInternalEdit.PRG + 2011/09/24 12:54:14 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 13:06:17 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/09/24 13:06:18 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 13:08:30 + .F. + + + + Thor_Tool_PEME_DynamicSnippets.PRG + 2011/09/24 13:08:30 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/09/24 13:17:00 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 13:19:18 + .F. + + + + Thor_Tool_PEME_ClosePEMEditorforms.PRG + 2011/09/24 13:19:19 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 13:19:22 + .F. + + + + PEMEditor_StartIDETools + 2011/09/24 13:19:35 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/09/24 13:19:47 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/09/25 12:30:35 + .F. + + + + PEMEditor_StartIDETools + 2011/09/25 12:33:46 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/09/25 12:33:46 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/09/25 12:34:29 + .F. + + + + PEMEditor_StartIDETools + 2011/10/01 08:54:19 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/01 08:54:19 + .F. + + + + PEMEditor_StartIDETools + 2011/10/01 09:27:30 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/01 09:27:30 + .F. + + + + PEMEditor_StartIDETools + 2011/10/01 11:28:16 + .F. + + + + Thor_Tool_PEME_ClosePEMEditorforms.PRG + 2011/10/01 11:28:16 + .F. + + + + PEMEditor_StartIDETools + 2011/10/01 11:31:17 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/01 11:31:17 + .F. + + + + Thor_Tool_GetPixel.PRG + 2011/10/01 11:33:40 + .F. + + + + PEMEditor_StartIDETools + 2011/10/01 11:36:27 + .F. + + + + Thor_Tool_PEME_OpenMRUS.PRG + 2011/10/01 11:36:31 + .F. + + + + PEMEditor_StartIDETools + 2011/10/01 11:47:33 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/01 11:47:33 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/01 12:41:01 + .F. + + + + PEMEditor_StartIDETools + 2011/10/01 14:16:46 + .F. + + + + Thor_Tool_PEME_DynamicSnippets.PRG + 2011/10/01 14:16:46 + .F. + + + + PEMEditor_StartIDETools + 2011/10/01 16:36:54 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/01 16:36:55 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:06:12 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/02 07:06:13 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:12:24 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/02 07:12:25 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:13:28 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/02 07:13:28 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:14:04 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/02 07:14:04 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/02 07:18:59 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:28:13 + .F. + + + + Thor_Tool_OpenProject.PRG + 2011/10/02 07:28:13 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/02 07:28:23 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:29:06 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/02 07:29:07 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:31:53 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:31:57 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/02 07:31:57 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:32:39 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/02 07:32:40 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:33:42 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/02 07:33:43 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:34:44 + .F. + + + + Thor_Tool_PEME_Closeallmethodwindows.PRG + 2011/10/02 07:34:44 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:35:32 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/02 07:35:34 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:35:52 + .F. + + + + Thor_Tool_PEME_EndControlStructure.PRG + 2011/10/02 07:35:52 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:36:20 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/02 07:36:21 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:38:39 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/02 07:38:39 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:38:46 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 07:38:53 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/02 07:38:54 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 17:09:34 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 17:09:34 + .F. + + + + Thor_Tool_Repository_RESIZEDESIGNER.PRG + 2011/10/02 17:09:34 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 17:58:25 + .F. + + + + Thor_Tool_PEME_OpenMRUS.PRG + 2011/10/02 17:58:29 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 20:04:52 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/02 20:04:52 + .F. + + + + PEMEditor_StartIDETools + 2011/10/02 20:13:54 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/02 20:13:54 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/02 21:04:29 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:36:57 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/03 06:36:58 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:37:30 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/03 06:37:30 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:38:26 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:38:37 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:38:37 + .F. + + + + THOR_TOOL_REPOSITORY_HACKCX_MRUS.PRG + 2011/10/03 06:38:47 + .F. + + + + Thor_Tool_ThorInternalRepository.PRG + 2011/10/03 06:38:47 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:38:53 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:38:57 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:38:57 + .F. + + + + THOR_TOOL_REPOSITORY_HACKCX_MRUS.PRG + 2011/10/03 06:39:00 + .F. + + + + Thor_Tool_ThorInternalRepository.PRG + 2011/10/03 06:39:00 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:39:17 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:39:20 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:39:20 + .F. + + + + THOR_TOOL_REPOSITORY_HACKCX_MRUS.PRG + 2011/10/03 06:39:24 + .F. + + + + Thor_Tool_ThorInternalRepository.PRG + 2011/10/03 06:39:24 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 06:55:39 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/03 06:55:39 + .F. + + + + Thor_Tool_PEME_OpenClass.PRG + 2011/10/03 07:31:34 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 07:31:34 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/03 14:19:15 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 14:19:15 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 16:25:19 + .F. + + + + Thor_Tool_PEME_EditParentClass.PRG + 2011/10/03 16:25:24 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 16:25:25 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/03 16:27:25 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 16:27:25 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/03 16:29:09 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 16:29:09 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/03 16:40:47 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 16:40:47 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/03 16:43:05 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 16:43:05 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/03 17:10:56 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/03 17:17:26 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/03 17:24:24 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/03 17:47:47 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 17:47:47 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/03 18:06:36 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 18:06:36 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/03 18:07:23 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 18:07:23 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/03 18:07:56 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 18:07:56 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/03 18:22:46 + .F. + + + + PEMEditor_StartIDETools + 2011/10/03 18:22:46 + .F. + + + + Thor_Tool_ThorInternalHelp.PRG + 2011/10/04 05:42:52 + .F. + + + + Thor_Tool_OpenProject.PRG + 2011/10/04 06:19:37 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 06:19:37 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/04 06:19:40 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 06:22:47 + .F. + + + + Thor_Tool_OpenProject.PRG + 2011/10/04 06:28:39 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 06:28:39 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/04 06:28:42 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/04 06:37:47 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/04 06:56:04 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 06:56:04 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/04 07:03:12 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 07:03:12 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 07:20:21 + .F. + + + + Thor_Tool_PEME_Copyforcomparingandpasting.PRG + 2011/10/04 07:20:26 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 07:20:26 + .F. + + + + Thor_Tool_PEME_Copyforcomparingandpasting.PRG + 2011/10/04 07:21:19 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 07:21:19 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/04 07:37:38 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 07:37:38 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/04 07:41:11 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 07:41:11 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/04 12:01:12 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 12:01:12 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/04 12:17:51 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 12:17:51 + .F. + + + + Thor_Tool_PEME_DynamicSnippets.PRG + 2011/10/04 12:18:09 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 12:18:09 + .F. + + + + Thor_Tool_PEME_DynamicSnippets.PRG + 2011/10/04 13:08:13 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:08:13 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/04 13:08:30 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:08:30 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/04 13:08:44 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:08:44 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/04 13:08:55 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:08:55 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:11:48 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:11:55 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/04 13:14:00 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:14:00 + .F. + + + + Thor_Tool_PEME_Back.PRG + 2011/10/04 13:15:16 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:15:16 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/04 13:15:17 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:15:17 + .F. + + + + Thor_Tool_PEME_Back.PRG + 2011/10/04 13:15:20 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:15:20 + .F. + + + + Thor_Tool_PEME_Back.PRG + 2011/10/04 13:15:21 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:15:21 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/04 13:15:22 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 13:15:22 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 13:19:59 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 14:19:01 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 14:35:39 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 14:41:34 + .F. + + + + Thor_Tool_OpenProject.PRG + 2011/10/04 14:41:51 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 14:41:51 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/04 14:42:08 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 14:43:08 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/04 14:47:40 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 14:47:40 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/04 14:47:48 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 14:47:48 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 14:48:07 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/04 14:49:26 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 14:49:26 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 14:50:30 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/04 14:54:31 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 14:54:31 + .F. + + + + Thor_Tool_PEME_ChangeParentClass.PRG + 2011/10/04 14:55:18 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 14:55:18 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 14:58:39 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 15:02:00 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/04 15:06:08 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 15:06:59 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/04 15:08:08 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 15:08:08 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 15:08:19 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 15:30:11 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/04 15:32:32 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 15:32:32 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 15:32:47 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/04 15:33:49 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 15:33:49 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 15:35:53 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 15:38:04 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 16:00:50 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 16:02:09 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 18:01:20 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 18:01:47 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 18:02:10 + .F. + + + + Thor_Tool_OpenProject.PRG + 2011/10/04 19:39:32 + .F. + + + + PEMEditor_StartIDETools + 2011/10/04 19:39:32 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/04 19:39:49 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 19:42:09 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 19:45:25 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 20:07:14 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 20:08:25 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 20:10:58 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/04 20:12:55 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/05 13:13:23 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/05 13:15:06 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/05 13:18:02 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/05 14:58:07 + .F. + + + + PEMEditor_StartIDETools + 2011/10/05 14:58:14 + .F. + + + + PEMEditor_StartIDETools + 2011/10/05 14:58:19 + .F. + + + + Thor_Tool_PEME_CrossRefThismethod.PRG + 2011/10/05 15:03:59 + .F. + + + + PEMEditor_StartIDETools + 2011/10/05 15:03:59 + .F. + + + + PEMEditor_StartIDETools + 2011/10/05 15:04:37 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/08 05:49:11 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/08 05:50:18 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/08 07:27:10 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 06:07:26 + .F. + + + + Thor_Tool_ThorInternalEdit.PRG + 2011/10/10 06:07:30 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 06:09:04 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 06:32:24 + .F. + + + + Thor_Tool_ThorInternalEdit.PRG + 2011/10/10 06:32:27 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 06:33:06 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 06:33:47 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 06:35:58 + .F. + + + + PEMEditor_StartIDETools + 2011/10/10 07:07:51 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 07:12:27 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 07:13:04 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 07:13:47 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 08:01:03 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 08:02:21 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/10 08:05:45 + .F. + + + + PEMEditor_StartIDETools + 2011/10/10 08:05:45 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 10:51:50 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/10 11:03:47 + .F. + + + + Thor_Tool_PEME_GoToDefinition.PRG + 2011/10/10 11:06:17 + .F. + + + + PEMEditor_StartIDETools + 2011/10/10 11:06:17 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 11:13:05 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/10 11:36:18 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/10 11:36:22 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/12 07:01:20 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/12 07:01:28 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/12 07:25:51 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/12 07:28:11 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/12 07:29:39 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/12 07:38:24 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/12 07:38:30 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/12 07:39:29 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/12 07:39:32 + .F. + + + + Thor_Tool_PEME_LaunchPEMEditor.PRG + 2011/10/12 07:41:11 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 07:41:11 + .F. + + + + Thor_Tool_PEME_Copyforcomparingandpasting.PRG + 2011/10/12 07:41:43 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 07:41:43 + .F. + + + + Thor_Tool_PEME_Pastepropertiesandmethodcode.PRG + 2011/10/12 07:42:57 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 07:42:57 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/12 07:50:36 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 07:50:36 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/12 08:04:20 + .F. + + + + Thor_Tool_PEME_Copyforcomparingandpasting.PRG + 2011/10/12 08:05:48 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 08:05:48 + .F. + + + + Thor_Tool_PEME_Pastepropertiesandmethodcode.PRG + 2011/10/12 08:06:07 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 08:06:07 + .F. + + + + Thor_Tool_PEME_Copyforcomparingandpasting.PRG + 2011/10/12 08:10:59 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 08:10:59 + .F. + + + + Thor_Tool_PEME_Pastepropertiesandmethodcode.PRG + 2011/10/12 08:11:18 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 08:11:18 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/12 08:13:18 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 08:13:18 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/12 08:13:46 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 08:13:46 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/12 08:15:15 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/12 21:14:44 + .F. + + + + Thor_Tool_Repository_Show_Classlibs.prg + 2011/10/12 21:14:58 + .F. + + + + Thor_Tool_Repository_Show_Path.prg + 2011/10/12 21:15:11 + .F. + + + + PEMEditor_StartIDETools + 2011/10/12 21:15:39 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/13 07:10:39 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/13 07:10:47 + .F. + + + + Thor_Tool_ThorInternalEdit.PRG + 2011/10/13 07:11:22 + .F. + + + + Thor_Tool_PEME_DynamicSnippets.PRG + 2011/10/13 07:12:10 + .F. + + + + PEMEditor_StartIDETools + 2011/10/13 07:12:10 + .F. + + + + Thor_Tool_PEME_MoveResizeWindow.PRG + 2011/10/13 07:15:41 + .F. + + + + PEMEditor_StartIDETools + 2011/10/13 07:15:41 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/13 07:18:55 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/13 07:18:58 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/13 07:20:26 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/13 07:20:30 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/13 07:21:57 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/13 07:21:59 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/13 07:22:51 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/13 07:22:53 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/13 07:39:57 + .F. + + + + Thor_Tool_ThorInternalFrameWork.PRG + 2011/10/13 07:40:00 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/14 07:56:00 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/14 07:56:06 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/14 18:40:49 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 08:06:59 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/15 08:07:46 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 08:10:50 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/15 08:11:00 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 08:12:11 + .F. + + + + Thor_Tool_GoFish4.PRG + 2011/10/15 08:12:14 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 08:27:54 + .F. + + + + Thor_Tool_PEME_GoToDefinition.PRG + 2011/10/15 08:31:18 + .F. + + + + PEMEditor_StartIDETools + 2011/10/15 08:31:18 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 08:42:37 + .F. + + + + Thor_Tool_ThorInternalRepositoryHomePage.PRG + 2011/10/15 08:42:46 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 08:44:09 + .F. + + + + Thor_Tool_ThorInternalRepositoryHomePage.PRG + 2011/10/15 08:44:16 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 08:47:41 + .F. + + + + Thor_Tool_ThorInternalRepositoryHomePage.PRG + 2011/10/15 08:47:45 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/15 08:50:00 + .F. + + + + PEMEditor_StartIDETools + 2011/10/15 08:50:00 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 08:50:46 + .F. + + + + PEMEditor_StartIDETools + 2011/10/15 08:52:08 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 22:01:18 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 22:01:26 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/15 22:02:35 + .F. + + + + Thor_Tool_sssssssaaa.PRG + 2011/10/18 08:04:23 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/18 08:08:34 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:08:34 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/18 08:10:26 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:10:26 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/18 08:10:46 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:10:46 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/18 08:10:54 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:10:54 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/18 08:11:57 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:11:57 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/18 08:13:08 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:13:08 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/18 08:13:48 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:13:48 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:24:41 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/18 08:27:05 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:27:05 + .F. + + + + Thor_Tool_PEME_EnhancedCut.PRG + 2011/10/18 08:35:48 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:35:48 + .F. + + + + Thor_Tool_PEME_BeautifyX.PRG + 2011/10/18 08:38:36 + .F. + + + + PEMEditor_StartIDETools + 2011/10/18 08:38:36 + .F. + + + + + +
+ diff --git a/Thor/Source/Tables/menudefinitions.db2 b/Thor/Source/Tables/menudefinitions.db2 new file mode 100644 index 00000000..781caf48 --- /dev/null +++ b/Thor/Source/Tables/menudefinitions.db2 @@ -0,0 +1,552 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="menudefinitions.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000031 + Visual FoxPro, autoincrement enabled + + + + ID + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 28 + 1 + + + PROMPT + C + 60 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + INTERNAL + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + TOPLEVEL + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + POPUP + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + POPUPNAME + C + 20 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SORTORDER + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + HOTKEYID + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + STATUSBAR + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + MENUDEFINITIONS.CDX + + + + HOTKEYID + REGULAR + HOTKEYID + + ASCENDING + MACHINE + + + ID + REGULAR + ID + + ASCENDING + MACHINE + + + SORTORDER + REGULAR + SORTORDER + + ASCENDING + MACHINE + + + + + + + + + 1 + File + .T. + .T. + .F. + _mFile + 3 + 0 + + + + + 2 + Edit + .T. + .T. + .F. + _mEdit + 4 + 0 + + + + + 3 + View + .T. + .T. + .F. + _mView + 5 + 0 + + + + + 4 + Tools + .T. + .T. + .F. + _mTools + 6 + 0 + + + + + 5 + Program + .T. + .T. + .F. + _mProg + 8 + 0 + + + + + 6 + Window + .T. + .T. + .F. + _mWindow + 9 + 0 + + + + + 7 + Help + .T. + .T. + .F. + _mSystem + 10 + 0 + + + + + 8 + Tho\<r + .F. + .T. + .F. + Thor_Internal + 1 + 0 + + + + + 9 + IDE Tools + .F. + .T. + .F. + PEME_Main + 2 + 0 + + + + + 10 + Enhanced Cut / Copy + .F. + .F. + .F. + PEME_Enhanced_Cut + 0 + 0 + + + + + 11 + Control Structures + .F. + .F. + .F. + PEME_Control_Struct + 0 + 0 + + + + + 12 + Cross References + .F. + .F. + .F. + PEME_CrossRefs + 0 + 0 + + + + + 13 + Copy / Paste + .F. + .F. + .T. + PEME_Copy_Paste + 10 + 100 + + + + + 14 + Parent Classes + .F. + .F. + .T. + PEME_Parent_Classes + 0 + 24 + + + + + 15 + Open files, favorites, MRUs + .F. + .F. + .T. + PEME_Open_Files + 0 + 69 + + + + + 16 + Window Manipulation + .F. + .F. + .F. + PEME_Windows + 11 + 0 + + + + + 17 + PEM Editor forms + .F. + .F. + .F. + PEME_Forms + 0 + 0 + + + + + 18 + Code Listings + .F. + .F. + .F. + PEME_Code_List + 0 + 0 + + + + + 19 + This Control + .F. + .F. + .F. + PEME_Code_This + 0 + 0 + + + + + 20 + This Control and Children + .F. + .F. + .F. + PEME_Code_Children + 0 + 0 + + + + + 21 + Auto Rename Controls + .F. + .F. + .F. + PEME_Auto_Rename + 0 + 0 + + + + + 22 + JRN + .F. + .T. + .F. + _3820YG6KY + 7 + 0 + + + + + 24 + JJJJJJ + .F. + .F. + .F. + _3B50TXCBV + 0 + 0 + + + + + 25 + JJJJ + .F. + .F. + .F. + _3B50TYWZL + 0 + 0 + + + + + 26 + JJJJJ + .F. + .F. + .F. + _3B50TZ62I + 0 + 0 + + + + + 27 + JJJJJ + .F. + .F. + .T. + _3B50TZXM4 + 0 + 0 + + + + + + +
+ diff --git a/Thor/Source/Tables/menutools.db2 b/Thor/Source/Tables/menutools.db2 new file mode 100644 index 00000000..d6ee8fe2 --- /dev/null +++ b/Thor/Source/Tables/menutools.db2 @@ -0,0 +1,1645 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="menutools.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000031 + Visual FoxPro, autoincrement enabled + + + + ID + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 2806 + 1 + + + MENUID + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + PRGNAME + C + 60 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SUBMENUID + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SEPARATOR + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SORTORDER + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + PROMPT + C + 60 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + STATUSBAR + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + MENUTOOLS.CDX + + + + ID + REGULAR + ID + + ASCENDING + MACHINE + + + MENUID + REGULAR + MENUID + + ASCENDING + MACHINE + + + SORTORDER + REGULAR + SORTORDER + + ASCENDING + MACHINE + + + SUBMENUID + REGULAR + SUBMENUID + + ASCENDING + MACHINE + + + + + + + + + 1 + 8 + Thor_Tool_ThorInternalEdit.PRG + 0 + .F. + 10 + Setup + + + + + 2 + 8 + Thor_Tool_ThorInternalHelp.PRG + 0 + .F. + 60 + Help Home Page + + + + + 3 + 8 + Thor_Tool_ThorInternalAllTools.PRG + 0 + .F. + 20 + Run Tool + + + + + 1796 + 1 + Thor_Tool_GoFish4.PRG + 0 + .F. + 1 + GoFish4: Prompt for the tool + + + + + 1797 + 1 + Thor_Tool_GoFish4.PRG + 0 + .F. + 2 + GoFish4: Prompt for the tool + + + + + 1798 + 1 + Thor_Tool_GoFish4.PRG + 0 + .F. + 3 + GoFish4: Prompt for the tool + + + + + 2247 + 22 + Thor_Tool_GetPixel.PRG + 0 + .F. + 8 + GetPixel + + + + + 2248 + 22 + + 0 + .T. + 4 + \- + + + + + 2249 + 22 + Thor_Tool_Repository_TOGGLECOMMENTCOLORS.PRG + 0 + .F. + 11 + Toggle comment colors + + + + + 2250 + 22 + Thor_Tool_Repository_SHOW_CLASSLIBS.PRG + 0 + .F. + 12 + Display Classlibs + + + + + 2251 + 22 + Thor_Tool_Repository_SHOW_PATH.PRG + 0 + .F. + 13 + Display Path + + + + + 2252 + 22 + Thor_Tool_Repository_HACKCX_MRUS.PRG + 0 + .F. + 10 + HackCX4 from MRU forms or classes + + + + + 2253 + 22 + Thor_Tool_Repository_GOTOMETHOD.PRG + 0 + .F. + 9 + Go To Method + + + + + 2254 + 22 + Thor_Tool_Repository_CREATESQLTABLEFROMCURSOR.PRG + 0 + .F. + 14 + Create SQL from cursor + + + + + 2255 + 22 + Thor_Tool_Repository_MOVEDESIGNERSTOTOP.PRG + 0 + .F. + 6 + Move Designer windows + + + + + 2256 + 22 + Thor_Tool_Repository_RESIZEDESIGNER.PRG + 0 + .F. + 7 + Resize Designer window + + + + + 2257 + 22 + Thor_Tool_WLCListFields.prg + 0 + .F. + 15 + WLC Column Listing Utility + + + + + 2259 + 22 + Thor_Tool_Repository_CYCLEDESIGNERWINDOWS.PRG + 0 + .F. + 5 + Cycle thru Designer windows + + + + + 2471 + 22 + Thor_Tool_GoToPemEditor.PRG + 0 + .F. + 1 + Go To PEMEditor + + + + + 2472 + 22 + Thor_Tool_gotoThor.PRG + 0 + .F. + 2 + Go To Thor + + + + + 2473 + 22 + THOR_TOOL_SETREVISIONDATE.PRG + 0 + .F. + 3 + Sets the revision date + + + + + 2698 + 8 + Thor_Tool_ThorInternalFrameWork.PRG + 0 + .F. + 90 + Thor Framework + + + + + 2699 + 9 + Thor_Tool_PEME_GoToDefinition.PRG + 0 + .F. + 1 + Go To Definition + + + + + 2700 + 9 + Thor_Tool_PEME_BeautifyX.PRG + 0 + .F. + 2 + BeautifyX + + + + + 2701 + 9 + Thor_Tool_PEME_CreateLOCALs.PRG + 0 + .F. + 3 + Create LOCALs + + + + + 2702 + 9 + Thor_Tool_PEME_ExtractToMethod.PRG + 0 + .F. + 4 + Extract To Method + + + + + 2703 + 9 + + 10 + .F. + 5 + Enhanced Cut / Copy + + + + + 2704 + 9 + + 11 + .F. + 6 + Control Structures + + + + + 2705 + 9 + + 18 + .F. + 7 + Code Listings + + + + + 2706 + 9 + + 12 + .F. + 8 + Cross References + + + + + 2707 + 9 + Thor_Tool_PEME_DynamicSnippets.PRG + 0 + .F. + 9 + Dynamic Snippets + + + + + 2708 + 9 + + 0 + .T. + 10 + \- + + + + + 2709 + 9 + + 13 + .F. + 11 + Copy / Paste + + + + + 2710 + 9 + + 14 + .F. + 12 + Parent Classes + + + + + 2711 + 9 + Thor_Tool_PEME_SetCloseSizeandPosition.PRG + 0 + .F. + 13 + Set Object Size and Position + + + + + 2712 + 9 + + 21 + .F. + 14 + Auto-Rename Object(s) + + + + + 2713 + 9 + Thor_Tool_PEME_FindObjects.PRG + 0 + .F. + 15 + Find Objects + + + + + 2714 + 9 + Thor_Tool_PEME_AddObject.PRG + 0 + .F. + 16 + Add Object + + + + + 2715 + 9 + + 0 + .T. + 17 + \- + + + + + 2716 + 9 + + 15 + .F. + 18 + Open files, favorites, MRUs + + + + + 2717 + 9 + + 16 + .F. + 19 + Window Manipulation + + + + + 2718 + 9 + + 17 + .F. + 20 + PEM Editor forms + + + + + 2719 + 9 + + 0 + .T. + 21 + \- + + + + + 2720 + 9 + Thor_Tool_PEME_EditHotKeysPreferences.PRG + 0 + .F. + 22 + Edit Preferences for IDE Tools + + + + + 2721 + 9 + Thor_Tool_PEME_Help.PRG + 0 + .F. + 23 + Help + + + + + 2722 + 10 + Thor_Tool_PEME_EnhancedCut.PRG + 0 + .F. + 1 + Enhanced Cut + + + + + 2723 + 10 + Thor_Tool_PEME_EnhancedCopy.PRG + 0 + .F. + 2 + Enhanced Copy + + + + + 2724 + 10 + Thor_Tool_PEME_EnhancedCutAdditive.PRG + 0 + .F. + 3 + Enhanced Cut / Additive + + + + + 2725 + 10 + Thor_Tool_PEME_EnhancedCopyAdditive.PRG + 0 + .F. + 4 + Enhanced Copy / Additive + + + + + 2726 + 11 + Thor_Tool_PEME_HighlightControlStructure.PRG + 0 + .F. + 1 + Highlight Control Structure + + + + + 2727 + 11 + Thor_Tool_PEME_EndControlStructure.PRG + 0 + .F. + 2 + Close Control Structure + + + + + 2728 + 12 + Thor_Tool_PEME_CrossRefThismethod.PRG + 0 + .F. + 1 + This method + + + + + 2729 + 12 + + 0 + .T. + 2 + \- + + + + + 2730 + 12 + Thor_Tool_PEME_CrossRefThisform.PRG + 0 + .F. + 3 + This form/class + + + + + 2731 + 12 + Thor_Tool_PEME_CrossRefThisformChildren.PRG + 0 + .F. + 4 + This form/class and children + + + + + 2732 + 12 + + 0 + .T. + 5 + \- + + + + + 2733 + 12 + Thor_Tool_PEME_CrossRefCurrentobject.PRG + 0 + .F. + 6 + Current object + + + + + 2734 + 12 + Thor_Tool_PEME_CrossRefCurrentobjectChildren.PRG + 0 + .F. + 7 + Current object and children + + + + + 2735 + 13 + Thor_Tool_PEME_Copyforcomparingandpasting.PRG + 0 + .F. + 1 + Copy (for comparing and pasting) + + + + + 2736 + 13 + Thor_Tool_PEME_Copyfullobjectnametoclipboard.PRG + 0 + .F. + 2 + Copy object name to clipboard + + + + + 2737 + 13 + + 0 + .T. + 3 + \- + + + + + 2738 + 13 + Thor_Tool_PEME_Comparewithcopiedobject.PRG + 0 + .F. + 4 + Compare with copied object + + + + + 2739 + 13 + Thor_Tool_PEME_Pastepropertiesandmethodcode.PRG + 0 + .F. + 5 + Paste properties and method code + + + + + 2740 + 13 + Thor_Tool_PEME_Pasteobject.PRG + 0 + .F. + 6 + Paste object + + + + + 2741 + 14 + Thor_Tool_PEME_ComparewithParentClass.PRG + 0 + .F. + 1 + Compare with Parent Class + + + + + 2742 + 14 + Thor_Tool_PEME_EditParentClass.PRG + 0 + .F. + 2 + Edit Parent Class + + + + + 2743 + 14 + Thor_Tool_PEME_ChangeParentClass.PRG + 0 + .F. + 3 + Change Parent Class + + + + + 2744 + 15 + Thor_Tool_PEME_OpenClass.PRG + 0 + .F. + 1 + Open Classes + + + + + 2745 + 15 + Thor_Tool_PEME_OpenForm.PRG + 0 + .F. + 2 + Open Forms + + + + + 2746 + 15 + Thor_Tool_PEME_OpenProject.PRG + 0 + .F. + 3 + Open Projects + + + + + 2747 + 15 + Thor_Tool_PEME_OpenFiles.PRG + 0 + .F. + 4 + Open Files + + + + + 2748 + 15 + Thor_Tool_PEME_OpenFavorites.PRG + 0 + .F. + 5 + Favorites + + + + + 2749 + 15 + Thor_Tool_PEME_OpenMRUS.PRG + 0 + .F. + 6 + MRUs + + + + + 2750 + 16 + Thor_Tool_PEME_Back.PRG + 0 + .F. + 1 + Back (previous method) + + + + + 2751 + 16 + Thor_Tool_PEME_Forward.PRG + 0 + .F. + 2 + Forward (next method) + + + + + 2752 + 16 + Thor_Tool_PEME_Closeallmethodwindows.PRG + 0 + .F. + 3 + Close all method windows + + + + + 2753 + 16 + Thor_Tool_PEME_Closeallmethodwindowsbut.PRG + 0 + .F. + 4 + Close all code windows but this one + + + + + 2754 + 16 + Thor_Tool_PEME_MoveResizeWindow.PRG + 0 + .F. + 5 + Move/Resize Window + + + + + 2755 + 16 + + 0 + .T. + 6 + \- + + + + + 2756 + 16 + Thor_Tool_PEME_OpenWindows.PRG + 0 + .F. + 7 + All Open Windows + + + + + 2757 + 17 + Thor_Tool_PEME_LaunchPEMEditor.PRG + 0 + .F. + 1 + Launch / Show PEM Editor + + + + + 2758 + 17 + Thor_Tool_PEME_LaunchDocumentTreeView.PRG + 0 + .F. + 2 + Launch / Show Document TreeView + + + + + 2759 + 17 + Thor_Tool_PEME_FormatSizeandPosition.PRG + 0 + .F. + 3 + Launch / Show Object Size and Position + + + + + 2760 + 17 + + 0 + .T. + 4 + \- + + + + + 2761 + 17 + Thor_Tool_PEME_LaunchClosePEMEditor.PRG + 0 + .F. + 5 + Launch / Close PEM Editor + + + + + 2762 + 17 + Thor_Tool_PEME_LaunchCloseDocumentTreeView.PRG + 0 + .F. + 6 + Launch / Close Document TreeView + + + + + 2763 + 17 + Thor_Tool_PEME_FormatCloseSizeandPosition.PRG + 0 + .F. + 7 + Launch / Close Object Size and Position + + + + + 2764 + 17 + + 0 + .T. + 8 + \- + + + + + 2765 + 17 + Thor_Tool_PEME_ClosePEMEditorforms.PRG + 0 + .F. + 9 + Open / Close PEM Editor forms + + + + + 2766 + 18 + + 19 + .F. + 1 + This Control + + + + + 2767 + 18 + + 20 + .F. + 2 + This Control and Children + + + + + 2768 + 19 + Thor_Tool_PEME_CodeListing00.PRG + 0 + .F. + 1 + All Code + + + + + 2769 + 19 + Thor_Tool_PEME_CodeListing10.PRG + 0 + .F. + 2 + All Code and Inherited Code + + + + + 2770 + 20 + Thor_Tool_PEME_CodeListing01.PRG + 0 + .F. + 1 + All Code + + + + + 2771 + 20 + Thor_Tool_PEME_CodeListing11.PRG + 0 + .F. + 2 + All Code and Inherited Code + + + + + 2772 + 21 + Thor_Tool_PEME_AutoRenameThis.PRG + 0 + .F. + 1 + Selected Object(s) + + + + + 2773 + 21 + Thor_Tool_PEME_AutoRenameChildren.PRG + 0 + .F. + 2 + Selected Object(s) and children + + + + + 2774 + 8 + + 0 + .T. + 50 + Framework + + + + + 2775 + 8 + Thor_Tool_ThorInternalModifyTool.PRG + 0 + .F. + 30 + Modify Tool + + + + + 2776 + 8 + Thor_Tool_ThorInternalToolLink.PRG + 0 + .F. + 40 + Tool Home Page + + + + + 2777 + 27 + Thor_Tool_PEME_FindObjects.PRG + 0 + .F. + 1 + Find Objects + + + + + 2778 + 27 + Thor_Tool_aaaaaaaa.PRG + 0 + .F. + 2 + aaaaaPrompt for the tool + + + + + 2779 + 27 + Thor_Tool_aaaaaaaa.PRG + 0 + .F. + 3 + aaaaaPrompt for the tool + + + + + 2780 + 27 + Thor_Tool_PEME_AddObject.PRG + 0 + .F. + 4 + Add Object + + + + + 2781 + 27 + Thor_Tool_PEME_AddObject.PRG + 0 + .F. + 5 + Add Object + + + + + 2782 + 27 + Thor_Tool_PEME_EnhancedCutAdditive.PRG + 0 + .F. + 6 + Enhanced Cut / Additive + + + + + 2783 + 27 + Thor_Tool_GoFish4.PRG + 0 + .F. + 7 + GoFish4 + + + + + 2784 + 27 + Thor_Tool_PEME_AddObject.PRG + 0 + .F. + 8 + Add Object + + + + + 2785 + 27 + Thor_Tool_GetPixel.PRG + 0 + .F. + 9 + GetPixel + + + + + 2786 + 27 + THOR_TOOL_GOTOTHOR.PRG + 0 + .F. + 10 + Go To Thor + + + + + 2787 + 27 + Thor_Tool_PEME_HighlightControlStructure.PRG + 0 + .F. + 11 + Highlight Control Structure + + + + + 2788 + 27 + Thor_Tool_PEME_EndControlStructure.PRG + 0 + .F. + 12 + Close Control Structure + + + + + 2789 + 14 + Thor_Tool_PEME_AddObject.PRG + 0 + .F. + 4 + Add Object + + + + + 2790 + 14 + thor_tool_togglecommentcolors.prg + 0 + .F. + 5 + Toggle comment colors + + + + + 2791 + 27 + Thor_Tool_aaaaaaaa.PRG + 0 + .F. + 13 + aaaaaPrompt for the tool + + + + + 2792 + 27 + Thor_Tool_aaaaaaaa.PRG + 0 + .F. + 14 + aaaaaPrompt for the tool + + + + + 2793 + 14 + Thor_Tool_PEME_AddObject.PRG + 0 + .F. + 6 + Add Object + + + + + 2794 + 14 + Thor_Tool_aaaaaaaa.PRG + 0 + .F. + 7 + aaaaaPrompt for the tool + + + + + 2795 + 14 + Thor_Tool_aaaaaaaa.PRG + 0 + .F. + 8 + aaaaaPrompt for the tool + + + + + 2796 + 14 + Thor_Tool_aaaaaaaa.PRG + 0 + .F. + 9 + aaaaaPrompt for the tool + + + + + 2797 + 27 + Thor_Tool_PEME_AddObject.PRG + 0 + .F. + 15 + Add Object + + + + + 2798 + 27 + thor_tool_togglecommentcolors.prg + 0 + .F. + 16 + Toggle comment colors + + + + + 2799 + 13 + Thor_Tool_aaaaaaaa.PRG + 0 + .F. + 7 + aaaaaPrompt for the tool + + + + + 2800 + 27 + Thor_Tool_aaaaaaaa.PRG + 0 + .F. + 17 + aaaaaPrompt for the tool + + + + + 2801 + 8 + Thor_Tool_ThorInternalRepositoryHomePage.PRG + 0 + .F. + 70 + Repository Home Page + + + + + 2802 + 8 + + 0 + .T. + 80 + + + + + + 2803 + 8 + + 0 + .T. + 100 + + + + + + 2804 + 8 + Thor_Tool_Thor_CheckForUpdates.PRG + 0 + .F. + 110 + Check for Updates + + + + + 2805 + 8 + Thor_Tool_Thor_Community.PRG + 0 + .F. + 120 + Community / Discussions + + + + + + +
+ diff --git a/Thor/Source/Tables/startuptools.db2 b/Thor/Source/Tables/startuptools.db2 new file mode 100644 index 00000000..25ac7969 --- /dev/null +++ b/Thor/Source/Tables/startuptools.db2 @@ -0,0 +1,122 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="startuptools.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000031 + Visual FoxPro, autoincrement enabled + + + + ID + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 3 + 1 + + + PRGNAME + C + 60 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + STARTUP + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + STARTUPTOOLS.CDX + + + + ID + REGULAR + ID + + ASCENDING + MACHINE + + + PRGNAME + REGULAR + UPPER(PRGNAME) + + ASCENDING + MACHINE + + + + + + + + + 1 + Thor_Tool_PEME_LaunchPEMEditor.PRG + .F. + + + + 2 + Thor_Tool_sssssssaaa.PRG + .T. + + + + + +
+ diff --git a/Thor/Source/Tables/thor.db2 b/Thor/Source/Tables/thor.db2 new file mode 100644 index 00000000..341a009c --- /dev/null +++ b/Thor/Source/Tables/thor.db2 @@ -0,0 +1,221 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000030 + Visual FoxPro + + + + KEY + C + 30 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CAPTION + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + VALUE + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + DISPLAY + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + TYPE + C + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + VALID + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CLASS + C + 20 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + LIBRARY + C + 20 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + + + + + ThorHotKey + + + + C + + ThorHotKey + Thor_UI.vcx + + + + UpdateMessage + + + + L + + + + + + + FontSize + + + + N + + + + + + + + +
+ diff --git a/Thor/Source/Tables/toolhotkeyassignments.db2 b/Thor/Source/Tables/toolhotkeyassignments.db2 new file mode 100644 index 00000000..7a6de950 --- /dev/null +++ b/Thor/Source/Tables/toolhotkeyassignments.db2 @@ -0,0 +1,394 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="toolhotkeyassignments.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000031 + Visual FoxPro, autoincrement enabled + + + + ID + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 83 + 1 + + + PRGNAME + C + 60 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + HOTKEYID + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + TOOLHOTKEYASSIGNMENTS.CDX + + + + HOTKEYID + REGULAR + HOTKEYID + + ASCENDING + MACHINE + + + ID + REGULAR + ID + + ASCENDING + MACHINE + + + PRGNAME + REGULAR + UPPER(PRGNAME) + + ASCENDING + MACHINE + + + + + + + + + 9 + Thor_Tool_PEME_EndControlStructure.PRG + 59 + + + + 10 + Thor_Tool_PEME_Copyforcomparingandpasting.PRG + 96 + + + + 11 + Thor_Tool_PEME_OpenMRUS.PRG + 101 + + + + 12 + Thor_Tool_PEME_OpenFiles.PRG + 0 + + + + 13 + Thor_Tool_PEME_OpenWindows.PRG + 35 + + + + 19 + Thor_Tool_PEME_CrossRefCurrentobject.PRG + 58 + + + + 20 + Thor_Tool_Repository_TOGGLECOMMENTCOLORS.PRG + 67 + + + + 22 + Thor_Tool_PEME_BeautifyX.PRG + 2 + + + + 23 + Thor_Tool_PEME_DynamicSnippets.PRG + 62 + + + + 24 + Thor_Tool_PEME_EnhancedCut.PRG + 21 + + + + 26 + Thor_Tool_PEME_EnhancedCopyAdditive.PRG + -1 + + + + 27 + Thor_Tool_PEME_Back.PRG + 4 + + + + 28 + Thor_Tool_PEME_Forward.PRG + 5 + + + + 29 + Thor_Tool_PEME_MoveResizeWindow.PRG + 6 + + + + 32 + Thor_Tool_PEME_ExtractToMethod.PRG + 10 + + + + 34 + Thor_Tool_PEME_CrossRefThismethod.PRG + 57 + + + + 36 + Thor_Tool_PEME_Closeallmethodwindows.PRG + 91 + + + + 37 + Thor_Tool_PEME_FindObjects.PRG + 63 + + + + 41 + Thor_Tool_Repository_GOTOMETHOD.PRG + 29 + + + + 45 + Thor_Tool_ThorInternalAllTools.PRG + 36 + + + + 46 + Thor_Tool_PEME_GoToDefinition.PRG + 0 + + + + 48 + Thor_Tool_Repository_HACKCX_MRUS.PRG + 66 + + + + 50 + Thor_Tool_Repository_CYCLEDESIGNERWINDOWS.PRG + 48 + + + + 52 + Thor_Tool_Repository_RESIZEDESIGNER.PRG + 49 + + + + 53 + Thor_Tool_Repository_MoveDesignersToTop.PRG + 47 + + + + 55 + Thor_Tool_PEME_LaunchPEMEditor.PRG + 19 + + + + 56 + Thor_Tool_PEME_ClosePEMEditorforms.PRG + 20 + + + + 59 + Thor_Tool_ThorInternalRepository.PRG + 65 + + + + 61 + Thor_Tool_PEME_OpenFavorites.PRG + 28 + + + + 62 + Thor_Tool_InspectErrors.PRG + 37 + + + + 63 + Thor_Tool_Repository_CommentSelectedText.PRG + 75 + + + + 64 + THOR_TOOL_REPOSITORY_SAMPLE_MODIFYSELECTEDTEXT.PRG + 77 + + + + 65 + Thor_Tool_OpenProject.PRG + 27 + + + + 66 + Thor_Tool_GetPixel.PRG + 111 + + + + 69 + Thor_Tool_PEME_HighlightControlStructure.PRG + 9 + + + + 72 + Thor_Tool_PEME_EnhancedCutAdditive.PRG + 31 + + + + 73 + Thor_Tool_PEME_FormatSizeandPosition.PRG + 33 + + + + 74 + Thor_Tool_PEME_Closeallmethodwindowsbut.PRG + 90 + + + + 75 + Thor_Tool_InspectTables.PRG + 87 + + + + 76 + Thor_Tool_aaaaaaaa.PRG + 93 + + + + 77 + thor_tool_thorframework.prg + 102 + + + + 78 + thor_tool_setrevisiondate.prg + 103 + + + + 79 + Thor_Tool_dsssssssss.PRG + 107 + + + + 80 + Thor_Tool_GoFish4.PRG + 38 + + + + 81 + thor_tool_togglecommentcolors.prg + 55 + + + + 82 + Thor_Tool_PEME_LaunchDocumentTreeView.PRG + 113 + + + + + +
+ diff --git a/Thor/Source/basecontrols.vc2 b/Thor/Source/basecontrols.vc2 new file mode 100644 index 00000000..a61c748c --- /dev/null +++ b/Thor/Source/basecontrols.vc2 @@ -0,0 +1,1221 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="basecontrols.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS basecheckbox AS checkbox + *< CLASSDATA: Baseclass="checkbox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + *p: _memberdata && XML Metadata for customizable properties + * + + Alignment = 0 + AutoSize = .T. + BackStyle = 0 + Caption = "Check1" + FontName = "Tahoma" + FontSize = 10 + Name = "basecheckbox" + Value = .F. + _memberdata = + + + + && XML Metadata for customizable properties + + PROCEDURE anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + * Abstract method + + ENDPROC + + PROCEDURE InteractiveChange + local lnPos, ; + lcAlias, ; + lcField + with This + + * Update the control source in case AnyChange calls Refresh. + + lnPos = at('.', .ControlSource) + if lnPos > 0 and not empty(.ControlSource) and ; + not .Value == evaluate(.ControlSource) + lcAlias = left(.ControlSource, lnPos - 1) + lcField = substr(.ControlSource, lnPos + 1) + if used(lcAlias) + replace (lcField) with .Value in (lcAlias) + else + store .Value to (.ControlSource) + endif used(lcAlias) + endif lnPos > 0 ... + + * Call a common method for handling changes. + + .AnyChange() + endwith + + ENDPROC + + PROCEDURE KeyPress + * Prevent Ctrl-0 from inserting a null value. + + lparameters tnKeyCode, ; + tnShiftAltCtrl + if tnKeyCode = asc('0') and bittest(tnShiftAltCtrl, 1) + nodefault + endif tnKeyCode = asc('0') ... + + ENDPROC + + PROCEDURE ProgrammaticChange + * Call a common method for handling changes. + + This.AnyChange() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS basecollection AS collection + *< CLASSDATA: Baseclass="collection" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: _memberdata && XML Metadata for customizable properties + * + + Height = 23 + Name = "buildercollection" + Width = 23 + _memberdata = + + && XML Metadata for customizable properties + +ENDDEFINE + +DEFINE CLASS basecombobox AS combobox + *< CLASSDATA: Baseclass="combobox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + *a: aitems[1,0] && An array of items for the RowSource if RowSourceType is set to 5-Array + *p: _memberdata && XML Metadata for customizable properties + * + + FontName = "Tahoma" + FontSize = 10 + Height = 22 + ItemTips = .T. + Name = "basecombobox" + RowSource = "This.aItems" + RowSourceType = 5 + Style = 2 + _memberdata = + + + && XML Metadata for customizable properties + + PROCEDURE anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + * Abstract method. + + ENDPROC + + PROCEDURE DropDown + * Set DisplayCount to an appropriate value based on how much room there is + * below the form. + + local lnHeight + lnHeight = iif(Thisform.ShowWindow = 2 or ; + (pemstatus(Thisform, 'Desktop', 5) and Thisform.Desktop), sysmetric(2), ; + _vfp.Height) + This.DisplayCount = max(ceiling((lnHeight - Thisform.Top - ; + objtoclient(This, 1))/This.Height), 7) + + ENDPROC + + PROCEDURE Init + * Initialize aItems. + + This.aItems = '' + + ENDPROC + + PROCEDURE InteractiveChange + local lnPos, ; + lcAlias, ; + lcField + with This + + * Update the control source in case AnyChange calls Refresh. + + lnPos = at('.', .ControlSource) + if lnPos > 0 and not empty(.ControlSource) and ; + not .Value == evaluate(.ControlSource) + lcAlias = left(.ControlSource, lnPos - 1) + lcField = substr(.ControlSource, lnPos + 1) + if used(lcAlias) + replace (lcField) with .Value in (lcAlias) + else + store .Value to (.ControlSource) + endif used(lcAlias) + endif lnPos > 0 ... + + * Call a common method for handling changes. + + .AnyChange() + endwith + + ENDPROC + + PROCEDURE KeyPress + * Prevent Ctrl-0 from inserting a null value. + + lparameters tnKeyCode, ; + tnShiftAltCtrl + if tnKeyCode = asc('0') and bittest(tnShiftAltCtrl, 1) + nodefault + endif tnKeyCode = asc('0') ... + + ENDPROC + + PROCEDURE ProgrammaticChange + * Call a common method for handling changes. + + This.AnyChange() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS basecommandbutton AS commandbutton + *< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: _memberdata && XML Metadata for customizable properties + * + + Caption = "Command1" + FontName = "Tahoma" + FontSize = 10 + Height = 23 + Name = "basecommandbutton" + Width = 75 + _memberdata = + + && XML Metadata for customizable properties + +ENDDEFINE + +DEFINE CLASS basecontainer AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: enabled_assign + *p: _memberdata && XML Metadata for customizable properties + * + + BackStyle = 0 + BorderWidth = 0 + Name = "basecontainer" + Style = 3 + _memberdata = + + && XML Metadata for customizable properties + + PROCEDURE enabled_assign + lparameters tlEnabled + This.Enabled = tlEnabled + This.SetAll('Enabled', tlEnabled) + + ENDPROC + +ENDDEFINE + +DEFINE CLASS baseeditbox AS editbox + *< CLASSDATA: Baseclass="editbox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + *m: validation && Custom validation code + *p: _memberdata && XML Metadata for customizable properties + * + + FontName = "Tahoma" + FontSize = 10 + IntegralHeight = .T. + Name = "baseeditbox" + SelectOnEntry = .T. + _memberdata = + + + + && XML Metadata for customizable properties + + PROCEDURE anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + * Abstract method. + + ENDPROC + + PROCEDURE InteractiveChange + * Call a common method for handling changes. + + This.AnyChange() + + ENDPROC + + PROCEDURE KeyPress + * Prevent Ctrl-0 from inserting a null value. + + lparameters tnKeyCode, ; + tnShiftAltCtrl + if tnKeyCode = asc('0') and bittest(tnShiftAltCtrl, 1) + nodefault + endif tnKeyCode = asc('0') ... + + ENDPROC + + PROCEDURE ProgrammaticChange + * Call a common method for handling changes. + + This.AnyChange() + + ENDPROC + + PROCEDURE Valid + * If we're not canceling, call the Validation method to do the actual + * validation. + + local luReturn + with This + if lastkey() <> 27 + luReturn = .Validation() + else + luReturn = .T. + endif lastkey() <> 27 + endwith + return luReturn + + ENDPROC + + PROCEDURE validation && Custom validation code + * Abstract method + + ENDPROC + + PROCEDURE When + * Store the current value into the Tag property so it can be restored if Valid + * fails. + + This.Tag = This.Value + + ENDPROC + +ENDDEFINE + +DEFINE CLASS baseform AS form + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdEscape" UniqueID="" Timestamp="" /> + + * + *m: refreshform && Refreshes the form with the LockScreen .T. + *m: restoresettings && Restores saved settings from FOXUSER + *m: savesettings && Saves settings to FOXUSER + *m: setfocustofirstobject && Sets focus to the first object in the specified container + *p: cfoxuserid && The FOXUSER ID to save/restore settings to + *p: cfoxusername && The FOXUSER NAME to save/restore settings to + *p: ldockable + *p: lpersistsizeposition && .T. to persist the size and position of the form + *p: lsavesettings && .T. to save and restore settings + *p: lsavetopwidth + *p: opersist && A reference to a FoxResource object + *p: _memberdata && XML Metadata for customizable properties + * + + AllowOutput = .F. + AutoCenter = .T. + Caption = "Form" + cfoxuserid = && The FOXUSER ID to save/restore settings to + cfoxusername = && The FOXUSER NAME to save/restore settings to + DataSession = 2 + DoCreate = .T. + FontName = "Tahoma" + FontSize = 10 + ldockable = .F. + lpersistsizeposition = .T. && .T. to persist the size and position of the form + lsavesettings = .T. && .T. to save and restore settings + lsavetopwidth = .T. + Name = "baseform" + opersist = .NULL. && A reference to a FoxResource object + ShowTips = .T. + Visible = .T. + _memberdata = + + + + + + + + + + + + && XML Metadata for customizable properties + + ADD OBJECT 'cmdEscape' AS basecommandbutton WITH ; + Cancel = .T., ; + Left = -100, ; + Name = "cmdEscape", ; + Top = -100 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + PROCEDURE Destroy + * Save the current settings + + if This.lSaveSettings + This.SaveSettings() + endif This.lSaveSettings + + * Nuke member objects. + + This.oPersist = .NULL. + + ENDPROC + + PROCEDURE Init + local lcLibrary + with This + + * Restore saved options and the size and position of the form. + + if .lSaveSettings + lcLibrary = 'FoxResource.prg' + .oPersist = newobject('FoxResource', lcLibrary) + .RestoreSettings() + endif .lSaveSettings + endwith + + ENDPROC + + PROCEDURE Load + * Set up the environment. + + set deleted on + set exact off + set exclusive off + set multilocks on + set safety off + set talk off + sys(3054, 0) + + ENDPROC + + PROCEDURE refreshform && Refreshes the form with the LockScreen .T. + * Lock for form while refreshing. + + LockWindow(.T.) + + This.LockScreen = .T. + This.Refresh() + This.LockScreen = .F. + + LockWindow(.F.) + ENDPROC + + PROCEDURE restoresettings && Restores saved settings from FOXUSER + * Restore saved settings from FOXUSER. + + Local lnDockable, lnHeight, lnLeft, lnTop, lnWidth + With This + .oPersist.Load (.cFoxUserID, .cFoxUserName) + + If .lPersistSizePosition + lnDockable = Nvl (.oPersist.Get ('Dockable'), 1) + lnTop = Max (Nvl (.oPersist.Get ('Top'), .Top), 0) + lnLeft = Max (Nvl (.oPersist.Get ('Left'), .Left), 0) + lnHeight = Nvl (.oPersist.Get ('Height'), .Height) + lnWidth = Nvl (.oPersist.Get ('Width'), .Width) + + .Top = -2000 + If .lDockable + .Dockable = lnDockable + Endif + + .Left = lnLeft + .Height = lnHeight + .Width = lnWidth + * Setting Top must be last so that it + * does not become visible until now + .Top = lnTop + Endif .lPersistSizePosition + Endwith + + ENDPROC + + PROCEDURE savesettings && Saves settings to FOXUSER + * Save settings to FOXUSER. + + with This + if .lPersistSizePosition + .oPersist.Set('Dockable', .Dockable) + .oPersist.Set('Top', .Top) + .oPersist.Set('Left', .Left) + .oPersist.Set('Height', .Height) + .oPersist.Set('Width', .Width) + endif .lPersistSizePosition + .oPersist.Save(.cFoxUserID, .cFoxUserName) + endwith + + ENDPROC + + PROCEDURE setfocustofirstobject && Sets focus to the first object in the specified container + *============================================================================== + * Method: SetFocusToFirstObject + * Status: Public + * Purpose: Sets focus to the first object in the specified container + * Author: Doug Hennig + * Last revision: 09/24/2010 + * Parameters: toContainer - the container to check (optional: if it + * isn't passed, the form is used) + * tlKeepCurrentPage - .T. to keep the current page in any + * PageFrame active + * Returns: .T. if it set focus to an object + * Environment in: none + * Environment out: if this method returns .T., focus has been set to an object + *============================================================================== + + lparameters toContainer, ; + tlKeepCurrentPage + local loContainer, ; + laObjects[1], ; + lnObjects, ; + lnIndex, ; + loControl, ; + llReturn, ; + lnI, ; + loObject, ; + lcClass, ; + lnPage, ; + loPage + + * If the container wasn't specified, let's use the form. + + loContainer = iif(vartype(toContainer) = 'O', toContainer, This) + + * Get an array of all member objects of the specified container. Initialize + * some variables. + + lnObjects = amembers(laObjects, loContainer, 2) + lnIndex = 99999 + loControl = .NULL. + llReturn = .F. + + * Check each of the member objects until we come across the one lowest in the + * tab order. + + for lnI = 1 to lnObjects + loObject = evaluate('loContainer.' + laObjects[lnI]) + lcClass = upper(loObject.BaseClass) + do case + + * If the object doesn't have a TabIndex property, is a label, is disabled, is + * read-only, or isn't visible, ignore it. + + case type('loObject.TabIndex') = 'U' or lcClass = 'LABEL' or ; + (type('loObject.TabStop') = 'L' and not loObject.TabStop and ; + upper(loObject.BaseClass) <> 'PAGEFRAME') or ; + (type('loObject.Enabled') = 'L' and not loObject.Enabled) or ; + (type('loObject.ReadOnly') = 'L' and loObject.ReadOnly) or ; + (type('loObject.Visible') = 'L' and not loObject.Visible) + + * If this object is lower in tab order than any we've already seen, grab a + * reference to it. + + case loObject.TabIndex < lnIndex + loControl = loObject + lnIndex = loObject.TabIndex + endcase + next lnI + + * If we found an object, set focus to it. We may need to drill down into it if + * it's a container. + + if vartype(loControl) = 'O' + lcClass = upper(loControl.BaseClass) + do case + + * If this is a pageframe, choose the first page, then call ourselves + * recursively to find the first object inside it and set focus to it. + + case lcClass = 'PAGEFRAME' + if tlKeepCurrentPage + lnPage = loControl.ActivePage + else + lnIndex = 99999 + lnPage = 0 + for lnI = 1 to loControl.PageCount + try + loPage = loControl.Pages[lnI] + if loPage.PageOrder < lnIndex + lnPage = lnI + lnIndex = loPage.PageOrder + endif loPage.PageOrder < lnIndex + catch + endtry + next lnI + endif tlKeepCurrentPage + if lnPage > 0 + if loControl.ActivePage <> lnPage + loControl.ActivePage = lnPage + endif loControl.ActivePage <> lnPage + llReturn = This.SetFocusToFirstObject(loControl.Pages[lnPage]) + endif lnPage > 0 + + * If this is another type of container, call ourselves recursively to find the + * first object inside it and set focus to it. + + case lcClass $ 'COMMANDGROUP,OPTIONGROUP,CONTAINER' + llReturn = This.SetFocusToFirstObject(loControl) + + * Set focus to the object. + + case pemstatus(loControl, 'SetFocus', 5) + loControl.SetFocus() + llReturn = .T. + endcase + endif vartype(loControl) = 'O' ... + return llReturn + + ENDPROC + + PROCEDURE cmdEscape.Click + Thisform.Release() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS basegrid AS grid + *< CLASSDATA: Baseclass="grid" Timestamp="" Scale="Pixels" Uniqueid="" /> + + FontName = "Tahoma" + FontSize = 10 + Height = 200 + Name = "basegrid" + RowHeight = 19 + Width = 320 + +ENDDEFINE + +DEFINE CLASS baselabel AS label + *< CLASSDATA: Baseclass="label" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: _memberdata && XML Metadata for customizable properties + * + + AutoSize = .T. + BackStyle = 0 + Caption = "Label1" + FontName = "Tahoma" + FontSize = 10 + Name = "baselabel" + _memberdata = + + && XML Metadata for customizable properties + +ENDDEFINE + +DEFINE CLASS baselabelledbox AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="shpBox" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblBox" UniqueID="" Timestamp="" /> + + * + *m: height_assign + *m: width_assign + *p: builder && Specifies the builder for this object + *p: _memberdata && XML Metadata for customizable properties + * + + BackStyle = 0 + BorderWidth = 0 + builder = BaseLabelledBoxBuilder.PRG && Specifies the builder for this object + Height = 133 + Name = "baselabelledbox" + Style = 3 + Width = 168 + _memberdata = + + && XML Metadata for customizable properties + + ADD OBJECT 'lblBox' AS baselabel WITH ; + BackStyle = 1, ; + Left = 10, ; + Name = "lblBox", ; + Style = 3 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'shpBox' AS baseline3d WITH ; + Height = 124, ; + Name = "shpBox", ; + Top = 7, ; + Width = 166 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="shape" /> + + PROCEDURE height_assign + * When the height of the container is resized, resize the shape. + + lparameters tnHeight + This.Height = tnHeight + This.shpBox.Height = tnHeight - This.shpBox.Top + + ENDPROC + + PROCEDURE width_assign + * When the width of the container is resized, resize the shape. + + lparameters tnWidth + store tnWidth to This.Width, This.shpBox.Width + + ENDPROC + +ENDDEFINE + +DEFINE CLASS baseline3d AS shape + *< CLASSDATA: Baseclass="shape" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: _memberdata && XML Metadata for customizable properties + * + + BackStyle = 0 + Height = 1 + Name = "baseline3d" + SpecialEffect = 0 + Style = 3 + Width = 100 + _memberdata = + + && XML Metadata for customizable properties + +ENDDEFINE + +DEFINE CLASS baselistbox AS listbox + *< CLASSDATA: Baseclass="listbox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + *a: aitems[1,0] && An array of items for the RecordSource + *p: _memberdata && XML Metadata for customizable properties + * + + FontName = "Tahoma" + FontSize = 10 + IntegralHeight = .T. + ItemTips = .T. + Name = "baselistbox" + RowSource = "This.aItems" + RowSourceType = 5 + _memberdata = + + + + && XML Metadata for customizable properties + + PROCEDURE anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + * Abstract method. + + ENDPROC + + PROCEDURE InteractiveChange + local lnPos, ; + lcAlias, ; + lcField + with This + + * Update the control source in case AnyChange calls Refresh. + + lnPos = at('.', .ControlSource) + if lnPos > 0 and not empty(.ControlSource) and ; + not .Value == evaluate(.ControlSource) + lcAlias = left(.ControlSource, lnPos - 1) + lcField = substr(.ControlSource, lnPos + 1) + if used(lcAlias) + replace (lcField) with .Value in (lcAlias) + else + store .Value to (.ControlSource) + endif used(lcAlias) + endif lnPos > 0 ... + + * Call a common method for handling changes. + + .AnyChange() + endwith + + ENDPROC + + PROCEDURE ProgrammaticChange + * Call a common method for handling changes. + + This.AnyChange() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS baseoptionbutton AS optionbutton + *< CLASSDATA: Baseclass="optionbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: _memberdata && XML Metadata for customizable properties + * + + AutoSize = .T. + BackStyle = 0 + Caption = "Option1" + FontName = "Tahoma" + FontSize = 10 + Name = "baseoptionbutton" + _memberdata = + + && XML Metadata for customizable properties + + PROCEDURE KeyPress + * Prevent Ctrl-0 from inserting a null value. + + lparameters tnKeyCode, ; + tnShiftAltCtrl + if tnKeyCode = asc('0') and bittest(tnShiftAltCtrl, 1) + nodefault + endif tnKeyCode = asc('0') ... + + ENDPROC + +ENDDEFINE + +DEFINE CLASS baseoptiongroup AS optiongroup + *< CLASSDATA: Baseclass="optiongroup" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + *p: _memberdata && XML Metadata for customizable properties + * + + BackStyle = 0 + BorderStyle = 0 + ButtonCount = 2 + Height = 46 + MemberClass = "baseoptionbutton" + MemberClassLibrary = basecontrols.vcx + Name = "baseoptiongroup" + Value = 0 + Width = 71 + _memberdata = + + && XML Metadata for customizable properties + Baseoptionbutton1.Left = 5 + Baseoptionbutton1.Name = "Baseoptionbutton1" + Baseoptionbutton1.Top = 5 + Baseoptionbutton2.Left = 5 + Baseoptionbutton2.Name = "Baseoptionbutton2" + Baseoptionbutton2.Top = 23 + + PROCEDURE anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + * Abstract method. + + ENDPROC + + PROCEDURE InteractiveChange + local lnPos, ; + lcAlias, ; + lcField + with This + + * Update the control source in case AnyChange calls Refresh. + + lnPos = at('.', .ControlSource) + if lnPos > 0 and not empty(.ControlSource) and ; + not .Value == evaluate(.ControlSource) + lcAlias = left(.ControlSource, lnPos - 1) + lcField = substr(.ControlSource, lnPos + 1) + if used(lcAlias) + replace (lcField) with .Value in (lcAlias) + else + store .Value to (.ControlSource) + endif used(lcAlias) + endif lnPos > 0 ... + + * Call a common method for handling changes. + + .AnyChange() + endwith + + ENDPROC + + PROCEDURE ProgrammaticChange + * Call a common method for handling changes. + + This.AnyChange() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS basepage AS page + *< CLASSDATA: Baseclass="page" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: _memberdata && XML Metadata for customizable properties + * + + Caption = "Page1" + FontName = "Tahoma" + FontSize = 10 + Height = 139 + Name = "basepage" + Width = 139 + _memberdata = + + && XML Metadata for customizable properties + + PROCEDURE Activate + * Refresh all controls. + + LockWindow(.T.) + + local llLockScreen + with This + llLockScreen = Thisform.LockScreen + if not llLockScreen + Thisform.LockScreen = .T. + endif not llLockScreen + .Refresh() + if not llLockScreen + Thisform.LockScreen = .F. + endif not llLockScreen + endwith + + LockWindow(.F.) + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS basepageframe AS pageframe + *< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: _memberdata && XML Metadata for customizable properties + * + + ErasePage = .T. + Height = 250 + MemberClass = "basepage" + MemberClassLibrary = basecontrols.vcx + Name = "basepageframe" + PageCount = 1 + TabStyle = 1 + _memberdata = + + && XML Metadata for customizable properties + Basepage1.Name = "Basepage1" + +ENDDEFINE + +DEFINE CLASS baseshape AS shape + *< CLASSDATA: Baseclass="shape" Timestamp="" Scale="Pixels" Uniqueid="" /> + + BackStyle = 0 + Height = 17 + Name = "baseshape" + Width = 100 + +ENDDEFINE + +DEFINE CLASS basespinner AS spinner + *< CLASSDATA: Baseclass="spinner" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + *p: _memberdata && XML Metadata for customizable properties + * + + FontName = "Tahoma" + FontSize = 10 + Height = 24 + Name = "basespinner" + SelectOnEntry = .T. + _memberdata = + + && XML Metadata for customizable properties + + PROCEDURE anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + * Abstract method. + + ENDPROC + + PROCEDURE Error + lparameters tnError, ; + tcMethod, ; + tnLine + do case + + * Spinners bound to object properties seem to have a problem when invalid + * values are entered from the keyboard: the Error method fires with error 1469 + * (property value is out of bounds) with tcMethod being "ControlSource" rather + * than the Valid method catching it. + + case tnError = 1469 + return + + * Ignore "property is read-only" errors. + + case tnError = 1743 + return + + * All other errors get passed on to the form. + + otherwise + Thisform.Error(tnError, This.Name + '.' + tcMethod, tnLine) + endcase + + ENDPROC + + PROCEDURE InteractiveChange + * Write the current value to the ControlSource if necessary (otherwise + * anything called from here can't check the value of our ControlSource), call + * the AnyChange method. Note: if the value is invalid, don't do anything. + + local lnPos, ; + lcAlias, ; + lcField + + if not between(This.Value, This.SpinnerLowValue, This.SpinnerHighValue) + nodefault + return + endif not between(.Value, ... + + with This + lnPos = at('.', .ControlSource) + if lnPos > 0 and not empty(.ControlSource) and ; + not .Value == evaluate(.ControlSource) + lcAlias = left(.ControlSource, lnPos - 1) + lcField = substr(.ControlSource, lnPos + 1) + try + if used(lcAlias) + replace (lcField) with .Value in (lcAlias) + else + store .Value to (.ControlSource) + endif used(lcAlias) + catch + nodefault + endtry + endif lnPos > 0 ... + .AnyChange() + endwith + + ENDPROC + + PROCEDURE KeyPress + * Prevent Ctrl-0 from inserting a null value. + + lparameters tnKeyCode, ; + tnShiftAltCtrl + if tnKeyCode = asc('0') and bittest(tnShiftAltCtrl, 1) + nodefault + endif tnKeyCode = asc('0') ... + + ENDPROC + + PROCEDURE ProgrammaticChange + * Call a common method for handling changes. + + This.AnyChange() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS basetextbox AS textbox + *< CLASSDATA: Baseclass="textbox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + *m: validation && Custom validation code + *p: conentryvalue && The value when the textbox receives focus + *p: _memberdata && XML Metadata for customizable properties + * + + conentryvalue = && The value when the textbox receives focus + FontName = "Tahoma" + FontSize = 10 + Format = "T" + Height = 22 + Name = "basetextbox" + SelectOnEntry = .T. + _memberdata = + + + + + && XML Metadata for customizable properties + + PROCEDURE anychange && Called from both InteractiveChange and ProgrammaticChange to consolidate handling any changes + * Abstract method. + + ENDPROC + + PROCEDURE GotFocus + * Save the value in case we need to restore it later. + + This.cOnEntryValue = This.Value + + ENDPROC + + PROCEDURE InteractiveChange + * Call a common method for handling changes. + + This.AnyChange() + + ENDPROC + + PROCEDURE KeyPress + * Prevent Ctrl-0 from inserting a null value. + + lparameters tnKeyCode, ; + tnShiftAltCtrl + if tnKeyCode = asc('0') and bittest(tnShiftAltCtrl, 1) + nodefault + endif tnKeyCode = asc('0') ... + + ENDPROC + + PROCEDURE ProgrammaticChange + * Call a common method for handling changes. + + This.AnyChange() + + ENDPROC + + PROCEDURE Valid + * If we're not canceling, call the Validation method to do the actual + * validation. + + local luReturn + with This + if lastkey() <> 27 + luReturn = .Validation() + else + luReturn = .T. + endif lastkey() <> 27 + endwith + return luReturn + + ENDPROC + + PROCEDURE validation && Custom validation code + * Abstract method + + ENDPROC + + PROCEDURE When + * Store the current value into the Tag property so it can be restored if Valid + * fails. + + This.Tag = This.Value + + ENDPROC + +ENDDEFINE + +DEFINE CLASS basetree AS olecontrol + *< CLASSDATA: Baseclass="olecontrol" Timestamp="" Scale="Pixels" Uniqueid="" Nombre="basetree" Parent="" ObjName="basetree" OLEObject="C:\Windows\SysWOW64\MSCOMCTL.OCX" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFD6IW88UM0BAwAAAEABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAagAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAAQAAAAAAAAABAAAAAIAAAD+/////v////7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////+2kEHHiYXREbFqAMDwKDYoIUM0EggAAABWCgAAVgoAALE8wWoBAAYAIgAAAJwAAADoAwAACAAAAAEAAAAB782rXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAAAAAAAEAAAABAAAAAQAAAAEAAAAAAAAAAAAAAAAAAAABAACAAAAAAAAAAAAFAAEARIfQAAAAAAAGABwBWQEMANgGLgAUIgqrAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFADAxUwgGAAAAAAAAAAUAAICE6xgAAQAAAFwAH97svQEABQDM6xgAAAAGAAAAAAAAAAAAAADbIQrrAAAAAAAAAAABAAAAAQAAAAEAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQABANSV0AAAAAAAKwAwAXUACADQAhUA0AIVAAAAkgW+MIF8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE8ARQBcAFQATQBBAFMAXwBPAEUASABvAA==" /> + + * + *m: getitemkey + *m: loadchildnodes + *m: loadnode + *m: loadtree + *m: restoreexpandednodes + *m: saveexpandednodes + *p: cselectednode + *a: anodes[1,0] + *p: _memberdata && XML Metadata for customizable properties + * + + cselectednode = + Height = 100 + Name = "basetree" + Width = 100 + _memberdata = + + + + + && XML Metadata for customizable properties + + PROCEDURE getitemkey + ENDPROC + + PROCEDURE loadchildnodes + ENDPROC + + PROCEDURE loadnode + ENDPROC + + PROCEDURE loadtree + ENDPROC + + PROCEDURE restoreexpandednodes + Local lcKey, lnI, lnPos, loNode, loSelected + loSelected = .Null. + With This + For lnI = 1 To .Nodes.Count + loNode = .Nodes.Item[lnI] + lcKey = loNode.Key + lnPos = Ascan (.aNodes, lcKey, -1, -1, 1, 15) + If lnPos > 0 + loNode.Expanded = .aNodes[lnPos, 2] + If lcKey == .cSelectedNode + .SelectedItem = loNode + loNode.EnsureVisible() + loSelected = loNode + Endif lcKey == .cSelectedNode + Endif lnPos > 0 ... + Next lnI + Endwith && this + + Return loSelected + + + ENDPROC + + PROCEDURE saveexpandednodes + Local lnI, loNode + Local aNodes[1] + With This + Dimension .aNodes[.Nodes.Count, 2] + For lnI = 1 To .Nodes.Count + loNode = .Nodes.Item[lnI] + .aNodes[lnI, 1] = loNode.Key + .aNodes[lnI, 2] = loNode.Expanded + Next lnI + Try + .cSelectedNode = .SelectedItem.Key + Catch + EndTry + .Nodes.Clear() + Endwith && This + + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/baseprojecthooks.vc2 b/Thor/Source/baseprojecthooks.vc2 new file mode 100644 index 00000000..cf2133e3 --- /dev/null +++ b/Thor/Source/baseprojecthooks.vc2 @@ -0,0 +1,46 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="baseprojecthooks.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS baseprojecthook AS projecthook + *< CLASSDATA: Baseclass="projecthook" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "common.h" + Height = 22 + Name = "baseprojecthook" + Width = 23 + + PROCEDURE BeforeBuild + LPARAMETERS cOutputName, nBuildAction, lRebuildAll, lShowErrors, lBuildNewGuids + + ExecScript(_screen.cThorDispatcher, 'Thor_Proc_ClearOutAllObjCode') + + ExecScript(_screen.cThorDispatcher, 'Thor_Proc_GenerateSCCFilesOnProject') + + MessageBox('Update Source Control Now') + ENDPROC + + PROCEDURE QueryModifyFile + #Define clCheckOutFromSourceCodeControl .F. + + Lparameters oFile, cClassName + Local llSuccess, loTools + + Try + * see http://vfpx.codeplex.com/wikipage?title=Thor%20Tools%20Object + loTools = Execscript (_Screen.cThorDispatcher, 'class= tools from pemeditor') + llSuccess = loTools.EditSourceX (oFile.Name, cClassName, , , , clCheckOutFromSourceCodeControl) + Catch + llSuccess = .F. + Endtry + + If llSuccess + Nodefault + Endif + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/createtool.sc2 b/Thor/Source/createtool.sc2 new file mode 100644 index 00000000..6aa61878 --- /dev/null +++ b/Thor/Source/createtool.sc2 @@ -0,0 +1,492 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="createtool.scx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +#INCLUDE "thor_ui.h" + +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="2" /> + + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + +ENDDEFINE + +DEFINE CLASS frmthor AS baseform OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Baselabel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Baselabel2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtMethod" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="List1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdSave" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdDefaultFolder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCurrentFolder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboPath" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Baselabel3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Baseline1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Baseline2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cbocCustomTemplate" UniqueID="" Timestamp="" /> + + * + *m: edittool && Edits the specified tool + *m: refreshtools && Refreshes the tools + *m: runthor && Runs Thor to update the hotkeys and menus + *m: textchanged + *p: ccurrentfolder + *p: ccustomtemplate + *p: cdefaultfolder + *p: cpath + *p: csearchstring + *p: cthorfolder + *p: ctoolfilename + *p: ldefaulttemplate + *p: lrefreshtools && Flags that we're refreshing tools + *p: lsaveok + *p: ncustomtemplates + *p: othor && A reference to a Thor_Engine object + *p: otools && A reference to a collection of tools + *a: afilenames[1,0] + * + + BorderStyle = 3 + Caption = "Create Tool" + ccurrentfolder = + ccustomtemplate = + cdefaultfolder = + cfoxuserid = Thor + cfoxusername = ThorCreateTool + cpath = + csearchstring = + cthorfolder = + ctoolfilename = + DataSession = 2 + DoCreate = .T. + Height = 285 + Icon = thor16.ico + ldefaulttemplate = .F. + lrefreshtools = .F. && Flags that we're refreshing tools + lsaveok = .F. + Name = "frmThor" + ncustomtemplates = 0 + othor = .NULL. && A reference to a Thor_Engine object + otools = .NULL. && A reference to a collection of tools + Visible = .T. + Width = 403 + WindowType = 1 + _memberdata = + + + + + + + ADD OBJECT 'Baselabel1' AS baselabel WITH ; + Alignment = 0, ; + BackStyle = 0, ; + Caption = "Folder:", ; + FontBold = .T., ; + FontItalic = .F., ; + FontName = "Arial", ; + FontSize = 10, ; + ForeColor = 0,0,0, ; + Height = 18, ; + Left = 16, ; + Name = "Baselabel1", ; + TabIndex = 6, ; + Top = 12, ; + Width = 47 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'Baselabel2' AS baselabel WITH ; + Alignment = 1, ; + BackStyle = 0, ; + Caption = "Thor_Tool_", ; + FontBold = .F., ; + FontItalic = .F., ; + FontName = "Arial", ; + FontSize = 10, ; + ForeColor = 0,0,0, ; + Height = 18, ; + Left = 15, ; + Name = "Baselabel2", ; + TabIndex = 7, ; + Top = 64, ; + Width = 65 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'Baselabel3' AS baselabel WITH ; + Alignment = 1, ; + Anchor = 6, ; + BackStyle = 0, ; + Caption = "Tool Template:", ; + FontBold = .T., ; + FontItalic = .F., ; + FontName = "Arial", ; + FontSize = 10, ; + ForeColor = 0,0,0, ; + Height = 18, ; + Left = 20, ; + Name = "Baselabel3", ; + TabIndex = 7, ; + Top = 220, ; + Width = 98 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'Baseline1' AS line WITH ; + Anchor = 14, ; + Height = 0, ; + Left = -6, ; + Name = "Baseline1", ; + Top = 207, ; + Width = 412 + *< END OBJECT: BaseClass="line" /> + + ADD OBJECT 'Baseline2' AS line WITH ; + Anchor = 14, ; + Height = 0, ; + Left = -6, ; + Name = "Baseline2", ; + Top = 244, ; + Width = 412 + *< END OBJECT: BaseClass="line" /> + + ADD OBJECT 'cbocCustomTemplate' AS basecombobox WITH ; + Anchor = 14, ; + ControlSource = "Thisform.cCustomTemplate", ; + FontSize = 10, ; + Height = 22, ; + Left = 131, ; + Name = "cbocCustomTemplate", ; + RowSource = "", ; + RowSourceType = 0, ; + Top = 217, ; + Width = 237 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cboPath' AS basecombobox WITH ; + Anchor = 10, ; + ControlSource = "Thisform.cPath", ; + DisabledForeColor = 0,0,0, ; + FontBold = .F., ; + FontItalic = .F., ; + FontName = "Arial", ; + FontSize = 10, ; + Height = 25, ; + Left = 16, ; + Name = "cboPath", ; + ReadOnly = .F., ; + RowSource = "", ; + RowSourceType = 0, ; + TabIndex = 3, ; + Top = 31, ; + Value = (""), ; + Width = 372 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cmdCurrentFolder' AS basecommandbutton WITH ; + Anchor = 8, ; + Caption = "Current Folder", ; + Default = .F., ; + FontBold = .F., ; + FontItalic = .F., ; + FontName = "Arial", ; + FontSize = 10, ; + Height = 26, ; + Left = 292, ; + Name = "cmdCurrentFolder", ; + TabIndex = 2, ; + Top = 2, ; + Width = 97 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdDefaultFolder' AS basecommandbutton WITH ; + Anchor = 8, ; + Caption = "Default Folder", ; + Default = .F., ; + FontBold = .F., ; + FontItalic = .F., ; + FontName = "Arial", ; + FontSize = 10, ; + Height = 26, ; + Left = 182, ; + Name = "cmdDefaultFolder", ; + TabIndex = 2, ; + Top = 2, ; + Width = 103 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdSave' AS basecommandbutton WITH ; + Anchor = 4, ; + Caption = "Create", ; + Default = .T., ; + FontBold = .F., ; + FontItalic = .F., ; + FontName = "Arial", ; + FontSize = 10, ; + Height = 27, ; + Left = 156, ; + Name = "cmdSave", ; + TabIndex = 2, ; + Top = 252, ; + Width = 63 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'List1' AS listbox WITH ; + Anchor = 15, ; + DisabledBackColor = 236,233,216, ; + DisabledForeColor = 0,0,0, ; + Enabled = .F., ; + FontBold = .F., ; + FontItalic = .F., ; + FontName = "Arial", ; + FontSize = 10, ; + Height = 113, ; + Left = 84, ; + Name = "List1", ; + RowSourceType = 0, ; + TabIndex = 5, ; + Top = 86, ; + Width = 237 + *< END OBJECT: BaseClass="listbox" /> + + ADD OBJECT 'txtMethod' AS textbox WITH ; + Anchor = 10, ; + ControlSource = "Thisform.cSearchString", ; + FontBold = .F., ; + FontItalic = .F., ; + FontName = "Arial", ; + FontSize = 10, ; + Height = 27, ; + Left = 84, ; + Name = "txtMethod", ; + TabIndex = 1, ; + Top = 60, ; + Width = 237 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE edittool && Edits the specified tool + ENDPROC + + PROCEDURE Init + Lparameters lcToolFolder, lnFontSize, loThor + + Local laFolders(1), lcPath, lcTemplateFolder, lcValue, lnI + With This + + .MinHeight = .Height + .MinWidth = .Width + + DoDefault() + + .cDefaultFolder = loThor.DiskFileName (Addbs (lcToolFolder) + ccMyTools) + .cCurrentFolder = loThor.DiskFileName (Addbs (Sys(5) + Curdir())) + + .SetAll ('FontSize', lnFontSize) + + * Path lists + With .cboPath + .AddItem (Strtran (This.cCurrentFolder, '\', '\\')) + + lcPath = Set ('path') + Alines (laFolders, lcPath, 5, ',', ';') + For lnI = 1 To Alen (laFolders) + If Not Empty (laFolders (lnI)) + .AddItem (Strtran (loThor.DiskFileName (laFolders (lnI)), '\', '\\')) + Endif + Endfor && lnI = 1 To Alen (laFolders) + + .AddItem ('\-') + .AddItem (Strtran (This.cDefaultFolder, '\', '\\')) + .AddItem (Strtran (loThor.DiskFileName (lcToolFolder), '\', '\\')) + + lcValue = Nvl (This.oPersist.Get ('FolderName'), This.cDefaultFolder) + If 'C' = Vartype(lcValue) + lcValue = loThor.DiskFileName (Addbs (lcValue)) + Else + lcValue = This.cDefaultFolder + Endif + + .Value = lcValue + If .ListIndex = 0 + .Value = This.cDefaultFolder + Endif + This.cPath = .Value + + Endwith + + * Custom Templates + With This.cbocCustomTemplate + .AddItem(ccThorDefaultTemplate) + + lcTemplateFolder = Addbs (lcToolFolder) + ccMyTemplates + This.nCustomTemplates = Adir(laFiles, lcTemplateFolder + '\*.PRG') + If This.nCustomTemplates > 0 + For lnI = 1 To This.nCustomTemplates + .AddItem(laFiles[lnI, 1]) + Endfor && lnI = 1 to This.nCustomTemplates + Endif && This.nCustomTemplates > 0 + Endwith && this.cbocCustomTemplate + + .TextChanged ('') + + .Refresh() + + Endwith + + ENDPROC + + PROCEDURE refreshtools && Refreshes the tools + ENDPROC + + PROCEDURE restoresettings + DoDefault() + + With This + .Top = Max (Nvl (.oPersist.Get ('Top'), .Top), 0) + .Left = Max (Nvl (.oPersist.Get ('Left'), .Left), 0) + .Height = Nvl (.oPersist.Get ('Height'), .Height) + .Width = Nvl (.oPersist.Get ('Width'), .Width) + Endwith + + With This + .cPath = Nvl (.oPersist.Get ('FolderName'), '') + .cCustomTemplate = Nvl (.oPersist.Get ('TemplateName'), ccThorDefaultTemplate) + Endwith + + DoDefault() + + ENDPROC + + PROCEDURE runthor && Runs Thor to update the hotkeys and menus + ENDPROC + + PROCEDURE savesettings + With This + .oPersist.Set ('FolderName', .cPath) + .oPersist.Set ('TemplateName', .cCustomTemplate) + Endwith + + DoDefault() + + ENDPROC + + PROCEDURE textchanged + Lparameters lcNewFileName + + Local lcFileName, lcMatchPrefix, lnFiles, lnI + lnFiles = Adir (laFileNames, Addbs (Thisform.cPath) + ccTOOLNAMEPREFIX + '*.PRG') + lcMatchPrefix = upper('Thor_Tool_' + Trim(lcNewFileName)) + + With Thisform + .List1.Clear() + .cmdSave.Enabled = .T. + For lnI = 1 To lnFiles + lcFileName = laFileNames (lnI, 1) + If upper(lcFileName) = lcMatchPrefix + If .List1.ListCount = 0 + .List1.AddItem ('Name matches:') + Endif + .List1.AddItem (Space(8) + Juststem (Substr (lcFileName, 11))) + If upper(Juststem(lcFileName)) == lcMatchPrefix + .cmdSave.Enabled = .F. + Endif + Endif + Endfor + + .List1.Visible = .List1.ListCount # 0 + .List1.Refresh() + Endwith + + + ENDPROC + + PROCEDURE Unload + Return Thisform.cToolFileName + + ENDPROC + + PROCEDURE cboPath.InteractiveChange + With Thisform + .cPath = This.Value + .TextChanged(.cSearchString) + .TxtMethod.SetFocus() + .Refresh() + Endwith + + ENDPROC + + PROCEDURE cmdCurrentFolder.Click + With Thisform + .cPath = .cCurrentFolder + .TextChanged(.cSearchString) + .TxtMethod.SetFocus() + .Refresh() + Endwith + + ENDPROC + + PROCEDURE cmdCurrentFolder.Init + This.Caption = ccCURRENTFOLDER + ENDPROC + + PROCEDURE cmdDefaultFolder.Click + With Thisform + .cPath = Thisform.cDefaultFolder + .TextChanged(.cSearchString) + .TxtMethod.SetFocus() + .Refresh() + Endwith + + ENDPROC + + PROCEDURE cmdDefaultFolder.Init + This.Caption = ccDEFAULTFOLDER + + ENDPROC + + PROCEDURE cmdSave.Click + Local lcPath + lcPath = Thisform.cPath + + If Empty (lcPath) Or Not Directory (lcPath) + lcPath = loThor.DiskFileName (Addbs (lcToolFolder) + ccMyTools) + Endif + + Thisform.cToolFileName = Addbs (lcPath) + ccTOOLNAMEPREFIX + Forceext (Thisform.cSearchString, 'PRG') + If Thisform.cCustomTemplate # ccThorDefaultTemplate + Thisform.cToolFileName = Thisform.cToolFileName + '|' + Thisform.cCustomTemplate + Endif && not Thisform.lDefaultTemplate + + Thisform.Release() + + ENDPROC + + PROCEDURE cmdSave.Init + This.Caption = ccCreate + + ENDPROC + + PROCEDURE txtMethod.InteractiveChange + Thisform.TextChanged(This.Value) + + DoDefault() + + ENDPROC + + PROCEDURE txtMethod.ProgrammaticChange + Thisform.TextChanged(This.Value) + + DoDefault() + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/gf_saved_search_results.dbf b/Thor/Source/gf_saved_search_results.dbf deleted file mode 100644 index d7cf6d88..00000000 Binary files a/Thor/Source/gf_saved_search_results.dbf and /dev/null differ diff --git a/Thor/Source/gf_saved_search_results.fpt b/Thor/Source/gf_saved_search_results.fpt deleted file mode 100644 index 601fa8de..00000000 Binary files a/Thor/Source/gf_saved_search_results.fpt and /dev/null differ diff --git a/Thor/Source/hotkeys.db2 b/Thor/Source/hotkeys.db2 new file mode 100644 index 00000000..6fb2b123 --- /dev/null +++ b/Thor/Source/hotkeys.db2 @@ -0,0 +1,1870 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="hotkeys.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000030 + Visual FoxPro + + + + KEY + C + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SCANCODE + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + KEYCODE + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + BARECODE + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SHCODE + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CTCODE + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + ALTCODE + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SHCTCODE + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SHKEY + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + BAREKEY + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CTKEY + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + ALTKEY + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SHCTKEY + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SHALTKEY + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CTALTKEY + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SHCTALTKEY + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + NOTES + C + 60 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + HOTKEYS.CDX + + + + KEYCODE + REGULAR + KEYCODE + + ASCENDING + MACHINE + + + SCANCODE + REGULAR + SCANCODE + + ASCENDING + MACHINE + + + + + + + + + A + 65 + 65 + -1 + -1 + 1 + 30 + 1 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + B + 66 + 66 + -1 + -1 + 2 + 48 + 2 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + C + 67 + 67 + -1 + -1 + 3 + 46 + 3 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + D + 68 + 68 + -1 + -1 + 4 + 32 + 4 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + E + 69 + 69 + -1 + -1 + 5 + 18 + 5 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + F + 70 + 70 + -1 + -1 + 6 + 33 + 6 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + G + 71 + 71 + -1 + -1 + 7 + 34 + 7 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + H + 72 + 72 + -1 + -1 + 8 + 35 + 8 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + I + 73 + 73 + -1 + -1 + 9 + 23 + 9 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + J + 74 + 74 + -1 + -1 + 10 + 36 + 10 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + K + 75 + 75 + -1 + -1 + 11 + 37 + 11 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + L + 76 + 76 + -1 + -1 + 12 + 38 + 12 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + M + 77 + 77 + -1 + -1 + 13 + 50 + 13 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + N + 78 + 78 + -1 + -1 + 14 + 49 + 14 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + O + 79 + 79 + -1 + -1 + 15 + 24 + 15 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + P + 80 + 80 + -1 + -1 + 16 + 25 + 16 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + Q + 81 + 81 + -1 + -1 + 17 + 16 + 17 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + R + 82 + 82 + -1 + -1 + 18 + 19 + 18 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + S + 83 + 83 + -1 + -1 + 19 + 31 + 19 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + T + 84 + 84 + -1 + -1 + 20 + 20 + 20 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + U + 85 + 85 + -1 + -1 + 21 + 22 + 21 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + V + 86 + 86 + -1 + -1 + 22 + 47 + 22 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + W + 87 + 87 + -1 + -1 + 23 + 17 + 23 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + X + 88 + 88 + -1 + -1 + 24 + 45 + 24 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + Y + 89 + 89 + -1 + -1 + 25 + 21 + 25 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + Z + 90 + 90 + -1 + -1 + 26 + 44 + 26 + -1 + -1 + 32 + 65 + 48 + 81 + 97 + 113 + + + + + 1 + 49 + 49 + -1 + -1 + -1 + 120 + -1 + -1 + -1 + -1 + 65 + -1 + -1 + -1 + -1 + + + + + 2 + 50 + 50 + -1 + -1 + -1 + 121 + -1 + -1 + -1 + -1 + 65 + -1 + -1 + -1 + -1 + + + + + 3 + 51 + 51 + -1 + -1 + -1 + 122 + -1 + -1 + -1 + -1 + 65 + -1 + -1 + -1 + -1 + + + + + 4 + 52 + 52 + -1 + -1 + -1 + 123 + -1 + -1 + -1 + -1 + 65 + -1 + -1 + -1 + -1 + + + + + 5 + 53 + 53 + -1 + -1 + -1 + 124 + -1 + -1 + -1 + -1 + 65 + -1 + -1 + -1 + -1 + + + + + 6 + 54 + 54 + -1 + -1 + -1 + 125 + -1 + -1 + -1 + -1 + 65 + -1 + -1 + -1 + -1 + + + + + 7 + 55 + 55 + -1 + -1 + -1 + 126 + -1 + -1 + -1 + -1 + 65 + -1 + -1 + -1 + -1 + + + + + 8 + 56 + 56 + -1 + -1 + -1 + 127 + -1 + -1 + -1 + -1 + 65 + -1 + -1 + -1 + -1 + + + + + 9 + 57 + 57 + -1 + -1 + -1 + 128 + -1 + -1 + -1 + -1 + 65 + -1 + -1 + -1 + -1 + + + + + 0 + 48 + 48 + -1 + -1 + 48 + 129 + -1 + -1 + -1 + 32 + 65 + -1 + 81 + 97 + 113 + + + + + BACKSPACE + 8 + 127 + -1 + -1 + 127 + 14 + -1 + -1 + -1 + 32 + 65 + -1 + -1 + 97 + -1 + Shift-Backspace = Shift-Ctrl-H + + + + HOME + 36 + 1 + -1 + 71 + 119 + -1 + 119 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + END + 35 + 6 + -1 + 79 + 117 + -1 + 117 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + PGUP + 33 + 18 + -1 + 73 + 132 + -1 + 132 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + PGDN + 34 + 3 + -1 + 81 + 118 + -1 + 118 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + INS + 45 + 22 + -1 + 82 + 146 + -1 + 146 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + DEL + 46 + 7 + -1 + 83 + 147 + -1 + 147 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + LEFTARROW + 37 + 19 + -1 + 75 + 115 + -1 + 115 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + RIGHTARROW + 39 + 4 + -1 + 77 + 116 + -1 + 116 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + UPARROW + 38 + 5 + -1 + 72 + 141 + -1 + 141 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + DOWNARROW + 40 + 24 + -1 + 80 + 145 + -1 + 145 + 17 + -1 + 32 + -1 + 49 + -1 + -1 + -1 + + + + + TAB + 9 + 9 + -1 + -1 + 148 + -1 + 148 + -1 + -1 + 32 + -1 + 31 + -1 + -1 + -1 + + + + + \ + 220 + 92 + -1 + -1 + 28 + -1 + -1 + -1 + -1 + 32 + -1 + -1 + -1 + -1 + -1 + + + + + ; + 186 + 59 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + ' + 222 + 39 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + , + 188 + 44 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + . + 190 + 46 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + / + 191 + 47 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + [ + 219 + 91 + -1 + 123 + -1 + -1 + -1 + 16 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + ] + 221 + 93 + -1 + 125 + 29 + -1 + -1 + 16 + -1 + 32 + -1 + -1 + -1 + -1 + -1 + + + + + = + 187 + 61 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + ENTER + 13 + 13 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + Shift-Enter = Shift-Ctrl-M + + + + ` + 192 + 96 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + - + 189 + 45 + -1 + -1 + -1 + -1 + 31 + -1 + -1 + -1 + -1 + 48 + -1 + -1 + -1 + + + + + ESC + 27 + 27 + -1 + 27 + -1 + -1 + -1 + 16 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + + + F1 + 112 + 28 + -1 + 84 + 94 + -1 + 94 + 17 + -1 + 33 + -1 + 49 + -1 + -1 + -1 + + + + + F2 + 113 + -1 + 60 + 85 + 95 + 105 + 95 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + F3 + 114 + -2 + 61 + 86 + 96 + 106 + 96 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + F4 + 115 + -3 + 62 + 87 + 97 + 107 + 97 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + F5 + 116 + -4 + 63 + 88 + 98 + 108 + 98 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + F6 + 117 + -5 + 64 + 89 + 99 + 109 + 99 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + F7 + 118 + -6 + 65 + 90 + 100 + 110 + 100 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + F8 + 119 + -7 + 66 + 91 + 101 + 111 + 101 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + F9 + 120 + -8 + 67 + 92 + 102 + 112 + 102 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + F10 + 121 + -9 + 68 + 93 + 103 + -1 + 103 + 17 + 1 + 33 + -1 + 49 + -1 + -1 + -1 + + + + + F11 + 122 + 133 + 133 + 135 + 137 + 139 + 137 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + F12 + 123 + 134 + 134 + 136 + 138 + 140 + 138 + 17 + 1 + 33 + 65 + 49 + 81 + 97 + 113 + + + + + SPACEBAR + 32 + 32 + -1 + 32 + 32 + -1 + -1 + 16 + -1 + 32 + -1 + -1 + -1 + -1 + -1 + + + + + + +
+ diff --git a/Thor/Source/peme_foxresource.vc2 b/Thor/Source/peme_foxresource.vc2 new file mode 100644 index 00000000..ee9b298a --- /dev/null +++ b/Thor/Source/peme_foxresource.vc2 @@ -0,0 +1,438 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="peme_foxresource.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS parameterx AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: this_access + *p: _memberdata && XML Metadata for customizable properties + * + + Name = "parameterx" + _memberdata = + + && XML Metadata for customizable properties + + PROCEDURE Init + Lparameters loDefaults + + This.oDefaults = loDefaults + ENDPROC + + PROCEDURE this_access + Lparameters tcMember + + If Pemstatus (This, tcMember, 5) ; + and (Pemstatus (This, tcMember, 4)) ; + And (Isnull( Getpem (This, tcMember))) ; + And (Not Upper(tcMember) == 'ODEFAULTS') ; + and (Not Pemstatus (This, tcMember, 6)) + Removeproperty(This, tcMember) + Endif + + If Not Pemstatus (This, tcMember, 5) + If 'O' = Vartype (This.oDefaults) And Pemstatus (This.oDefaults, tcMember, 5) + This.AddProperty (tcMember, Getpem (This.oDefaults, tcMember)) + Else + This.AddProperty (tcMember, Null) + Endif + Endif + + Return This + + ENDPROC + +ENDDEFINE + +DEFINE CLASS peme_resource AS parameterx OF "peme_foxresource.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: closeresource + *m: copysettings + *m: createresourcefile + *m: loadvalues && Occurs just before an object is created. + *m: openresource + *m: readme + *m: release && Releases a FormSet or Form from memory. + *m: resetdefaults + *m: restorecopiedsettings + *m: savevalues + *m: setresourcefile + *m: usedefaults + *p: cxid + *p: cxname + *p: cxresourcefile + *p: cxresourcetype + *p: ocopiedsettings + *p: oprefs + * + + cxid = + cxname = + cxresourcefile = + cxresourcetype = PREFW + Name = "peme_resource" + ocopiedsettings = .NULL. + _memberdata = + + + + + + + + + + + + + + + + + + + + + + PROCEDURE closeresource + Lparameters llPack + + Local lnSelect + + If Used("FoxResource") + lnSelect = Select() + If llPack + Select FoxResource + Try + Use (Dbf()) Exclusive Alias FoxResource + Pack + Catch + + Endtry + Endif + If Used("FoxResource") + Use In FoxResource + EndIf + + Select(lnSelect) + Endif + + ENDPROC + + PROCEDURE copysettings + Local laMembers(1), lcMember, lxValue, lnI + + With This + .oCopiedSettings = Createobject('Empty') + + Amembers (laMembers, This, 3, 'PHG#') + For m.lnI = 1 To Alen (laMembers, 1) + If laMembers (lnI, 2) = 'P' And Not 'I' $ laMembers (lnI, 5) + lcMember = laMembers (lnI, 1) + lxValue = Getpem (This, lcMember) + AddProperty(.oCopiedSettings, lcMember, lxValue) + Endif + Endfor + Endwith + + + + ENDPROC + + PROCEDURE createresourcefile + Lparameters tcFileName + + This.CloseResource() + + Create Table (tcFileName) Free ( ; + Type C (12), ; + Id C (12), ; + Name M, ; + ReadOnly L, ; + ckval N (6), ; + Data M, ; + Updated D ; + ) + Use + + This.cxResourceFile = Fullpath (tcFileName) + + ENDPROC + + PROCEDURE Destroy + This.Release() + ENDPROC + + PROCEDURE Init + If Set ('RESOURCE') == 'ON' + This.SetResourceFile (Sys(2005)) + Else + This.SetResourceFile ('') + Endif + + + ENDPROC + + PROCEDURE loadvalues && Occurs just before an object is created. + Lparameters cxID, cxName + + Local lcType, lnCnt, lnI, lnSelect + + If This.OpenResource() + + m.cxID = Evl (m.cxID, '') + m.cxName = Evl (m.cxName, '') + + With This + .cxID = cxID + .cxName = cxName + Endwith + + m.lnSelect = Select() + + m.lcType = Padr (This.cxResourceType, Len (FoxResource.Type)) + m.cxID = Padr (m.cxID, Len (FoxResource.Id)) + + Select FoxResource + Locate For ; + Upper(Type) == Upper(m.lcType) ; + And Upper(Id) == Upper(m.cxID) ; + And Upper(Name) == Upper(m.cxName) + If Found() And Not Empty (Data) And ckval == Val (Sys(2007, Data)) + Restore From Memo Data Additive + If Vartype (aOptions[1, 1]) == 'C' + m.lnCnt = Alen (aOptions, 1) + For m.lnI = 1 To m.lnCnt + Try + This.AddProperty (aOptions[m.lnI, 1], aOptions[m.lnI, 2]) + Catch + + Endtry + Endfor + Endif + Endif + + This.CloseResource() + + Select (m.lnSelect) + Endif + ENDPROC + + PROCEDURE openresource + If Not Used ('FoxResource') + If File (This.cxResourceFile) + Try + Use (This.cxResourceFile) Alias FoxResource In 0 Shared Again + Catch + Endtry + Endif + Endif + Return Used ('FoxResource') + + ENDPROC + + PROCEDURE readme + #If .F. + + (1) Setup (and possibly create) Resource file: + This.SetResourceFile (lcFileName, CreateIfMissingFlag) + + (2) Set up default values (optional step): + This.UseDefaults() + + This.oDefaults.Property1 = SomeValue + This.oDefaults.Property2 = SomeValue + etc + + (3) Read current settings from the resource file + This.LoadValues(cKey1, cKey2) + cKey1 and cKey2 allow for multiple resource settings on the same file. Records found + will match both keys. If either is not supplied, '' is used. + + (4) Read Values: + ? This.Property1 + Returns: + the value of the property, if it has been set + else, the value of the saved property + else, the default value for the property + else, .null. + + (5) Assign Values: + This.SomeProperty = SomeValue + + (6) Save results back to Resource File + This.SaveValues() + + + Notes: + (A) Assign .Null. to a value resets it to default + (B) If step 2 is not used, any properties created (step (5)) will be saved + (C) If default values are used, only properties that have defaults will be saved. + + #Endif + ENDPROC + + PROCEDURE release && Releases a FormSet or Form from memory. + Local laMembers(1), lcMember + Amembers (laMembers, This, 0) + For Each lcMember In laMembers + lcMember = Upper (lcMember) + If lcMember = 'O' And Pemstatus(This, lcMember, 4) And 'O' = Vartype (Getpem (This, lcMember)) + This.&lcMember. = .Null. + Endif + Endfor + + ENDPROC + + PROCEDURE resetdefaults + Lparameters llRemoveAll + + Local laMembers(1), lcMember, lxDefault, lxValue, lnI + + If 'O' # Vartype (This.oDefaults) + Return + Endif + + Amembers (laMembers, This, 3, 'PHG#') + + For m.lnI = 1 To Alen (laMembers, 1) + If laMembers (lnI, 2) = 'P' And Not 'I' $ laMembers (lnI, 5) + lcMember = laMembers (lnI, 1) + If llRemoveAll + Removeproperty(This, lcMember) + Else + lxValue = Getpem (This, lcMember) + If Pemstatus (This.oDefaults, lcMember, 5) And Upper(lcMember) # 'ODEFAULTS' + lxDefault = Getpem (This.oDefaults, lcMember) + This.AddProperty(lcMember, lxDefault) + Endif + Endif + Endif + Endfor + + ENDPROC + + PROCEDURE restorecopiedsettings + Local laMembers(1), lcMember, lxValue, lnI + + With This + Amembers (laMembers, This, 3, 'PHG#') + For m.lnI = 1 To Alen (laMembers, 1) + If laMembers (lnI, 2) = 'P' And Not 'I' $ laMembers (lnI, 5) + lcMember = laMembers (lnI, 1) + If Pemstatus(.oCopiedSettings, lcMember, 5) + lxValue = Getpem (.oCopiedSettings, lcMember) + This.AddProperty(lcMember, lxValue) + Else + Removeproperty(This, lcMember) + Endif + Endif + Endfor + Endwith + + ENDPROC + + PROCEDURE savevalues + Lparameters cxID, cxName + + Local laMembers[1], lcMember, lcType, llAddIt, lnI, lnRow, lnSelect, lxDefault, lxValue + Local aOptions[1] + + If This.OpenResource() + + m.cxID = Evl (m.cxID, This.cxID) + m.cxName = Evl (m.cxName, This.cxName) + + m.lnSelect = Select() + + m.lcType = Padr (This.cxResourceType, Len (FoxResource.Type)) + m.cxID = Padr (m.cxID, Len (FoxResource.Id)) + + Select FoxResource + Locate For ; + Upper(Type) == Upper(m.lcType) ; + And Upper(Id) == Upper(m.cxID) ; + And Upper(Name) == Upper(m.cxName) + If Not Found() + Append Blank In FoxResource + Replace ; + Type With m.lcType, ; + Name With m.cxName, ; + Id With m.cxID, ; + ReadOnly With .F. ; + In FoxResource + Endif + + Amembers (laMembers, This, 3, 'PHG#') + lnRow = 0 + Dimension aOptions[1, 2] + aOptions(1, 1) = 'A' + + For m.lnI = 1 To Alen (laMembers, 1) + If laMembers (lnI, 2) = 'P' And Not 'I' $ laMembers (lnI, 5) + lcMember = laMembers (lnI, 1) + lxValue = Getpem (This, lcMember) + Do Case + Case Upper(lcMember) = 'ODEFAULTS' + llAddIt = .F. + Case 'O' = Vartype (lxValue) + llAddIt = .F. + Case Isnull (lxValue) + llAddIt = .F. + Case 'O' = Vartype (This.oDefaults) + If Pemstatus (This.oDefaults, lcMember, 5) + lxDefault = Getpem (This.oDefaults, lcMember) + llAddIt = (Vartype(lxValue) # Vartype(lxDefault)) Or Not lxValue == lxDefault + Else + llAddIt = .F. + Endif + Otherwise + llAddIt = .T. + Endcase + + If llAddIt + lnRow = lnRow + 1 + Dimension aOptions[lnRow, 2] + aOptions[m.lnRow, 1] = lcMember + aOptions[m.lnRow, 2] = lxValue + Endif + + Endif + Endfor + Save To Memo Data All Like aOptions + + Replace ; + Updated With Date(), ; + ckval With Val (Sys(2007, FoxResource.Data)) ; + In FoxResource + + This.CloseResource (.T.) + + Select (m.lnSelect) + Endif + + ENDPROC + + PROCEDURE setresourcefile + Lparameters lcResourceFile, llCreateIfMissing + + If llCreateIfMissing And Not File (lcResourceFile) + This.CreateResourceFile (lcResourceFile) + Else + This.cxResourceFile = lcResourceFile + Endif + ENDPROC + + PROCEDURE usedefaults + This.oDefaults = Newobject ('ParameterX', 'PEME_FoxResource.VCX') + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thor.pj2 b/Thor/Source/thor.pj2 new file mode 100644 index 00000000..49442e45 --- /dev/null +++ b/Thor/Source/thor.pj2 @@ -0,0 +1,136 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor.pjx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +LPARAMETERS tcDir + +lcCurdir = SYS(5)+CURDIR() +CD ( EVL( tcDir, JUSTPATH( SYS(16) ) ) ) + +* +_Author = "" +_Company = "" +_Address = "" +_City = "" +_State = "" +_PostalCode = "" +_Country = "" +*-- +_Comments = "" +_CompanyName = "" +_FileDescription = "" +_LegalCopyright = "" +_LegalTrademark = "" +_ProductName = "" +_MajorVer = "" +_MinorVer = "" +_Revision = "" +_LanguageID = "" +_AutoIncrement = "0" +* + + +* +*<.HomeDir = 'c:\users\dhennig\desktop\thor\thor\source' /> + +FOR EACH loProject IN _VFP.Projects FOXOBJECT + loProject.Close() +ENDFOR + +STRTOFILE( '', '__newproject.f2b' ) +BUILD PROJECT thor.pjx FROM '__newproject.f2b' +FOR EACH loProject IN _VFP.Projects FOXOBJECT + loProject.Close() +ENDFOR + +MODIFY PROJECT 'thor.pjx' NOWAIT NOSHOW NOPROJECTHOOK + +loProject = _VFP.Projects('thor.pjx') + +WITH loProject.FILES + .ADD('..\..\..\..\..\..\..\program files (x86)\microsoft visual foxpro 9\foxtools.fll') && *< FileMetadata: Type="L" Cpid="0" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('basecontrols.vcx') && *< FileMetadata: Type="V" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('createtool.scx') && *< FileMetadata: Type="K" Cpid="0" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('down.bmp') && *< FileMetadata: Type="x" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('filtertool.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('foxresource.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('hotkeys.dbf') && *< FileMetadata: Type="D" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('lockwindow.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('menus.ico') && *< FileMetadata: Type="x" Cpid="0" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('peme_foxresource.vcx') && *< FileMetadata: Type="V" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('peme_winapisupport.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('popup.ico') && *< FileMetadata: Type="x" Cpid="0" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('programs.ico') && *< FileMetadata: Type="x" Cpid="0" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('quotesaroundlongtext.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('refhelp.bmp') && *< FileMetadata: Type="x" Cpid="0" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('refresh2.bmp') && *< FileMetadata: Type="x" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('tables\hotkeydefinitions.dbf') && *< FileMetadata: Type="D" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('tables\menudefinitions.dbf') && *< FileMetadata: Type="D" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('tables\menutools.dbf') && *< FileMetadata: Type="D" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('tables\thor.dbf') && *< FileMetadata: Type="D" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('tables\toolhotkeyassignments.dbf') && *< FileMetadata: Type="D" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor.h') && *< FileMetadata: Type="T" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor.ico') && *< FileMetadata: Type="x" Cpid="0" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor.vcx') && *< FileMetadata: Type="V" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('thor16.ico') && *< FileMetadata: Type="x" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor16.png') && *< FileMetadata: Type="x" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor_english.h') && *< FileMetadata: Type="T" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor_foxresource.vcx') && *< FileMetadata: Type="V" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('thor_left_arrow.bmp') && *< FileMetadata: Type="x" Cpid="0" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor_main.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="BQAJAHRob3JfdWkuaLby0FxMTQYAdGhvci5ovvPQXExNSAAuLlwuLlwuLlwuLlwuLlwuLlxwcm9ncmFtIGZpbGVzICh4ODYpXG1pY3Jvc29mdCB2aXN1YWwgZm94cHJvIDlcZm94cHJvLmjG9AuKiTEOAHRob3JfZW5nbGlzaC5ozvXQXExNDQB0aG9ydmVyc2lvbi5o1vbQXExN" /> + .ADD('thor_menu.vcx') && *< FileMetadata: Type="V" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('thor_right_arrow.bmp') && *< FileMetadata: Type="x" Cpid="0" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor_run.vcx') && *< FileMetadata: Type="V" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('thor_sf_splitter.vcx') && *< FileMetadata: Type="V" Cpid="0" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('thor_sfcombotree.vcx') && *< FileMetadata: Type="V" Cpid="0" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('thor_starting_prgs.dbf') && *< FileMetadata: Type="D" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor_ui.h') && *< FileMetadata: Type="T" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + .ADD('thor_ui.vcx') && *< FileMetadata: Type="V" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('thor_utils.vcx') && *< FileMetadata: Type="V" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('thorformruntool.scx') && *< FileMetadata: Type="K" Cpid="0" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('thorui.scx') && *< FileMetadata: Type="K" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('up.bmp') && *< FileMetadata: Type="x" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> + * + + .ITEM('__newproject.f2b').Remove() + + * + * + + * + .ITEM(lcCurdir + '..\..\..\..\..\..\..\program files (x86)\microsoft visual foxpro 9\foxtools.fll').Exclude = .T. + .ITEM(lcCurdir + 'tables\hotkeydefinitions.dbf').Exclude = .T. + .ITEM(lcCurdir + 'tables\menudefinitions.dbf').Exclude = .T. + .ITEM(lcCurdir + 'tables\menutools.dbf').Exclude = .T. + .ITEM(lcCurdir + 'tables\thor.dbf').Exclude = .T. + .ITEM(lcCurdir + 'tables\toolhotkeyassignments.dbf').Exclude = .T. + * + + * + .ITEM(lcCurdir + 'thor.h').Type = 'T' + .ITEM(lcCurdir + 'thor_english.h').Type = 'T' + .ITEM(lcCurdir + 'thor_ui.h').Type = 'T' + * +ENDWITH + +WITH loProject + * + .SetMain(lcCurdir + 'thor_main.prg') + .Debug = .T. + .Encrypted = .F. + *<.CmntStyle = 1 /> + *<.NoLogo = .F. /> + *<.SaveCode = .T. /> + *<.User = '' /> + .ProjectHookLibrary = '' + .ProjectHookClass = '' + * +ENDWITH + + +_VFP.Projects('thor.pjx').Close() +*ERASE '__newproject.f2b' +CD (lcCurdir) +RETURN \ No newline at end of file diff --git a/Thor/Source/thor.vc2 b/Thor/Source/thor.vc2 new file mode 100644 index 00000000..3cd9a18e --- /dev/null +++ b/Thor/Source/thor.vc2 @@ -0,0 +1,1973 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS othor AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor.h" + * + *m: do + *m: executethorproc + *m: getfullfilename + *p: cappfolder + *p: _memberdata && XML Metadata for customizable properties + * + + cappfolder = .F. + Name = "othor" + _memberdata = + + + + + && XML Metadata for customizable properties + + PROCEDURE do + LParameters lcPRGName, lxP1, lxP2, lxP3, lxP4, lxP5, lxP6, lxP7, lxP8, lxP9, lxP10 + + Local loGetThor As 'GetThorRun' + Local lcFile, lcFolder, lcSys16, lcThorApp, lcThorFolder, llFirst, llThorInkey, lnI, lnInkey, lnPopUpID + Local lnWindowOnTop, loLink, loPEME_Tools, loResult, loThorEngine, loThorInfo, loThorRun + + lcFolder = This.cAppFolder + lcThorApp = lcFolder + 'Thor.APP' + lcThorFolder = lcFolder + 'Thor\' + llThorInkey = .F. + + Do Case + Case Atc('Thor_', lcPrgName) = 1 + Return This.ExecuteThorProc(lcPRGName, lcThorFolder, llThorInkey, .F., Pcount(), @lxP1, @lxP2, @lxP3, @lxP4, @lxP5, @lxP6, @lxP7, @lxP8, @lxP9, @lxP10) + + Case Atc([Full Path=], lcPrgName) = 1 + lcFile = This.GetFullFileName (Alltrim (Substr (lcPRGName, At ('=', lcPRGName) + 1)), lcThorFolder) + Return lcFile + + Case Atc([Class=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcherClasses, lcPRGName, lcThorAPP, Pcount(), lxP1, lxP2, lxP3, lxP4, lxP5) + + Case Atc([PopupID=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName) + + Case Atc([Result=], lcPrgName) = 1 + _Screen.xThorResult = lxP1 + Return lxP1 + + Case Empty (lcPRGName) + Do (lcThorApp) With 'Edit' + + Case Atc([FORMRUNTOOL], lcPrgName) = 1 + Do (lcThorApp) With 'FORMRUNTOOL' + + Case Atc([?], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcherHelp) + + Case Atc([Run], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName) + + Case Atc([Tool Folder=], lcPrgName) = 1 + Return lcThorFolder + 'Tools\' + + Case Atc([Version=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName) + + Case Atc([Thor Engine=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName) + + Case Atc([Thor Register=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName) + + Case Atc([Get Option=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName, lxP1, lxP2) + + Case Atc([Set Option=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName, lxP1, lxP2, lxP3) + + Case Atc([Thor Template Code=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName) + + Case Atc([Clear HotKeys], lcPrgName) = 1 + Do (lcThorApp) With 'Clear HotKeys' + + Case Atc([Toggle Debug Mode], lcPrgName) = 1 + _Screen.lThorDebugMode = not _Screen.lThorDebugMode + Set Mark of Bar 6 of Menu_4NU0XBVVF to _Screen.lThorDebugMode + If _Screen.lThorDebugMode + Set Asserts on + EndIf + + Case Atc([Edit=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName) + + Case Atc([Link=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName) + + * Get ToolInfo for tool + Case Atc([ToolInfo=], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcher, lcPrgName, lxP1) + + Case Atc([DoDefault()], lcPrgName) = 1 + lcPRGName = '' + llFirst = .F. + For lnI = Program (-1) To 1 Step - 1 + lcSys16 = Sys(16, lnI) + Do Case + Case Upper (Getwordnum (lcSys16, 1)) = 'PROCEDURE' + Case Not llFirst + llFirst = .T. + Otherwise + lcPRGName = JustStem (lcSys16) + Exit + Endcase + Endfor + + Return This.ExecuteThorProc (lcPRGName, lcThorFolder, llThorInkey, .T., Pcount(), @lxP1, @lxP2, @lxP3, @lxP4, @lxP5, @lxP6, @lxP7, @lxP8, @lxP9, @lxP10) + + Otherwise + Return This.ExecuteThorProc(lcPRGName, lcThorFolder, llThorInkey, .F., Pcount(), @lxP1, @lxP2, @lxP3, @lxP4, @lxP5, @lxP6, @lxP7, @lxP8, @lxP9, @lxP10) + + Endcase + + Return + + + ENDPROC + + PROCEDURE executethorproc + Lparameters lcPRGName, lcThorFolder, llThorInkey, llDoDefault, lnPCount, lxP1, lxP2, lxP3, lxP4, lxP5, lxP6, lxP7, lxP8, lxP9, lxP10, lcFileText + + Local lcFullPRGName, lcParams, lnI + lcFullPRGName = This.GetFullFileName(m.lcPRGName, m.lcThorFolder, m.llDoDefault) + If Empty(m.lcFullPRGName) + Return .Null. + Endif + + _Screen.lThorInkey = _Screen.lThorInkey Or m.llThorInkey + _Screen.xThorResult = .T. + If m.lnPCount < 2 + lcParams = '' + Else + lcParams = 'with lxP1' + For lnI = 2 To m.lnPCount - 1 + *** DH 2018-10-12: as suggested by Toni Koehler, use ALLTRIM(STR()) instead of + *** TRANSFORM() because with SET POINT TO ',' and SET FIXED ON, TRANSFORM(1) + *** gives "1,000" which looks like multiple parameters: lcP1,lxP2,000,lxP3,000, etc. + * lcParams = m.lcParams + ', lxP' + Transform(m.lnI) + lcParams = m.lcParams + ', lxP' + alltrim(str(m.lnI)) + Endfor + Endif + + Assert Not _Screen.lThorDebugMode Message 'Debug: ' + Juststem(m.lcFullPRGName) + Do(m.lcFullPRGName) &lcParams + + _Screen.lThorInkey = _Screen.lThorInkey And Type('llThorInkey') = 'L' And Not m.llThorInkey + Return _Screen.xThorResult + + ENDPROC + + PROCEDURE getfullfilename + Lparameters lcPRGName, lcThorFolder, llDoDefault + Local lcFile, lcFullPRGName1, lcFullPRGName2, lcFullPRGName3 + + If Empty(Justext(m.lcPRGName)) + lcFile = Forceext (m.lcPRGName, 'prg') + Else + lcFile = m.lcPRGName + Endif + lcFullPRGName1 = Forcepath (m.lcFile, m.lcThorFolder + 'Tools\' + ccMyTools) + lcFullPRGName2 = Forcepath (m.lcFile, m.lcThorFolder + 'Tools\' + ccProcs) + lcFullPRGName3 = Forcepath (m.lcFile, m.lcThorFolder + 'Tools\') + Do Case + Case File (m.lcFile) And Not m.llDoDefault + lcFile = Fullpath (m.lcFile) + Case File (m.lcFullPRGName1) And Not m.llDoDefault + lcFile = m.lcFullPRGName1 + Case File (m.lcFullPRGName2) + lcFile = m.lcFullPRGName2 + Case File (m.lcFullPRGName3) + lcFile = m.lcFullPRGName3 + Otherwise + lcFile = '' + Endcase + Return m.lcFile + + ENDPROC + + PROCEDURE Init + lparameters tcFolder + local lcFolder + This.cAppFolder = Addbs(JustPath(JustPath(tcFolder))) + *** JRN 2011-04-14 : + Set Deleted On + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_engine AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor_ui.h" + * + *m: addfoldertools + *m: additemtomenu && Adds an item (tool or separator) to a menu + *m: addmenu && Adds a menu to the Thor tables + *m: addsubmenu && Adds a submenu + *m: addtoolhotkey && Adds a hotkey to a tool + *m: diskfilename + *m: findfile && Finds a file in one of Thor's paths + *m: findoption + *m: getitembyposition && Returns the ID for an item in the specified menu by its order in the menu + *m: getkeydesc + *m: getkeydescriptionfromkeycode + *m: getkeyvaluefromkeyname + *m: getmacrodefinitions + *m: getmenubyname && Returns the ID for the menu with the specified name + *m: getmenuitems && Returns a list of items in the specified menu + *m: getonkeylabeldefinitions + *m: getoption && Returns the value of the specified Thor option + *m: gettableforalias + *m: gettooldescription + *m: gettoolscollection && Returns a collection with registered tools + *m: opentable + *m: opentables && Opens the Thor tables + *m: packtable + *m: packtables + *m: removeitemfrommenu && Removes the specified item from the specified menu + *m: removemenu && Removes the specified menu + *m: removetool + *m: removetoolhotkey && Removes the hot key for the specified tool + *m: renumbermenuitems && Renumbers the items for the specified menu so there are no gaps in the sequence + *m: renumbermenus && Renumbers all menus so there are no gaps in the sequence + *m: setmenuprompt + *m: setoption + *p: cappfolder + *p: ctablesfolder && The folder for the Thor tables + *p: cthorfolder + *p: ctoolsfolder && The folder for the Thor tools + *p: cversion && The Thor version number + *p: _memberdata && XML Metadata for customizable properties + * + + cappfolder = .F. + ctablesfolder = && The folder for the Thor tables + cthorfolder = + ctoolsfolder = && The folder for the Thor tools + cversion = 0.4 && The Thor version number + Name = "thor_engine" + Width = 17 + _memberdata = + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + && XML Metadata for customizable properties + + PROCEDURE addfoldertools + Lparameters toTools, tcFolder, tlPrivateCopy + + * Get a list of PRGs in the specified folder. + + Local loThorInfo As 'ThorInfo' Of 'Thor_Utils.vcx' + Local laTools[1], lcCategories, lcCategory, lcTool, lcUpperTool, lnI, lnJ, lnSort, lnTools + Local loException + + lnTools = Adir (laTools, tcFolder + ccTOOLNAMEPREFIX + '*.prg', '', 1) + + * Get the information for each tool and add it to the collection. + + For lnI = 1 To lnTools + lcTool = laTools[lnI, 1] + loThorInfo = Newobject ('ThorInfo', 'Thor_Utils.vcx') + Try + Do (tcFolder + lcTool) With loThorInfo + If Not Empty (loThorInfo.Prompt) + lcUpperTool = Upper (lcTool) + + Do Case + Case 0 = toTools.GetKey (lcUpperTool) + lcCategories = Trim (Evl (loThorInfo.Category, Evl (loThorInfo.Source, '(None)'))) + lnSort = Evl (loThorInfo.Sort, 9999) + loThorInfo.PRGName = lcTool + loThorInfo.FullFileName = tcFolder + lcTool + loThorInfo.PrivateCopy = Iif(tlPrivateCopy, 1, 0) + + For lnJ = 1 To Getwordcount (lcCategories, ccCR) + lcCategory = Getwordnum (lcCategories, lnJ, ccCR) + loThorInfo.InternalSort = Upper (lcCategory + '|' + Iif (lnSort < 0, ' ', '~') + Str (Abs (lnSort), 5) + loThorInfo.Prompt) + loThorInfo.Category = lcCategory + toTools.Add (loThorInfo, lcUpperTool + Iif (lnJ = 1, '', Transform (lnJ))) + Endfor + Case Not tlPrivateCopy + toTools.Item[lcUpperTool].PrivateCopy = -1 + Endcase + + Endif Not Empty (loThorInfo.Prompt) + Catch To loException + *** fail silently + Endtry + Next lnI + + ENDPROC + + PROCEDURE additemtomenu && Adds an item (tool or separator) to a menu + *============================================================================== + * Method: AddItemToMenu + * Purpose: Adds an item (tool or separator) to a menu + * Author: Doug Hennig + * Last revision: 03/23/2011 + * Parameters: tnMenuID - the ID for the menu this belongs to + * (required) + * tcPRGName - the PRG name of the tool (ignored if + * tlSeparator is .T.; required if .F.) + * tcPrompt - the prompt for the item (ignored if + * tlSeparator is .T.; required if .F.) + * tlSeparator - .T. if this is a separator + * tnOrder - the order for the menu (optional: if it + * isn't passed, this menu appears at the bottom of the + * menu it's in) + * tcStatusBarText - the status bar text (optional) + * Returns: the ID of the new item + * Environment in: see This.OpenTables for requirements + * Environment out: MenuTools is positioned to the new record + * MenuDefinitions is positioned to the menu the item is added + * to + *============================================================================== + + lparameters tnMenuID, ; + tcPRGName, ; + tcPrompt, ; + tlSeparator, ; + tnOrder, ; + tcStatusBarText + local laOrder[1], ; + lnOrder, ; + lcPRGName, ; + lcPrompt + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + do case + case vartype(tnMenuID) <> 'N' or ; + not seek(tnMenuID, 'MenuDefinitions', 'ID') + error 11 + case vartype(tlSeparator) <> 'L' + error 11 + *!* * Removed 2/28/2012 + *!* case not tlSeparator and (vartype(tcPRGName) <> 'C' or empty(tcPRGName)) + *!* error 11 + *!* * Removed 2/28/2012 + *!* case not tlSeparator and (vartype(tcPrompt) <> 'C' or empty(tcPrompt)) + *!* error 11 + case vartype(tnOrder) <> 'L' and (vartype(tnOrder) <> 'N' or tnOrder < 1) + error 11 + case not inlist(vartype(tcStatusBarText), 'L', 'C') + error 11 + endcase + + * If an order wasn't specified, get the next SortOrder value to use. + + if vartype(tnOrder) <> 'N' + select max(SortOrder) from MenuTools into array laOrder ; + where MenuID = tnMenuID + lnOrder = Nvl(Evl(laOrder[1],0), 0) + 1 + endif vartype(tnOrder) <> 'N' + + * Add a record for the menu. + + lcPRGName = iif(tlSeparator, '', tcPRGName) + lcPrompt = iif(tlSeparator, '\-', tcPrompt) + insert into MenuTools (MenuID, PRGName, SortOrder, Prompt, Separator, StatusBar) ; + values (tnMenuID, lcPRGName, lnOrder, lcPrompt, tlSeparator, evl(tcStatusBarText, '')) + return MenuTools.ID + + ENDPROC + + PROCEDURE addmenu && Adds a menu to the Thor tables + *============================================================================== + * Method: AddMenu + * Purpose: Adds a menu to the Thor tables + * Author: Doug Hennig + * Last revision: 04/25/2011 + * Parameters: tcPrompt - the prompt for the menu (required) + * tlTopLevel - .T. for a top-level menu (if both tlTopLevel + * and tlPopup are .F., this is a submenu so tnParentID + * is required) + * tlPopup - .T. for a popup menu + * tnOrder - the order for the menu (optional: if it + * isn't passed, this menu appears at the bottom of the + * menu it's in for a submenu or at the right end of the + * menu bar for a top-level menu; not used if only a popup + * menu ie. tlTopLevel is .F.) + * tcStatusBarText - the status bar text (optional) + * tnKeyCode - the key code for the hot key (optional; + * if passed, same value as passed to TextBox.KeyPress) + * tnShiftCtrlAlt - the status of the modifier keys for the + * hot key (optional; if passed, same value as passed to + * TextBox.KeyPress) + * tcPopupName - the name for the popup menu (optional: if + * it isn't passed, SYS(2015) is used) + * Returns: the ID of the new menu or 0 if it wasn't added + * Environment in: see This.OpenTables for requirements + * Environment out: a record was added to MenuDefinitionsm, which is positioned + * to the new record + * a record may have been added to HotKeyDefinitions and it + * may be positioned to the record for the hotkey + *============================================================================== + + lparameters tcPrompt, ; + tlTopLevel, ; + tlPopup, ; + tnOrder, ; + tcStatusBarText, ; + tnKeyCode, ; + tnShiftCtrlAlt, ; + tcPopupName + local lcPopupName, ; + lnOrder, ; + laOrder[1], ; + lnHotKeyID, ; + loKey, ; + lnSelect, ; + lcDescrip, ; + lcFkyValue, ; + lnID + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + do case + case vartype(tcPrompt) <> 'C' or empty(tcPrompt) + error 11 + case vartype(tlTopLevel) <> 'L' or vartype(tlPopup) <> 'L' + error 11 + *!* * Removed 9/9/2011 + *!* case not tlTopLevel and not tlPopup + *!* error 11 + case vartype(tnOrder) <> 'L' and (vartype(tnOrder) <> 'N' or tnOrder < 1) + error 11 + case not inlist(vartype(tcStatusBarText), 'L', 'C') + error 11 + case vartype(tnKeyCode) <> 'L' and (vartype(tnKeyCode) <> 'N' or ; + not seek(tnKeyCode, 'HotKeys', 'KeyCode')) + error 11 + case vartype(tnShiftCtrlAlt) <> 'L' and (vartype(tnShiftCtrlAlt) <> 'N' or ; + tnShiftCtrlAlt < 0) + error 11 + case vartype(tcPopupName) <> 'L' and (vartype(tcPopupName) <> 'C' or ; + empty(tcPopupName)) + error 11 + endcase + + * Assign the popup name. + + lcPopupName = iif(vartype(tcPopupName) = 'C', tcPopupName, sys(2015)) + + * If we're adding the menu to the top level and an order wasn't specified, get + * the next SortOrder value to use. + + do case + case not tlTopLevel + lnOrder = 0 + case vartype(tnOrder) <> 'N' + select max(SortOrder) from MenuDefinitions into array laOrder ; + where TopLevel + lnOrder = Nvl(Evl(laOrder[1],0), 0) + 1 + otherwise + lnOrder = tnOrder + endcase + + * If a keycode was specified, see if it exists and if it's already used. + + lnHotKeyID = 0 + if vartype(tnKeyCode) = 'N' and vartype(tnShiftCtrlAlt) = 'N' + loKey = newobject('HotKey', 'Thor_Utils.vcx') + loKey.nScanCode = HotKeys.ScanCode + && we use the scan code not the key code + loKey.lShift = bittest(tnShiftCtrlAlt, 0) + loKey.lCtrl = bittest(tnShiftCtrlAlt, 1) + loKey.lAlt = bittest(tnShiftCtrlAlt, 2) + lnSelect = select() + select HotKeyDefinitions + locate for nKeyCode = HotKeys.ScanCode and nShifts = tnShiftCtrlAlt + do case + case not loKey.IsValid() + *** need to handle this. Use ERROR to throw error? + *** This.cErrorMessage = 'already used' + lnHotKeyID = -1 + case not found() + lcDescrip = loKey.GetHotKeyDescription() + lcFkyValue = loKey.GetKeyCode() + insert into HotKeyDefinitions (nKeyCode, nShifts, Descript, FkyValue) ; + values (HotKeys.ScanCode, tnShiftCtrlAlt, lcDescrip, lcFkyValue) + lnHotKeyID = ID + case seek(HotKeyDefinitions.ID, 'MenuDefinitions', 'HotKeyID') + *** need to handle this. Use ERROR to throw error? + *** This.cErrorMessage = 'already used' + lnHotKeyID = -1 + otherwise + lnHotKeyID = ID + endcase + select (lnSelect) + *!* * Removed 9/9/2011 + *!* *** JRN 2011-04-14 : if no hot keys, can't be a pop-up menu + *!* * this allows creation of sub-menus (neither top-level nor popup) + *!* Else + *!* tlPopup = .F. + endif vartype(tnKeyCode) = 'N' ... + + * Add a record for the menu. + + if lnHotKeyID >= 0 + insert into MenuDefinitions ; + (Prompt, TopLevel, Popup, PopupName, SortOrder, HotKeyID, StatusBar) ; + values (tcPrompt, tlTopLevel, tlPopup, lcPopupName, lnOrder, lnHotKeyID, ; + evl(tcStatusBarText, '')) + lnID = MenuDefinitions.ID + else + lnID = 0 + endif lnHotKeyID >= 0 + return lnID + + ENDPROC + + PROCEDURE addsubmenu && Adds a submenu + *============================================================================== + * Method: AddSubMenu + * Purpose: Adds a submenu + * Author: Doug Hennig + * Last revision: 04/16/2011 + * Parameters: tnParentID - the ID for the menu this is a submenu of + * (required) + * tnMenuID - the ID of an existing menu if we're adding + * it as a submenu (optional: if it isn't passed, a new + * menu is created) + * tcPrompt - the prompt for the menu (required if tnMenuID + * is not passed) + * tnOrder - the order for the menu (optional: if it + * isn't passed, this menu appears at the bottom of the + * menu it's in) + * tcStatusBarText - the status bar text (optional) + * Returns: the ID of the new menu + * Environment in: see This.OpenTables for requirements + * Environment out: MenuDefinitions and MenuTools are positioned to the new + * records + *============================================================================== + + lparameters tnParentID, ; + tnMenuID, ; + tcPrompt, ; + tnOrder, ; + tcStatusBarText + local lcPopupName, ; + laOrder[1], ; + lnOrder, ; + lnMenuID, ; + lcPrompt + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + do case + case vartype(tnParentID) <> 'N' and ; + not seek(tnParentID, 'MenuDefinitions', 'ID') + error 11 + case (vartype(tnMenuID) = 'N' and ; + not seek(tnMenuID, 'MenuDefinitions', 'ID')) + error 11 + case vartype(tnMenuID) <> 'N' and vartype(tnMenuID) <> 'L' + error 11 + case vartype(tnMenuID) = 'L' and (vartype(tcPrompt) <> 'C' or ; + empty(tcPrompt)) + error 11 + case vartype(tnOrder) <> 'L' and (vartype(tnOrder) <> 'N' or tnOrder < 1) + error 11 + case not inlist(vartype(tcStatusBarText), 'L', 'C') + error 11 + endcase + + * Assign the popup name. + + lcPopupName = sys(2015) + + * If an order wasn't specified, get the next SortOrder value to use. + + if vartype(tnOrder) <> 'N' + select max(SortOrder) from MenuTools into array laOrder ; + where MenuID = tnParentID + lnOrder = Nvl(Evl(laOrder[1],0), 0) + 1 + endif vartype(tnOrder) <> 'N' + + * Add a record for the menu. + + if vartype(tnMenuID) = 'N' + lnMenuID = tnMenuID + lcPrompt = Evl( tcPrompt, MenuDefinitions.Prompt) + else + insert into MenuDefinitions ; + (Prompt, PopupName, StatusBar) ; + values (tcPrompt, lcPopupName, evl(tcStatusBarText, '')) + lnMenuID = MenuDefinitions.ID + lcPrompt = tcPrompt + endif vartype(tnMenuID) = 'N' + insert into MenuTools (MenuID, SubMenuID, SortOrder, Prompt) ; + values (tnParentID, lnMenuID, lnOrder, lcPrompt) + return MenuDefinitions.ID + + ENDPROC + + PROCEDURE addtoolhotkey && Adds a hotkey to a tool + *============================================================================== + * Method: AddToolHotKey + * Purpose: Adds a hotkey to a tool + * Author: Doug Hennig + * Last revision: 04/25/2011 + * Parameters: tcPRGName - the PRG name of the tool (required) + * tnKeyCode - the key code for the hot key (optional; + * if passed, same value as passed to TextBox.KeyPress; + * if not passed, any existing hotkey assignment is + * cleared) + * tnShiftCtrlAlt - the status of the modifier keys for the + * hot key (optional; if passed, same value as passed to + * TextBox.KeyPress; if not passed, any existing hotkey + * assignment is cleared) + * tlAddOnly -- if .T., existing hot key for the tool will not be replaced + * Returns: none + * Environment in: none + * Environment out: a record may have been created in ToolHotKeyAssignments + * ToolHotKeyAssignments.HotKeyID is set to the specified + * hotkey (if it's valid) or 0 if the keycode isn't + * specified + *============================================================================== + + lparameters tcPRGName, ; + tnKeyCode, ; + tnShiftCtrlAlt, ; + tlAddOnly + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + do case + case vartype(tcPRGName) <> 'C' or empty(tcPRGName) + error 11 + case vartype(tnKeyCode) <> 'L' and (vartype(tnKeyCode) <> 'N' or ; + not seek(tnKeyCode, 'HotKeys', 'KeyCode')) + error 11 + case vartype(tnShiftCtrlAlt) <> 'L' and (vartype(tnShiftCtrlAlt) <> 'N' or ; + tnShiftCtrlAlt < 0) + error 11 + endcase + + * If a keycode was specified, see if it exists and if it's already used. + + lnHotKeyID = 0 + if vartype(tnKeyCode) = 'N' and vartype(tnShiftCtrlAlt) = 'N' + loKey = newobject('HotKey', 'Thor_Utils.vcx') + loKey.nScanCode = HotKeys.ScanCode + && we use the scan code not the key code + loKey.lShift = bittest(tnShiftCtrlAlt, 0) + loKey.lCtrl = bittest(tnShiftCtrlAlt, 1) + loKey.lAlt = bittest(tnShiftCtrlAlt, 2) + lnSelect = select() + select HotKeyDefinitions + locate for nKeyCode = HotKeys.ScanCode and nShifts = tnShiftCtrlAlt + do case + case not loKey.IsValid() + *** need to handle this. Use ERROR to throw error? + *** This.cErrorMessage = 'already used' + lnHotKeyID = -1 + case not found() + lcDescrip = loKey.GetHotKeyDescription() + lcFkyValue = loKey.GetKeyCode() + insert into HotKeyDefinitions (nKeyCode, nShifts, Descript, FkyValue) ; + values (HotKeys.ScanCode, tnShiftCtrlAlt, lcDescrip, lcFkyValue) + lnHotKeyID = ID + case seek(HotKeyDefinitions.ID, 'MenuDefinitions', 'HotKeyID') + *** need to handle this. Use ERROR to throw error? + *** This.cErrorMessage = 'already used' + lnHotKeyID = -1 + otherwise + lnHotKeyID = ID + endcase + select (lnSelect) + endif vartype(tnKeyCode) = 'N' ... + + * Create a record in ToolHotKeyAssignments if necessary. + + *** JRN 2011-04-14 : exit if hot key already defined AND tlAddOnly = .T. + Do case + case not seek(upper(tcPRGName), 'ToolHotKeyAssignments', 'PRGName') + insert into ToolHotKeyAssignments (PRGName) values (tcPRGName) + *** JRN 2011-04-14 : if this tool already has a hot key + * and tlHotKey is .T., nothing to do + Case tlAddOnly + Return -1 + EndCase + + * Assign the hotkey. + + replace HotKeyID with lnHotKeyID in ToolHotKeyAssignments + + ENDPROC + + PROCEDURE diskfilename + Lparameters lcFileName + + #Define MAX_PATH 260 + + Local lnFindFileData, lnHandle, lcXXX + Declare Integer FindFirstFile In win32api String @, String @ + Declare Integer FindNextFile In win32api Integer, String @ + Declare Integer FindClose In win32api Integer + + Do Case + Case ( Right (lcFileName, 1) == '\' ) + Return Addbs (This.DiskFileName (Left (lcFileName, Len (lcFileName) - 1))) + + Case Empty (lcFileName) + Return '' + + Case ( Len (lcFileName) == 2 ) And ( Right (lcFileName, 1) == ':' ) + Return Upper (lcFileName) && win2k gives curdir() for C: + Endcase + + lnFindFileData = Space(4 + 8 + 8 + 8 + 4 + 4 + 4 + 4 + MAX_PATH + 14) + lnHandle = FindFirstFile (@lcFileName, @lnFindFileData) + + If ( lnHandle < 0 ) + If ( Not Empty (Justfname (lcFileName)) ) + lcXXX = Justfname (lcFileName) + Else + lcXXX = lcFileName + Endif + Else + = FindClose (lnHandle) + lcXXX = Substr (lnFindFileData, 45, MAX_PATH) + lcXXX = Left (lcXXX, At (Chr(0), lcXXX) - 1) + Endif + + + Do Case + Case Empty (Justpath (lcFileName)) + Return lcXXX + Case ( Justpath (lcFileName) == '\' ) And (Left (lcFileName, 2) == '\\') && unc + Return '\\' + lcXXX + Otherwise + Return Addbs (This.DiskFileName (Justpath (lcFileName))) + lcXXX + Endcase + + Return + + ENDPROC + + PROCEDURE findfile && Finds a file in one of Thor's paths + *============================================================================== + * Method: FindFile + * Purpose: Finds the file in one of the Thor paths + * Author: Doug Hennig + * Last revision: 6/21/2011 JRN + * Parameters: tcFile - the file to find + * Returns: the file with the path it was found in or blank if it + * wasn't found + * Environment in: This.cToolsFolder contains the default folder for tools + * Environment out: none + *============================================================================== + + lparameters tcFile + local lcFile + do case + case file(tcFile) + lcFile = tcFile + case file(This.cToolsFolder + ccMyTools + '\' + tcFile) + lcFile = This.cToolsFolder + ccMyTools + '\' + tcFile + case file(This.cToolsFolder + tcFile) + lcFile = This.cToolsFolder + tcFile + otherwise + lcFile = '' + endcase + return lcFile + + ENDPROC + + PROCEDURE findoption + *============================================================================== + * Method: GetOption + * Purpose: Finds the specified Thor option + * Author: Jim Nelson + * Last revision: 04/09/2011 + * Parameters: tcKey - the key for the option + * tcTool - name of the tool this applies to (internally, may be left off) + * Returns: .T. if found + * Environment in: Thor.DBF is open + * Environment out: Thor.DBF is positioned to the record for the option or EOF + * if it wasn't found + *============================================================================== + + Lparameters tcKey, tcTool + Local lnSelect, luReturn + + * Open the tables if necessary. + + This.OpenTables() + + * Find the key in Thor and convert the value to the desired data type. + + lnSelect = Select() + Select Thor + Locate For Upper (Key) = Padr (Upper (tcKey), 30) ; + and Upper (Tool) = Padr (Upper (Evl (tcTool, 'Thor')), 60) + + luReturn = Found() + + Select (lnSelect) + Return luReturn + + ENDPROC + + PROCEDURE getitembyposition && Returns the ID for an item in the specified menu by its order in the menu + *============================================================================== + * Method: GetItemByPosition + * Purpose: Returns the ID for an item in the specified menu by its + * order in the menu + * Author: Doug Hennig + * Last revision: 03/23/2011 + * Parameters: tnMenuID - the menu the tool belongs to (required) + * tnOrder - the order for the item (required) + * Returns: the ID of the tool's record in MenuTools or 0 of not found + * Environment in: none + * Environment out: none + *============================================================================== + + lparameters tnMenuID, ; + tcPRGName + local lnSelect, ; + lnID + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + do case + case vartype(tnMenuID) <> 'N' or ; + not seek(tnMenuID, 'MenuDefinitions', 'ID') + error 11 + case vartype(tnOrder) <> 'N' or tnOrder <= 0 + error 11 + endcase + + * Find the item. + + lnSelect = select() + select MenuTools + locate for MenuID = tnMenuID and SortOrder = tnOrder + lnID = ID + select (lnSelect) + return lnID + + ENDPROC + + PROCEDURE getkeydesc + Lparameters lnShift + + Return IIf(0 # Bitand(lnShift, cnSHIFT), ccSHIFT, ''); + + IIf(0 # Bitand(lnShift, cnCTRL), ccCTRL, '') ; + + IIf(0 # Bitand(lnShift, cnALT), ccALT, '') ; + + Trim(HotKeys.Key) + + ENDPROC + + PROCEDURE getkeydescriptionfromkeycode + *============================================================================== + * Method: GetKeyDescriptionKeyCode + * Purpose: Returns the description given the 2-byte macro key code + * Author: Jim Nelson + * Last revision: 05/27/2011 + * Parameters: the 2-byte macro key code for the specified key or .NULL. + * if we can't create a macro key code + * Returns: the description for the key + *============================================================================== + + Lparameters lcKeyCode, llBrackets + + Local lcLeftBracket, lcRightBracket, lnAsc1, lnAsc2 + + lnAsc1 = Asc (Substr (lcKeyCode, 1, 1 )) + lnAsc2 = Asc (Substr (lcKeyCode, 2, 1 )) + + lcLeftBracket = IIf (llBrackets, '{', '') + lcRightBracket = IIf (llBrackets, '}', '') + + Select HotKeys + + Do Case + + Case lnAsc2 = 1 + + Locate For HotKeys.ShCode = lnAsc1 + If Found() + Return lcLeftBracket + This.GetKeyDesc (cnNO_MODIFIER) + lcRightBracket + Endif + + Return '??' + + Case Not Inlist ( lnAsc2, 0, 16) + + Locate For HotKeys.BareCode = lnAsc1 And HotKeys.BareKey = lnAsc2 + If Found() + Return lcLeftBracket + This.GetKeyDesc (cnNO_MODIFIER) + lcRightBracket + Endif + + Locate For HotKeys.ShCode = lnAsc1 And HotKeys.ShKey = lnAsc2 + If Found() + Return lcLeftBracket + This.GetKeyDesc (cnSHIFT) + lcRightBracket + Endif + + Locate For HotKeys.CtCode = lnAsc1 And HotKeys.CtKey = lnAsc2 + If Found() + Return lcLeftBracket + This.GetKeyDesc (cnCTRL) + lcRightBracket + Endif + + Locate For HotKeys.AltCode = lnAsc1 And HotKeys.AltKey = lnAsc2 + If Found() + Return lcLeftBracket + This.GetKeyDesc (cnALT) + lcRightBracket + Endif + + Locate For HotKeys.ShCtCode = lnAsc1 And HotKeys.ShCtKey = lnAsc2 + If Found() + Return lcLeftBracket + This.GetKeyDesc (cnSHIFT + cnCTRL) + lcRightBracket + Endif + + Locate For HotKeys.AltCode = lnAsc1 And HotKeys.ShAltKey = lnAsc2 + If Found() + Return lcLeftBracket + This.GetKeyDesc (cnSHIFT + cnALT) + lcRightBracket + Endif + + Locate For HotKeys.AltCode = lnAsc1 And HotKeys.CtAltKey = lnAsc2 + If Found() + Return lcLeftBracket + This.GetKeyDesc (cnCTRL + cnALT) + lcRightBracket + Endif + + Locate For HotKeys.AltCode = lnAsc1 And HotKeys.ShCtAltKey = lnAsc2 + If Found() + Return lcLeftBracket + This.GetKeyDesc (cnSHIFT + cnCTRL + cnALT) + lcRightBracket + Endif + + Return '??' + + Case lnAsc1 = 8 + Return '{BACKSPACE}' + + Case lnAsc1 = 9 + Return '{TAB}' + + Case lnAsc1 = 13 + Return '{ENTER}' + + Otherwise + Return Left (lcKeyCode, 1) + + Endcase + ENDPROC + + PROCEDURE getkeyvaluefromkeyname + *============================================================================== + * Method: GetKeyValueFromKeyName + * Purpose: Get internal representation of keystroke + * Author: Jim Nelson + * Last revision: 04/23/2011 + * Parameters: tcKeyName - key name (such as 'Alt-F12') + * tlKeyCodes + * Returns: if tlKeyCodes = .F. -- two-byte internal representation, if valid, else empty + * if tlKeyCodes = .T. -- object, properties 'KeyCode' and 'nShifts' + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tcKeyName, tlKeyCodes + + Local loKey As 'HotKey' Of 'Thor_Utils.vcx' + Local loResult As 'Empty' + Local lcFkyValue, lcName, llAlt, llCtrl, llShift, lnKeyCode, lnScanCode, lnSelect + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + If Vartype (tcKeyName) # 'C' Or Empty (tcKeyName) + Error 11 + Endif + + llShift = 'SHIFT' $ Upper (tcKeyName) + llCtrl = 'CTRL' $ Upper (tcKeyName) + llAlt = 'ALT' $ Upper (tcKeyName) + + * find the hotkey + lnSelect = Select() + Select HotKeys + lcName = Padr (Upper (Substr (tcKeyName, Max (Rat ('+', tcKeyName), Rat ('-', tcKeyName)) + 1)), 10) + Locate For Key = lcName + If Not Found() + Return '' + Endif + + lnScanCode = HotKeys.ScanCode + *** DH 04/23/2011: only need keycode + *Do case + * Case llShift + * lnKeyCode = HotKeys.ShCode + * Case llCtrl + * lnKeyCode = HotKeys.CtCode + * Case llAlt + * lnKeyCode = HotKeys.AltCode + * Otherwise + lnKeyCode = HotKeys.KeyCode + *EndCase + + Select (lnSelect) + + * and the result + If Empty(tlKeyCodes) + loKey = Newobject ('HotKey', 'Thor_Utils.vcx') + + loKey.nScanCode = lnScanCode + loKey.lShift = llShift + loKey.lCtrl = llCtrl + loKey.lAlt = llAlt + + If loKey.IsValid() + lcFkyValue = loKey.GetKeyCode() + Return lcFkyValue + Else + Return '' + EndIf + Else + loResult = CreateObject('Empty') + AddProperty(loResult, 'KeyCode', lnKeyCode) + AddProperty(loResult, 'nShifts', IIF(llShift, 1, 0) + IIF(llCtrl, 2, 0) + IIF(llAlt, 4, 0)) + Return loResult + endif + ENDPROC + + PROCEDURE getmacrodefinitions + * Returns collection of all macros (including Thor macros) + + Local loHotKeysCollection As 'Collection' + Local loMacro As 'Empty' + Local lcDefinition, lcFKYFile, lcFKYFileName, lcKey, lcKeys, lcKeystrokes, lcMacro, lcMacroName + Local lnCount, lnI, lnJ, lnLength, lnNextByte, lnTotalLength + + lcFKYFileName = Addbs (Sys(2023)) + Forceext (Sys(2015), 'FKY') + Erase (lcFKYFileName) + + Save Macros To (lcFKYFileName) + lcFKYFile = Filetostr (lcFKYFileName) + Erase (lcFKYFileName) + + lnCount = (256 * Asc (Substr (lcFKYFile, 18))) + Asc (Substr (lcFKYFile, 17)) + + loHotKeysCollection = Createobject ('Collection') + lnNextByte = 19 + For lnI = 1 To lnCount + lnLength = (256 * Asc (Substr (lcFKYFile, lnNextByte + 21))) + Asc (Substr (lcFKYFile, lnNextByte + 20)) + lnTotalLength = 24 + (2 * lnLength) + lcMacro = Substr (lcFKYFile, lnNextByte, lnTotalLength) + lnNextByte = lnNextByte + lnTotalLength + + lcMacroName = Trim (Strtran (Left (lcMacro, 20), Chr(0), '')) + lcDefinition = This.GetKeyDescriptionFromKeyCode (Substr (lcMacro, 23, 2)) + + lcKeystrokes = Substr (lcMacro, 25) + lcKeys = '' + For lnJ = 1 To Len (lcKeystrokes) Step 2 + lcKey = Substr (lcKeystrokes, lnJ, 2) + lcKeys = lcKeys + This.GetKeyDescriptionFromKeyCode (lcKey, .T.) + Endfor + + loMacro = Createobject ('Empty') + AddProperty (loMacro, 'FKYtext', lcMacro) + AddProperty (loMacro, 'Keystrokes', lcKeys) + AddProperty (loMacro, 'Name', lcMacroName) + AddProperty (loMacro, 'Definition', lcDefinition) + loHotKeysCollection.Add (loMacro) + + Endfor && lnI = 1 to lnCount + + Return loHotKeysCollection + + + + + ENDPROC + + PROCEDURE getmenubyname && Returns the ID for the menu with the specified name + *============================================================================== + * Method: GetMenuByName + * Purpose: Returns the ID for the menu with the specified name + * Author: Doug Hennig + * Last revision: 03/23/2011 + * Parameters: tcPopupName - the name of the popup for the menu to find + * (required) + * Returns: the ID of the menu if found and 0 if not + * Environment in: see This.OpenTables for requirements + * Environment out: MenuDefinitions is positioned to the record with the name + * if found and EOF if not + *============================================================================== + + lparameters tcPopupName + local lnSelect + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + if vartype(tcPopupName) <> 'C' or empty(tcPopupName) + error 11 + endif vartype(tcPopupName) <> 'C' ... + + * Try to find the menu by name. + + lnSelect = select() + select MenuDefinitions + locate for trim(upper(PopupName)) == upper(tcPopupName) + lnID = ID + select (lnSelect) + return lnID + + ENDPROC + + PROCEDURE getmenuitems && Returns a list of items in the specified menu + *============================================================================== + * Method: GetMenuItems + * Purpose: Returns a list of items in the specified menu + * Author: Doug Hennig + * Last revision: 04/13/2011 + * Parameters: tnMenuID - the ID for the menu (required) + * taItems - an array to three fields of the items for the + * menu passed by reference (required): + * ID, PRGName, Prompt + * Returns: the number of items in the array + * Environment in: none + * Environment out: the passed array is filled with items for the menu + *============================================================================== + + lparameters tnMenuID, ; + taItems + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + do case + case vartype(tnMenuID) <> 'N' or ; + not seek(tnMenuID, 'MenuDefinitions', 'ID') + error 11 + case type('taItems', 1) <> 'A' + error 11 + endcase + + * Fill the array with the items for the menu and return the count. + + *** JRN 2011-04-13 : added two more fields, plus sortorder + select ID, PRGName, Prompt from MenuTools where MenuID = tnMenuID order by sortorder into array taItems + *** JRN 2011-04-13 + + return _tally + + ENDPROC + + PROCEDURE getonkeylabeldefinitions + Local loKey As 'Empty' + Local loKeyCollection As 'Collection' + Local laKeys[1], lcExec, lcKey, lcKeyText, lcKeys, lcStr, lcTempFile, lnCount, lnI + lcTempFile = Addbs (Sys(2023)) + Sys(2015) + '.txt' + + *** We need to use a temporary file for this + Set Console Off + Set Alternate To (lcTempFile) + Set Alternate On + + *** Dump the memory + List Status + + Set Alternate Off + Set Alternate To + Set Console On + + lcStr = Filetostr (lcTempFile) + Delete File (lcTempFile) + + **************************************************************** + + lcStr = Chrtran (lcStr, ccLF, '') + + lcKeys = Strextract (lcStr, 'ON KEY LABEL', 'TEXTMERGE OPTIONS', 1, 1) + lnCount = Alines (laKeys, lcKeys) + loKeyCollection = Createobject ('Collection') + For lnI = 2 To lnCount + lcKeyText = laKeys (lnI) + lcKey = Getwordnum (lcKeyText, 1) + If Not Empty(lcKey) + lcExec = On('Key', lcKey) + If Not Empty(lcExec) + lcKey = Strtran(lcKey, 'SHIFT+', ccSHIFT) + lcKey = Strtran(lcKey, 'CTRL+', ccCTRL) + lcKey = Strtran(lcKey, 'ALT+', ccALT) + + loKey = Createobject ('Empty') + AddProperty (loKey, 'Key', lcKey) + AddProperty (loKey, 'Definition', lcExec) + loKeyCollection.Add (loKey) + Endif + Endif + Endfor && lnI = 2 to lnCount + + Return loKeyCollection + + ENDPROC + + PROCEDURE getoption && Returns the value of the specified Thor option + *============================================================================== + * Method: GetOption + * Purpose: Returns the value of the specified Thor option + * Author: Doug Hennig + * Last revision: 04/09/2011 + * Parameters: tcKey - the key for the option + * tcTool - name of the tool this applies to (internally, may be left off) + * Returns: the value of the option or NULL if it wasn't found + * Environment in: Thor.DBF is open + * Environment out: Thor.DBF is positioned to the record for the option or EOF + * if it wasn't found + *============================================================================== + + Lparameters tcKey, tcTool + Local lnSelect, luReturn + + * Open the tables if necessary. + + This.OpenTables() + + * Find the key in Thor and convert the value to the desired data type. + + lnSelect = Select() + Select Thor + Locate For Upper (Key) = Padr (Upper (tcKey), 30) ; + and Upper (Tool) = Padr (Upper (Evl (tcTool, 'Thor')), 60) + Do Case + Case Not Found() + luReturn = .Null. + Case Type = 'C' + luReturn = Value + Case Type = 'N' + luReturn = Val (Value) + Case Type = 'D' + luReturn = Val (Value) + Date(1899, 12, 30) + Case Type = 'L' + luReturn = Value = 'Y' + Otherwise + luReturn = .Null. + Endcase + Select (lnSelect) + Return luReturn + + ENDPROC + + PROCEDURE gettableforalias + Lparameters lcAlias + + #Define PLACEHOLDER '<*>' + Local lcName, lcWildCardValue, lnStarPosition + If Seek(Upper(Padr(lcAlias, 40)), 'TableAliases', 'Alias') + Return Alltrim(TableAliases.Table) + Else + Select TableAliases + Locate For Like(Upper(Alltrim(Alias)), Upper(Alltrim(lcAlias))) + If Found() + lnStarPosition = At('*', Alias) + lcWildCardValue = Substr(lcAlias, lnStarPosition, Len(Alltrim(lcAlias)) - Len(Alltrim(Alias)) + 1) + lcName = Alltrim(Table) + If Empty(lcName) + Return lcWildCardValue + Else + Return Strtran(lcName, PLACEHOLDER, lcWildCardValue) + Endif + Else + Return .F. + Endif + Endif + + ENDPROC + + PROCEDURE gettooldescription + Lparameters loTool + + Local lcFolder, lcToolFolder, lcValue + Local cValue + + lcValue = ccPROGRAM + ': ' + loTool.PRGName + If Not Empty (loTool.Source) + lcValue = lcValue + ccCR + ccSource + ': ' + loTool.Source + Endif + + lcFolder = Justpath (loTool.FullFileName) + + lcToolFolder = Addbs (Justpath (This.cToolsFolder)) + Do Case + Case Upper(Addbs(lcFolder)) == Upper (lcToolFolder) + + Case Upper (lcFolder) = Upper (lcToolFolder) + lcValue = lcValue + ccCR + ccCR + ccFOLDERNAME + ': ' + Substr (This.DiskFileName (lcFolder), Len (lcToolFolder) + 1) + Otherwise + lcValue = lcValue + ccCR + ccCR + ccFOLDERNAME + ': ' + This.DiskFileName (lcFolder) + Endcase + + lcValue = lcValue + ccCR + ccCR + ccDESCRIPTION + ': ' + loTool.Description + + If Not Empty (loTool.Author) + lcValue = lcValue + ccCR + ccCR + ccAUTHOR + ': ' + loTool.Author + Endif + + If Not Empty (loTool.Version) + lcValue = lcValue + ccCR + ccCR + ccVERSION + ': ' + loTool.Version + Endif + + Return lcValue + + ENDPROC + + PROCEDURE gettoolscollection && Returns a collection with registered tools + *============================================================================== + * Method: GetToolsCollection + * Purpose: Returns a collection with registered tools + * Author: Doug Hennig + * Last revision: 03/24/2011 + * Parameters: tcFolder - the folder to look in for Thor_Tool PRG files + * toTools - a collection (optional; if it isn't passed, a + * new collection is created) + * Returns: a collection of ThorInfo objects + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tcFolder, ; + toTools + + Local laFolders[1], lnCount, lnI, loTools + + * If we weren't passed one, create a collection to hold tool information. + + If Vartype (toTools) = 'O' + loTools = toTools + Else + loTools = Createobject ('Collection') + Endif Vartype (toTools) = 'O' + + *** JRN 2011-05-22 : all tools in current folder + If Atc(tcFolder, Addbs(Curdir())) = 0 + This.AddFolderTools (loTools, Addbs(Curdir()), .T.) + Endif + + *** JRN 2011-05-04 : find all tools in path + lnCount = Alines (laFolders, Set ('Path'), .T., ';', ',') + For lnI = 1 To lnCount + If Not Empty (laFolders (lnI)) + This.AddFolderTools (loTools, Addbs(laFolders (lnI)), .T.) + Endif + Endfor + This.AddFolderTools (loTools, Addbs (Addbs (tcFolder) + ccMyTools), .T.) + This.AddFolderTools (loTools, tcFolder, .F.) + + * Save the path in the collection. + + loTools.Tag = tcFolder + Return loTools + + ENDPROC + + PROCEDURE Init + lparameters tcFolder + local lcFolder + This.cAppFolder = Addbs(JustPath(JustPath(tcFolder))) + lcFolder = addbs(tcFolder) + This.cThorFolder = lcFolder + This.cTablesFolder = lcFolder + 'Tables\' + This.cToolsFolder = lcFolder + 'Tools\' + *** JRN 2011-04-14 : + Set Deleted On + + ENDPROC + + PROCEDURE opentable + Lparameters tcTableName, tcOrder + + Local lcFolder + lcFolder = This.cTablesFolder + + Do Case + Case Used(tcTableName) + + Case Pcount() = 1 + Use (lcFolder + tcTableName) Shared Again In 0 + + Otherwise + Use (lcFolder + tcTableName) Shared Again In 0 Order &tcOrder + + Endcase + + + ENDPROC + + PROCEDURE opentables && Opens the Thor tables + *============================================================================== + * Method: OpenTables + * Purpose: Opens the Thor tables + * Author: Doug Hennig + * Last revision: 04/05/2011 + * Parameters: none + * Returns: none + * Environment in: This.cTablesFolder contains the folder containing the + * tables, and that folder exists + * Environment out: the tables are opened if they aren't already + *============================================================================== + + * Open the tables we need. + + This.OpenTable('MenuDefinitions') + This.OpenTable('HotKeyDefinitions') + This.OpenTable('MenuTools') + This.OpenTable('ToolHotKeyAssignments') + This.OpenTable('StartupTools', 'PRGName') + This.OpenTable('ToolBarTools', 'PRGName') + This.OpenTable('Favorites', 'PRGName') + This.OpenTable('TableAliases') + This.OpenTable('Thor') + This.OpenTable('HotKeys') + + ENDPROC + + PROCEDURE packtable + *============================================================================== + * Method: PakcTables + * Purpose: Packs a single Thor table, if possible + * Author: Jim Nelson + * Last revision: 04/14/2011 + * Parameters: lcAlias -- alias of table to be packed + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters lcAlias + + Local lcDBF, lcOrder, lnSelect + + If not Used(lcAlias) + Return + EndIf + + lnSelect = Select() + + Select (lcAlias) + lcDBF = Dbf() + lcOrder = Order() + + Try + Use (lcDBF) Exclusive + Pack + + Use (lcDBF) Shared + If Not Empty (lcOrder) + Set Order To (lcOrder) + Endif + Catch + + Endtry + + Select (lnSelect) + ENDPROC + + PROCEDURE packtables + *============================================================================== + * Method: PakcTables + * Purpose: Packs each of the Thor tables, if possible + * Author: Jim Nelson + * Last revision: 04/14/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + With This + .PackTable ('MenuDefinitions') + .PackTable ('HotKeyDefinitions') + .PackTable ('MenuTools') + .PackTable ('ToolHotKeyAssignments') + Endwith + ENDPROC + + PROCEDURE removeitemfrommenu && Removes the specified item from the specified menu + *============================================================================== + * Method: RemoveItemFromMenu + * Purpose: Removes the specified item from the specified menu + * Author: Doug Hennig + * Last revision: 03/23/2011 + * Parameters: tnID - the ID of the item to remove + * Returns: none + * Environment in: see This.OpenTables for requirements + * Environment out: the record is removed from MenuTools + *============================================================================== + + lparameters tnID + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + *** JRN 2011-04-13 : OOPS ... Or, not and + if vartype(tnID) <> 'N' or ; + not seek(tnID, 'MenuTools', 'ID') + error 11 + endif vartype(tnID) <> 'N' ... + delete in MenuTools + + ENDPROC + + PROCEDURE removemenu && Removes the specified menu + *============================================================================== + * Method: RemoveMenu + * Purpose: Removes the specified menu + * Author: Doug Hennig + * Last revision: 03/24/2011 + * Parameters: tnMenuID - the ID for the menu to remove (required) + * tlRemoveTopLevel - .T. to remove only a top-level instance + * of the menu and leave any others + * tlRemovePopup - .T. to remove only a popup instance + * of the menu and leave any others + * tlRemoveSubMenu - .T. to remove only a submenu instance + * of the menu and leave any others + * Returns: none + * Environment in: see This.OpenTables for requirements + * Environment out: the MenuDefinitions record for the menu was updated if + * one of tlRemoveTopLevel or tlRemovePopup is .T. + * the MenuDefinitions record for the menu was removed if + * tlRemoveTopLevel, tlRemovePopup, and tlRemoveSubMenu + * are all .F. or the last instance of the menu is being + * removed. In that case, all MenuTools records for it are + * removed as well + *============================================================================== + + lparameters tnMenuID, ; + tlRemoveTopLevel, ; + tlRemovePopup, ; + tlRemoveSubMenu + local lnSelect + + * Open the tables if necessary. + + This.OpenTables() + + * See where the menu is being used. + + = seek(tnMenuID, 'MenuDefinitions', 'ID') + llTopLevel = MenuDefinitions.TopLevel + llPopup = MenuDefinitions.Popup + llSubMenu = seek(MenuDefinitions.ID, 'MenuTools', 'SubMenuID') + do case + + * If we're removing it from the top level but it still exists elsewhere, turn + * off the TopLevel flag. + + case tlRemoveTopLevel and (llPopup or llSubMenu) + replace TopLevel with .F. in MenuDefinitions + + * If we're removing it as a popup but it still exists elsewhere, turn off the + * Popup flag. + + case tlRemovePopup and (llTopLevel or llSubMenu) + replace Popup with .F., HotKeyID with 0 in MenuDefinitions + + * If we're removing it as a submenu but it still exists elsewhere, delete the + * MenuTools record that makes it a submenu. Renumber the tools for the menu the + * submenu belonged to. + + case tlRemoveSubMenu and (llTopLevel or llPopup) + lnMenuID = MenuTools.MenuID + delete in MenuTools + This.RenumberMenuItems(lnMenuID) + + * Delete the menu altogether. Delete the tools and separators in the menu. We + * may also have to delete submenus if they aren't used for anything else. + + otherwise + delete in MenuDefinitions + delete from MenuTools where (MenuID = tnMenuID and SubMenuID = 0) or ; + SubMenuID = tnMenuID + + * Now go through the submenus that belong to the menu and decide what to do + * with them. + + lnSelect = select() + select MenuTools + scan for MenuID = tnMenuID + lnSubMenuID = SubMenuID + lnRecno = recno() + delete + + * See if another menu uses this submenu. + + llUsed = seek(lnSubMenuID, 'MenuTools', 'SubMenuID') + go lnRecno + do case + + * It is used by another menu, so do nothing. + + case llUsed + + * It isn't used by another menu so find the submenu in MenuDefinitions. If we + * can't (which shouldn't happen), we'll just clean up MenuTools. + + case not seek(lnSubMenuID, 'MenuDefinitions', 'ID') + delete for MenuID = lnSubMenuID + + * If it isn't used as either a top-level or popup menu, we'll delete the submenu. + + case not MenuDefinitions.TopLevel and not MenuDefinitions.Popup + delete in MenuDefinitions + delete for MenuID = lnSubMenuID + endcase + endscan for MenuID = tnMenuID + + * Renumber all menus and the items in them. + + This.RenumberMenus() + select MenuDefinitions + scan + This.RenumberMenuItems(ID) + endscan + select (lnSelect) + endcase + + ENDPROC + + PROCEDURE removetool + Lparameters lcPRGName + + * Return full file name and path + Local lcFileName, llFailed + lcPRGName = Forceext (lcPRGName, 'prg') + lcFileName = Execscript (_Screen.cThorDispatcher, 'Full Path=' + lcPRGName) + + If Empty (lcFileName) + Return .F. + Endif + + Try + Erase (Forceext (lcFileName, 'prg')) + Erase (Forceext (lcFileName, 'fxp')) + llFailed = .F. + Catch + llFailed = .T. + EndTry + + If llFailed + Return .F. + Endif + + * now, is there one left in Tools? + lcFileName = Execscript (_Screen.cThorDispatcher, 'Full Path=', lcPRGName) + If Empty (lcFileName) + This.OpenTables() + Delete From ToolHotKeyAssignments Where Upper (PRGName) = Upper (lcPRGName) + Delete From MenuTools Where Upper (PRGName) = Upper (lcPRGName) + Endif + + + + ENDPROC + + PROCEDURE removetoolhotkey && Removes the hot key for the specified tool + *============================================================================== + * Method: RemoveToolHotKey + * Purpose: Removes the hot key for the specified tool + * Author: Doug Hennig + * Last revision: 03/25/2011 + * Parameters: tcPRGName - the PRG name of the tool (required) + * Returns: none + * Environment in: none + * Environment out: all records in ToolHotKeyAssignments for the specified + * tool are deleted + *============================================================================== + + lparameters tcPRGName, ; + tnKeyCode, ; + tnShiftCtrlAlt + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + if vartype(tcPRGName) <> 'C' or empty(tcPRGName) + error 11 + endif vartype(tcPRGName) <> 'C' or empty(tcPRGName) + + * Create a record in ToolHotKeyAssignments if necessary. + + delete from ToolHotKeyAssignments where upper(PRGName) = upper(tcPRGName) + + ENDPROC + + PROCEDURE renumbermenuitems && Renumbers the items for the specified menu so there are no gaps in the sequence + *============================================================================== + * Method: RenumberMenuItems + * Purpose: Renumbers the items for the specified menu so there are no + * gaps in the sequence + * Author: Doug Hennig + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 03/24/2011 + * Parameters: tnMenuID - the ID for the menu to renumber the items for + * Returns: none + * Environment in: none + * Environment out: the items in MenuTools for the specified menu have been + * renumbered to a complete sequence + *============================================================================== + + lparameters tnMenuID + local lnSelect, ; + lcOrder, ; + lnItem + + * Open the tables if necessary. + + This.OpenTables() + + * Ensure we have valid parameters. + + if vartype(tnMenuID) <> 'N' + error 11 + endif vartype(tnMenuID) <> 'N' + + * Renumber the items. + + lnSelect = select() + select MenuTools + lcOrder = order() + set order to SortOrder + lnItem = 0 + scan for MenuID = tnMenuID + lnItem = lnItem + 1 + replace SortOrder with lnItem + endscan for MenuID = tnMenuID + set order to (lcOrder) + select (lnSelect) + + ENDPROC + + PROCEDURE renumbermenus && Renumbers all menus so there are no gaps in the sequence + *============================================================================== + * Method: RenumberMenus + * Purpose: Renumbers all menus so there are no gaps in the sequence + * Author: Doug Hennig + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 03/24/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: the items in MenuDefinitions have been renumbered to a + * complete sequence + *============================================================================== + + local lnSelect, ; + lcOrder, ; + lnItem + + * Open the tables if necessary. + + This.OpenTables() + + * Renumber the items. + + lnSelect = select() + select MenuDefinitions + lcOrder = order() + set order to SortOrder + lnItem = 0 + scan for SortOrder > 0 + lnItem = lnItem + 1 + replace SortOrder with lnItem + endscan for SortOrder > 0 + set order to (lcOrder) + select (lnSelect) + + ENDPROC + + PROCEDURE setmenuprompt + *============================================================================== + * Method: SetMenuPrompt + * Purpose: Sets the prompt for a menu + * Author: Jim Nelson + * Last revision: 08/24/2011 JRN + * Parameters: tnID - ID for the menu + * tcPrompt - the new prompt + * Returns: the ID of the menu if found and 0 if not + * Environment in: see This.OpenTables for requirements + * Environment out: MenuDefinitions is positioned to the record with the name + * if found and EOF if not + *============================================================================== + + Lparameters tnID, tcPrompt + Local lnSelect + + * Open the tables if necessary. + + This.OpenTables() + + lnSelect = Select() + Select MenuDefinitions + Locate For Id = tnID + If Found() + Replace Prompt With tcPrompt + Endif + Select (lnSelect) + Return + + ENDPROC + + PROCEDURE setoption + *============================================================================== + * Method: SetOption + * Purpose: Sets the value of the specified Thor option + * Author: Jim Nelson + * Last revision: 04/09/2011 + * Parameters: tcKey - the key for the option + * tcTool - name of the tool this applies to (internally, may be left off) + * tuValue - the new value for the option + * tcDisplayValue - the display value for the option + * if different than Transform(tuValue) + * Returns: .T. if updated or NULL if it wasn't found + * Environment in: Thor.DBF is open + * Environment out: Thor.DBF is positioned to the record for the option or EOF + * if it wasn't found + *============================================================================== + + Lparameters tcKey, tcTool, tuValue, tcDisplayValue + Local lcType, lnSelect, luReturn + + * Open the tables if necessary. + + This.OpenTables() + + * Find the key in Thor and convert the value to the desired data type. + + lnSelect = Select() + Select Thor + Locate For Upper (Key) = Padr (Upper (tcKey), 30) ; + And Upper (Tool) = Padr (Upper (Evl (tcTool, 'Thor')), 60) + lcType = Vartype (tuValue) + + Do Case + Case Not Found() + Insert Into Thor (Key, Tool) Values (tcKey, tcTool) + Return This.SetOption(tcKey, tcTool, tuValue, tcDisplayValue) + + Case IsNull(tuValue) + Replace Value With '.Null.' ; + , Display With '.Null.' ; + , Type With 'X' + luReturn = .T. + + Case lcType = 'C' + Replace Value With tuValue ; + , Display With Iif ('C' = Vartype (tcDisplayValue), tcDisplayValue, tuValue) ; + , Type With 'C' + luReturn = .T. + + Case lcType = 'N' + Replace Value With Transform (tuValue) ; + , Display With Iif ('C' = Vartype (tcDisplayValue), tcDisplayValue, Transform (tuValue)) ; + , Type With 'N' + luReturn = .T. + + Case lcType = 'D' + Replace Value With Transform (tuValue - Date(1899, 12, 30)) ; + , Display With Iif ('C' = Vartype (tcDisplayValue), tcDisplayValue, Transform (tuValue)) ; + , Type With 'D' + luReturn = .T. + + Case lcType = 'L' + Replace Value With Iif (tuValue, 'Y', 'N') ; + , Display With Iif ('C' = Vartype (tcDisplayValue), tcDisplayValue, Iif (tuValue, 'Yes', 'No')) ; + , Type With 'L' + luReturn = .T. + Otherwise + luReturn = .F. + Endcase + Select (lnSelect) + Return luReturn + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thor_foxresource.vc2 b/Thor/Source/thor_foxresource.vc2 new file mode 100644 index 00000000..03bfc3cd --- /dev/null +++ b/Thor/Source/thor_foxresource.vc2 @@ -0,0 +1,577 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_foxresource.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS parameterx AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: this_access + *p: _memberdata && XML Metadata for customizable properties + * + + Name = "parameterx" + _memberdata = + + && XML Metadata for customizable properties + + PROCEDURE Init + Lparameters loDefaults + + This.oDefaults = loDefaults + ENDPROC + + PROCEDURE this_access + Lparameters tcMember + + If Pemstatus (This, tcMember, 5) ; + and (Pemstatus (This, tcMember, 4)) ; + And (Isnull( Getpem (This, tcMember))) ; + And (Not Upper(tcMember) == 'ODEFAULTS') ; + and (Not Pemstatus (This, tcMember, 6)) + Removeproperty(This, tcMember) + Endif + + If Not Pemstatus (This, tcMember, 5) + If 'O' = Vartype (This.oDefaults) And Pemstatus (This.oDefaults, tcMember, 5) + This.AddProperty (tcMember, Getpem (This.oDefaults, tcMember)) + Else + This.AddProperty (tcMember, Null) + Endif + Endif + + Return This + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_form_settings AS thor_resource OF "thor_foxresource.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor_ui.h" + * + *m: aligntocursor + *m: restore + *m: save + * + + Name = "thor_form_settings" + _memberdata = + + + + + + PROCEDURE aligntocursor + Lparameters toThisForm, llAlignToMouse, tnVerticalAdjustment, tnHorizontalAdjustment + + Local lnHorizontalAdjustment, lnLeft, lnTop, loCoordinates + + Execscript (_Screen.cThorDispatcher, 'PEMEditor_StartIDETools') + loCoordinates = _oPEMEditor.oUtils.oEditorWin.GetPopupCoordinates (.F., llAlignToMouse) + + If loCoordinates.Source = 'Center' + lnTop = loCoordinates.Top + toThisForm.Height / 2 + lnLeft = loCoordinates.Left + toThisForm.Width / 2 + Else + lnTop = loCoordinates.Top - Iif ('N' = Vartype (tnVerticalAdjustment), Sysmetric(9) + tnVerticalAdjustment, 0) + lnLeft = loCoordinates.Left - Iif ('N' = Vartype (tnHorizontalAdjustment), tnHorizontalAdjustment, 0) + Endif + + toThisForm.Top = Max(6, Min (_Screen.Height - Sysmetric(9) - toThisForm.Height - 6, lnTop)) + toThisForm.Left = Max(6, Min (_Screen.Width - toThisForm.Width - 6, lnLeft)) + + ENDPROC + + PROCEDURE Init + Lparameters txThisForm + + Local lcFileName, lcHome7, lcNew, lcOld, lcSettingsFileName, lcToolFolder, lnI, loThisForm + + If Pcount() = 0 + Return + EndIf + + lcToolFolder = Execscript(_Screen.cThorDispatcher, 'Tool Folder=') + + If 'O' = Vartype(m.txThisForm) + loThisForm = m.txThisForm + If Upper(m.loThisForm.BaseClass) = Upper('form') + lcFileName = Sys(1271, m.loThisForm) + Else + lcFileName = m.loThisForm.FileName + If Not(':' $ m.lcFileName Or '\' $ m.lcFileName) + lcFileName = Forcepath(m.lcFileName, Home(7)) + Endif + Endif + lcFileName = Addbs(Justpath(m.lcFileName)) + Juststem(m.lcFileName) + '.Settings.dbf' + Else + If not Empty(txThisForm) + lcFileName = Forcepath(m.txThisForm, m.lcToolFolder + ccMyTools) + Else + Return + EndIf + Endif + + lcFileName = Forceext(m.lcFileName, 'DBF') + * ----------------------------------------------------------- + * hullabaloo moving old style settings files to Settings folder + lcSettingsFileName = Forcepath(m.lcFileName, m.lcToolFolder + ccMySettings) + lcSettingsFileName = Strtran(m.lcSettingsFileName, '.Settings', '-Settings') + If File(m.lcFileName) And Not File(m.lcSettingsFileName) + For lnI = 1 To Adir(laFiles, Forceext(m.lcFileName, '.???'), '', 1) + lcOld = Forcepath(laFiles[m.lnI, 1], Justpath(m.lcFileName)) + lcNew = Forcepath(Strtran(laFiles[m.lnI, 1], '.Settings', '-Settings', 1, 1, 1), m.lcToolFolder + ccMySettings) + Rename [&lcOld] To [&lcNew] + Endfor + Endif + + If Execscript(_Screen.cThorDispatcher, 'Get Option=', 'Settings in Home(7)', 'Thor') + lcHome7 = Addbs(Home(7)) + 'Thor Settings' + If Not Directory(m.lcHome7) + Mkdir (m.lcHome7) + Endif + lcSettingsFileName = Forcepath(m.lcSettingsFileName, m.lcHome7) + Endif + + * ----------------------------------------------------------- + This.SetResourceFile(m.lcSettingsFileName, .T.) + This.LoadValues('PREFW', 'FORM') + + This.PropertiesList = '|' + + ENDPROC + + PROCEDURE restore + Lparameters toThisForm, tcPropertylist + + Local laProperties[1], lcName, lnCount, lnI + lnCount = Alines (laProperties, Evl (tcPropertylist, 'top,left,height,width'), 5, ',') + For lnI = 1 To lnCount + lcName = Lower (laProperties (lnI)) + If Pemstatus (toThisForm, lcName, 5) + This.PropertiesList = '|' + lcName + Strtran (This.PropertiesList, '|' + lcName + '|', '|') + If Pemstatus (This, '_' + lcName, 5) + AddProperty (toThisForm, lcName, GetPem(This, '_' + lcName)) + Endif + Endif + EndFor + + ENDPROC + + PROCEDURE save + Lparameters toThisForm + + Local laProperties[1], lcName, lnCount, lnI + lnCount = Alines (laProperties, This.PropertiesList, 5, '|') + For lnI = 1 To lnCount + lcName = Lower (laProperties (lnI)) + If Pemstatus (toThisForm, lcName, 5) + AddProperty (This, '_' + lcName, Getpem (toThisForm, lcName)) + Endif + Endfor + + This.SaveValues() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_resource AS parameterx OF "thor_foxresource.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: closeresource + *m: copysettings + *m: createresourcefile + *m: loadvalues && Occurs just before an object is created. + *m: openresource + *m: readme + *m: release && Releases a FormSet or Form from memory. + *m: resetdefaults + *m: restorecopiedsettings + *m: savevalues + *m: setresourcefile + *m: usedefaults + *p: cxid + *p: cxname + *p: cxresourcefile + *p: cxresourcetype + *p: ocopiedsettings + *p: oprefs + * + + cxid = + cxname = + cxresourcefile = + cxresourcetype = PREFW + Name = "thor_resource" + ocopiedsettings = .NULL. + _memberdata = + + + + + + + + + + + + + + + + + + + + + + PROCEDURE closeresource + Lparameters llPack + + Local lnSelect + + If Used("FoxResource") + lnSelect = Select() + If llPack + Select FoxResource + Try + Use (Dbf()) Exclusive Alias FoxResource + Pack + Catch + + Endtry + Endif + If Used("FoxResource") + Use In FoxResource + EndIf + + Select(lnSelect) + Endif + + ENDPROC + + PROCEDURE copysettings + Local laMembers(1), lcMember, lxValue, lnI + + With This + .oCopiedSettings = Createobject('Empty') + + Amembers (laMembers, This, 3, 'PHG#') + For m.lnI = 1 To Alen (laMembers, 1) + If laMembers (lnI, 2) = 'P' And Not 'I' $ laMembers (lnI, 5) + lcMember = laMembers (lnI, 1) + lxValue = Getpem (This, lcMember) + AddProperty(.oCopiedSettings, lcMember, lxValue) + Endif + Endfor + Endwith + + + + ENDPROC + + PROCEDURE createresourcefile + Lparameters tcFileName + + This.CloseResource() + + Create Table (tcFileName) Free ( ; + Type C (12), ; + Id C (12), ; + Name M, ; + ReadOnly L, ; + ckval N (6), ; + Data M, ; + Updated D ; + ) + Use + + This.cxResourceFile = Fullpath (tcFileName) + + ENDPROC + + PROCEDURE Destroy + Local lcTalk + lcTalk = Set('Talk') + Set Talk Off + + This.Release() + + Set Talk &lcTalk + + ENDPROC + + PROCEDURE Init + If Set ('RESOURCE') == 'ON' + This.SetResourceFile (Sys(2005)) + Else + This.SetResourceFile ('') + Endif + + + ENDPROC + + PROCEDURE loadvalues && Occurs just before an object is created. + Lparameters cxID, cxName + + Local lcType, lnCnt, lnI, lnSelect + + If This.OpenResource() + + m.cxID = Evl (m.cxID, '') + m.cxName = Evl (m.cxName, '') + + With This + .cxID = cxID + .cxName = cxName + Endwith + + m.lnSelect = Select() + + m.lcType = Padr (This.cxResourceType, Len (FoxResource.Type)) + m.cxID = Padr (m.cxID, Len (FoxResource.Id)) + + Select FoxResource + Locate For ; + Upper(Type) == Upper(m.lcType) ; + And Upper(Id) == Upper(m.cxID) ; + And Upper(Name) == Upper(m.cxName) + If Found() And Not Empty (Data) And ckval == Val (Sys(2007, Data)) + Restore From Memo Data Additive + If Vartype (aOptions[1, 1]) == 'C' + m.lnCnt = Alen (aOptions, 1) + For m.lnI = 1 To m.lnCnt + Try + This.AddProperty (aOptions[m.lnI, 1], aOptions[m.lnI, 2]) + Catch + + Endtry + Endfor + Endif + Endif + + This.CloseResource() + + Select (m.lnSelect) + Endif + ENDPROC + + PROCEDURE openresource + If Not Used ('FoxResource') + If File (This.cxResourceFile) + Try + Use (This.cxResourceFile) Alias FoxResource In 0 Shared Again + Catch + Endtry + Endif + Endif + Return Used ('FoxResource') + + ENDPROC + + PROCEDURE readme + #If .F. + + (1) Setup (and possibly create) Resource file: + This.SetResourceFile (lcFileName, CreateIfMissingFlag) + + (2) Set up default values (optional step): + This.UseDefaults() + + This.oDefaults.Property1 = SomeValue + This.oDefaults.Property2 = SomeValue + etc + + (3) Read current settings from the resource file + This.LoadValues(cKey1, cKey2) + cKey1 and cKey2 allow for multiple resource settings on the same file. Records found + will match both keys. If either is not supplied, '' is used. + + (4) Read Values: + ? This.Property1 + Returns: + the value of the property, if it has been set + else, the value of the saved property + else, the default value for the property + else, .null. + + (5) Assign Values: + This.SomeProperty = SomeValue + + (6) Save results back to Resource File + This.SaveValues() + + + Notes: + (A) Assign .Null. to a value resets it to default + (B) If step 2 is not used, any properties created (step (5)) will be saved + (C) If default values are used, only properties that have defaults will be saved. + + #Endif + ENDPROC + + PROCEDURE release && Releases a FormSet or Form from memory. + Local laMembers(1), lcMember + Amembers (laMembers, This, 0) + For Each lcMember In laMembers + lcMember = Upper (lcMember) + If lcMember = 'O' And Pemstatus(This, lcMember, 4) And 'O' = Vartype (Getpem (This, lcMember)) + This.&lcMember. = .Null. + Endif + Endfor + + ENDPROC + + PROCEDURE resetdefaults + Lparameters llRemoveAll + + Local laMembers(1), lcMember, lxDefault, lxValue, lnI + + If 'O' # Vartype (This.oDefaults) + Return + Endif + + Amembers (laMembers, This, 3, 'PHG#') + + For m.lnI = 1 To Alen (laMembers, 1) + If laMembers (lnI, 2) = 'P' And Not 'I' $ laMembers (lnI, 5) + lcMember = laMembers (lnI, 1) + If llRemoveAll + Removeproperty(This, lcMember) + Else + lxValue = Getpem (This, lcMember) + If Pemstatus (This.oDefaults, lcMember, 5) And Upper(lcMember) # 'ODEFAULTS' + lxDefault = Getpem (This.oDefaults, lcMember) + This.AddProperty(lcMember, lxDefault) + Endif + Endif + Endif + Endfor + + ENDPROC + + PROCEDURE restorecopiedsettings + Local laMembers(1), lcMember, lxValue, lnI + + With This + Amembers (laMembers, This, 3, 'PHG#') + For m.lnI = 1 To Alen (laMembers, 1) + If laMembers (lnI, 2) = 'P' And Not 'I' $ laMembers (lnI, 5) + lcMember = laMembers (lnI, 1) + If Pemstatus(.oCopiedSettings, lcMember, 5) + lxValue = Getpem (.oCopiedSettings, lcMember) + This.AddProperty(lcMember, lxValue) + Else + Removeproperty(This, lcMember) + Endif + Endif + Endfor + Endwith + + ENDPROC + + PROCEDURE savevalues + Lparameters cxID, cxName + + Local laMembers[1], lcMember, lcType, llAddIt, lnI, lnRow, lnSelect, lxDefault, lxValue + Local aOptions[1] + + If This.OpenResource() + + m.cxID = Evl (m.cxID, This.cxID) + m.cxName = Evl (m.cxName, This.cxName) + + m.lnSelect = Select() + + m.lcType = Padr (This.cxResourceType, Len (FoxResource.Type)) + m.cxID = Padr (m.cxID, Len (FoxResource.Id)) + + Select FoxResource + Locate For ; + Upper(Type) == Upper(m.lcType) ; + And Upper(Id) == Upper(m.cxID) ; + And Upper(Name) == Upper(m.cxName) + If Not Found() + Append Blank In FoxResource + Replace ; + Type With m.lcType, ; + Name With m.cxName, ; + Id With m.cxID, ; + ReadOnly With .F. ; + In FoxResource + Endif + + Amembers (laMembers, This, 3, 'PHG#') + lnRow = 0 + Dimension aOptions[1, 2] + aOptions(1, 1) = 'A' + + For m.lnI = 1 To Alen (laMembers, 1) + If laMembers (lnI, 2) = 'P' And Not 'I' $ laMembers (lnI, 5) + lcMember = laMembers (lnI, 1) + lxValue = Getpem (This, lcMember) + Do Case + Case Upper(lcMember) = 'ODEFAULTS' + llAddIt = .F. + Case 'O' = Vartype (lxValue) + llAddIt = .F. + Case Isnull (lxValue) + llAddIt = .F. + Case 'O' = Vartype (This.oDefaults) + If Pemstatus (This.oDefaults, lcMember, 5) + lxDefault = Getpem (This.oDefaults, lcMember) + llAddIt = (Vartype(lxValue) # Vartype(lxDefault)) Or Not lxValue == lxDefault + Else + llAddIt = .F. + Endif + Otherwise + llAddIt = .T. + Endcase + + If llAddIt + lnRow = lnRow + 1 + Dimension aOptions[lnRow, 2] + aOptions[m.lnRow, 1] = lcMember + aOptions[m.lnRow, 2] = lxValue + Endif + + Endif + Endfor + Save To Memo Data All Like aOptions + + Replace ; + Updated With Date(), ; + ckval With Val (Sys(2007, FoxResource.Data)) ; + In FoxResource + + This.CloseResource (.T.) + + Select (m.lnSelect) + Endif + + ENDPROC + + PROCEDURE setresourcefile + Lparameters lcResourceFile, llCreateIfMissing + + If llCreateIfMissing And Not File (lcResourceFile) + This.CreateResourceFile (lcResourceFile) + Else + This.cxResourceFile = lcResourceFile + Endif + ENDPROC + + PROCEDURE usedefaults + This.oDefaults = Newobject ('ParameterX', 'PEME_FoxResource.VCX') + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thor_menu.vc2 b/Thor/Source/thor_menu.vc2 new file mode 100644 index 00000000..94bdaf10 --- /dev/null +++ b/Thor/Source/thor_menu.vc2 @@ -0,0 +1,342 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_menu.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS contextmenu AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: activate && Occurs when a FormSet, Form, or Page object becomes active or when a ToolBar object is shown. + *m: addmenuitem && Adds a new item to a ComboBox or ListBox control, optionally allowing you to specify the item's index. + *m: addsubmenu + *m: calculateshortcutmenuposition + *m: createcontextmenu + *m: endsubmenu + *m: pix2fox + *m: releasepopups + *m: setdatasession + *p: cmenuname + *p: keyword + *p: nchoice + *p: nchoices + *p: ncurrentlevel + *p: nhandle + *p: nmenubar + *p: parameters + *a: aallmenunames[1,0] + *a: abarcounts[1,0] + *a: achoices[1,0] + *a: amenunames[1,0] + *p: _memberdata && XML Metadata for customizable properties + * + + cmenuname = + keyword = .F. + Name = "contextmenu" + nchoice = 0 + nchoices = 0 + ncurrentlevel = 1 + nhandle = 0 + nmenubar = 0 + parameters = .F. + _memberdata = + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + && XML Metadata for customizable properties + + PROCEDURE activate && Occurs when a FormSet, Form, or Page object becomes active or when a ToolBar object is shown. + Local lcMenu, lnChoice + + If This.nChoices = 0 + Messagebox ('This menu is empty; no menu items found!', 16, 'Menu is empty', 0) + This.ReleasePopups() + Return + Endif + + lnChoice = 0 + lcMenu = This.aMenuNames(1) + Activate Popup &lcMenu + + This.ReleasePopups() + + If lnChoice > 0 + This.nChoice = lnChoice + This.Keyword = This.aChoices (lnChoice, 1) + This.Parameters = This.aChoices (lnChoice, 2) + Return .T. + Else + Return .F. + Endif + + ENDPROC + + PROCEDURE addmenuitem && Adds a new item to a ComboBox or ListBox control, optionally allowing you to specify the item's index. + Lparameters lcPrompt, lcExec, lcStatusBar, lcKeyStroke, lcKeyWord, lxParameters, llMarked + + Local lcMenuName, lnBar, lnCurrentLevel + + With This + lnCurrentLevel = .nCurrentLevel + lnBar = .aBarCounts (lnCurrentLevel) + 1 + lcMenuName = .aMenuNames (lnCurrentLevel) + + .aBarCounts (lnCurrentLevel) = lnBar + + .nChoices = .nChoices + 1 + Dimension .aChoices (.nChoices, 2) + .aChoices (.nChoices, 1) = Evl (lcKeyWord, lcPrompt) + .aChoices (.nChoices, 2) = lxParameters + If Empty (lcExec) + lcExec = 'lnChoice = ' + Transform (.nChoices) + Endif + + Endwith + + lcPrompt = Evl (lcPrompt, '\-') + lcStatusBar = Evl (lcStatusBar, '') + + If Empty (lcKeyStroke) + Define Bar (lnBar) Of (lcMenuName) Prompt lcPrompt Message lcStatusBar + Else + Define Bar (lnBar) Of (lcMenuName) Prompt lcPrompt Key Alt+F12, lcKeyStroke Message lcStatusBar + Endif + + If Not Empty (lcExec) + On Selection Bar (lnBar) Of (lcMenuName) &lcExec + Endif + + If llMarked + Set Mark of Bar (lnBar) Of (lcMenuName) To .T. + Endif + + With This + .cMenuName = lcMenuName + .nMenuBar = lnBar + Endwith + ENDPROC + + PROCEDURE addsubmenu + Lparameters lcPrompt, lcStatusBar, lcKeyStroke + Local lcMenuName, lcPopupName, lcSkip, lnBar, lnCurrentLevel + + With This + lnCurrentLevel = .nCurrentLevel + + lcPopupName = 'Menu' + Sys(2015) + Define Popup &lcPopupName SHORTCUT Relative + + lnBar = .aBarCounts (lnCurrentLevel) + 1 + lcMenuName = .aMenuNames (lnCurrentLevel) + .aBarCounts (lnCurrentLevel) = lnBar + lcStatusBar = Evl(lcStatusBar, '') + + If Empty (lcKeyStroke) + Define Bar (lnBar) Of (lcMenuName) Prompt lcPrompt Message lcStatusBar + Else + Define Bar (lnBar) Of (lcMenuName) Prompt lcPrompt Key Alt+F12, lcKeyStroke Message lcStatusBar + Endif + + On Bar (lnBar) Of (lcMenuName) Activate Popup &lcPopupName + + **************************************************************** + + lnCurrentLevel = lnCurrentLevel + 1 + .nCurrentLevel = lnCurrentLevel + + Dimension .aBarCounts(lnCurrentLevel) + .aBarCounts(lnCurrentLevel) = 0 + + Dimension .aMenuNames(lnCurrentLevel) + .aMenuNames(lnCurrentLevel) = lcPopupName + + Dimension .aAllMenuNames(1 + Alen(.aAllMenuNames)) + .aAllMenuNames(Alen(.aAllMenuNames)) = lcMenuName + + Endwith + + + ENDPROC + + PROCEDURE calculateshortcutmenuposition + Local lcPoint, lnSMCol, lnSMRow, loResult, loWas + + loWas = Newobject ('WinApiSupport', 'PEME_WinApiSupport.PRG') + Declare Long GetCursorPos In WIN32API String @lpPoint + Declare Long ScreenToClient In WIN32API Long HWnd, String @lpPoint + + lcPoint = Replicate (Chr(0), 8) + && Get mouse location in Windows desktop coordinates (pixels) + = GetCursorPos (@lcPoint) + && Convert to VFP Desktop (_Screen) coordinates + = ScreenToClient (_Screen.HWnd, @lcPoint) + && Covert the coordinates to foxels + + lnSMCol = This.Pix2Fox (loWas.Long2Num (Left (lcPoint, 4)), .F., _Screen.FontName, _Screen.FontSize) + lnSMRow = This.Pix2Fox (loWas.Long2Num (Right (lcPoint, 4)), .T., _Screen.FontName, _Screen.FontSize) + + loResult = Createobject ('Empty') + AddProperty (loResult, 'Column', lnSMCol ) + AddProperty (loResult, 'Row', lnSMRow ) + Return loResult + + ENDPROC + + PROCEDURE createcontextmenu + Lparameters lcMenuName, llAlignToMouse + Local lnHandle, loEditorWin, loPosition, loPositionMouse + + loEditorWin = Execscript(_Screen.cThorDispatcher, 'class= editorwin from pemeditor') + loPosition = loEditorWin.GetPopupCoordinates(.T., llAlignToMouse) + loPositionMouse = loEditorWin.GetPopupCoordinates(.T., .T.) + + *** JRN 2010-11-10 : Following is an attempt to solve the problem + * when there is another form already open; apparently, if the + * focus is on the screen, the positioning of the popup still works OK + + Set Library To (Home() + 'FoxTools.fll') Additive + lnHandle = _Wontop() + + _Screen.Show() + + _WSelect(lnHandle) + + Try + Define Popup (lcMenuName) ; + shortcut ; + Relative ; + From loPosition.Top, loPosition.Left + Catch + Define Popup (lcMenuName) ; + shortcut ; + Relative ; + From loPositionMouse.Top, loPositionMouse.Left + EndTry + + + + ENDPROC + + PROCEDURE endsubmenu + Lparameters lcPrompt + Local lnBarCount, lcMenuName, lnCurrentLevel + + With This + lnCurrentLevel = .nCurrentLevel + lnBarCount = .aBarCounts(lnCurrentLevel) + If lnCurrentLevel > 1 + + lnCurrentLevel = lnCurrentLevel - 1 + .nCurrentLevel = lnCurrentLevel + + Dimension .aBarCounts(lnCurrentLevel) + Dimension .aMenuNames(lnCurrentLevel) + + If lnBarCount = 0 + lcMenuName = .aMenuNames (lnCurrentLevel) + Release Bar (.aBarCounts(lnCurrentLevel)) Of &lcMenuName + .aBarCounts(lnCurrentLevel) = .aBarCounts(lnCurrentLevel) - 1 + Endif + Endif + + Endwith + + ENDPROC + + PROCEDURE Init + Lparameters lcMenuName, lnStartBar, llAlignToMouse + + With This + .aBarCounts(1) = Evl(lnStartBar, 0) + + If Empty (lcMenuName) + lcMenuName = 'Menu' + Sys(2015) + .CreateContextMenu (lcMenuName, llAlignToMouse) + Endif + + .aMenuNames(1) = lcMenuName + .aAllMenuNames(1) = lcMenuName + + Endwith + + + ENDPROC + + PROCEDURE pix2fox + LPARAMETER tnPixels, tlVertical, tcFontName, tnFontSize + && tnPixels - pixels to convert + && tlVertical - .F./.T. convert horizontal/vertical coordinates + && tcFontName, tnFontSize - use specified font/size + && or current form (active output window) font/size, if not specified + LOCAL lnFoxels + + IF PCOUNT() > 2 + lnFoxels = tnPixels/FONTMETRIC(IIF(tlVertical, 1, 6), tcFontName, tnFontSize) + ELSE + lnFoxels = tnPixels/FONTMETRIC(IIF(tlVertical, 1, 6)) + ENDIF + + RETURN lnFoxels + ENDPROC + + PROCEDURE releasepopups + Local lcMenu, lnI + For lnI = 1 To Alen (This.aAllMenuNames) + lcMenu = This.aAllMenuNames (lnI) + Release Popups &lcMenu + Endfor + + + ENDPROC + + PROCEDURE setdatasession + Lparameters tnDataSession + + Set Datasession to (tnDataSession) + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thor_run.vc2 b/Thor/Source/thor_run.vc2 new file mode 100644 index 00000000..28daf781 --- /dev/null +++ b/Thor/Source/thor_run.vc2 @@ -0,0 +1,1900 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_run.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS thor_run AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor_run.h" + * + *m: add1tool + *m: addalltools + *m: addforums + *m: addmenuitems + *m: addopenfolder + *m: addopenfolders + *m: addpopuphotkeys + *m: addsourcefile + *m: addsourcefiles + *m: addtoolhotkeys + *m: assignallhotkeys + *m: assigndedicatedhotkey + *m: assignhotkeys + *m: assignmultiplehotkeys + *m: assignsimplehotkeys + *m: assignthordispatcher + *m: assignthordispatcherclasses + *m: assignthordispatcherhelp + *m: clear && Clears the contents of a ComboBox or ListBox control. + *m: clearhotkeys && Removes all the Thor-assigned hotkeys + *m: createmacro + *m: createtoolbar + *m: createtoplevelbars + *m: createtoplevelpads + *m: erasefile + *m: executepopup + *m: gethotkeyscollection + *m: getpublishedclasses + *m: popupalltools + *m: run && Occurs when an Active Document is ready to execute your application code. + *m: runstartupprgs + *m: updateoptionslist + *p: cdebugmenuname + *p: cdedicatedhotkey + *p: cdedicatedhotkeyfkyvalue + *p: cthorapp + *p: cthorfolder + *p: fullfilename + *p: ndebugmenubar + *p: othorengine + *p: otoolscollection + *p: _memberdata && XML Metadata for customizable properties + * + + cdebugmenuname = + cdedicatedhotkey = Alt-F12 + cdedicatedhotkeyfkyvalue = + cthorapp = + cthorfolder = + fullfilename = + Name = "thor_run" + ndebugmenubar = 0 + othorengine = .NULL. + otoolscollection = .NULL. + _memberdata = + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + && XML Metadata for customizable properties + + PROCEDURE add1tool + Lparameters loContextMenu, loTool, tcFolder, tcActionPrefix + Local lcKeystroke, lcPRGName, lcPrompt, lcStatusBar + + lcPrompt = loTool.Prompt + lcPRGName = Evl(tcActionPrefix, '') + Alltrim (loTool.PRGName) + lcStatusBar = Chrtran (Left (Alltrim (Evl(loTool.StatusBarText,loTool.Description)), 250), ccCRLF + ccTAB, ' ') + + If Empty(tcActionPrefix); + and Indexseek (Upper (lcPRGName), .T., 'ToolHotKeyAssignments', 'PrgName') ; + And ToolHotKeyAssignments.HotKeyID # 0 + Indexseek (ToolHotKeyAssignments.HotKeyID, .T., 'HotKeyDefinitions', 'ID') + lcKeystroke = Alltrim (HotKeyDefinitions.Descript) + Else + lcKeystroke = '' + Endif + + loContextMenu.AddMenuItem (lcPrompt, [ExecScript(_Screen.cThorDispatcher, '] + lcPRGName + [')], lcStatusBar, lcKeystroke) + + + ENDPROC + + PROCEDURE addalltools + *============================================================================== + * Method: AddAllTools + * Purpose: For the internal sub-menu 'All Tools', adds ALL tools + * Author: Jim Nelson + * Last revision: 04/14/2011 + * Parameters: loContextMenu, tcFolder + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters loContextMenu, tcFolder, lcOnlySource, tcActionPrefix + + Local laPrev[1], laThis[1], laTools[1], lcCategory, lcPrev, lcPreviousCategory, lcSource + Local lcSubCategory, lcThis, lnI, lnJ, lnK, lnMax1, lnMax2, lnSort, lnStart, lnToolCount, loTool + Local loTools + + loTools = This.oToolsCollection + + lnToolCount = loTools.Count + If lnToolCount = 0 + Return + Endif + + Dimension laTools (lnToolCount, 5) + For lnI = 1 To lnToolCount + loTool = loTools.Item (lnI) + lcSource = Evl (Trim (loTool.Source), '(No Source)') + *!* * Removed 2/3/2012 + *!* lcCategory = Trim (loTool.Category) + lcCategory = Evl (Trim (loTool.Category), lcSource) + lcSubCategory = Trim (loTool.SubCategory) + lnSort = Evl(loTool.Sort, 9999) + + laTools (lnI, 1) = lnI + laTools (lnI, 2) = lcSource + laTools (lnI, 3) = lcCategory + laTools (lnI, 4) = lcSubCategory + * note the odd construction with lnSort! aha! + laTools (lnI, 5) = loTool.InternalSort + Endfor + + Asort (laTools, 5) + lcPreviousCategory = '' + + For lnI = 1 To lnToolCount + + loTool = loTools.Item (laTools (lnI, 1)) + lcSource = laTools (lnI, 2) + lcCategory = laTools (lnI, 3) + + If lcSource == 'Thor' + Loop + Endif + + If Not lcCategory == lcPreviousCategory + lnMax1 = Alines (laPrev, lcPreviousCategory, 5, '|') + lnMax2 = Alines (laThis, lcCategory, 5, '|') + If lnI = 1 + lnJ = 1 + Else + lnStart = 1 + Min (lnMax1, lnMax2) + For lnJ = 1 To Min (lnMax1, lnMax2) + lcPrev = laPrev[lnJ] + lcThis = laThis[lnJ] + If Not Upper (lcPrev) == Upper (lcThis) + lnStart = lnJ + Exit + Endif + Endfor + For lnK = lnStart To lnMax1 + loContextMenu.EndSubMenu () + Endfor + Endif + For lnK = lnJ To lnMax2 + loContextMenu.AddSubMenu (laThis[lnK]) + Endfor + Endif + + This.Add1Tool (loContextMenu, loTool, tcFolder, tcActionPrefix) + lcPreviousCategory = lcCategory + + Endfor && lnI = 1 To lnToolCount + + For lnI = 1 To (1 + Occurs ('|', lcPreviousCategory)) + loContextMenu.EndSubMenu () + Endfor + + Return + + + ENDPROC + + PROCEDURE addforums + Lparameters loContextMenu, lcNameProperty, lcLinkProperty + + Local laLinks[1], laNames[1], lcName, lnI, loTool, loTools + loTools = This.oToolsCollection + + Create Cursor crsr_Forums (Name C(40), Link C(250)) + Index On Name Tag Name + + For Each loTool In loTools FoxObject + If Not Empty (loTool.&lcNameProperty) + Alines(laNames, loTool.&lcNameProperty) + Alines(laLinks, loTool.&lcLinkProperty) + For lnI = 1 To Min(Alen(laNames), Alen(laLinks)) + Locate For Upper(Trim(Name)) == Upper(Trim(laNames[lnI])) + If Not Found() + Insert Into crsr_Forums Values (laNames[lnI], laLinks[lnI]) + Endif + Endfor + Endif + Endfor && each loTool in loTools foxobject + + Scan + lcName = Alltrim(Chrtran(Name, [-], '')) && - insures that Thor's items appear at the top of the list + loContextMenu.AddMenuItem (lcName, [ExecScript(_Screen.cThorDispatcher, 'Thor_Proc_Shell', '] + Trim (Link) + [')]) + Endscan + + + ENDPROC + + PROCEDURE addmenuitems + *============================================================================== + * Method: AddMenuItems + * Purpose: Adds bars (tools, separators, and sub-menus) to an existing menu + * Recursive for handling sub-menus + * Author: Jim Nelson + * Last revision: 03/21/2011 + * Parameters: loContextMenu -- object for handling menus + * lnMenuID -- MenuID being processed for the current menu / sub-menu + * tcFolder -- folder for tools + * Returns: none + * Environment in: Table MenuDefinitions + * Environment out: none + *============================================================================== + + Lparameters loContextMenu, lnMenuID, tcFolder, tcActionPrefix + + Local laMenuTools[1], lcKeystroke, lcMenuStatusBar, lcPRGName, lcPrompt, lcStatusBar, llSeparator + Local lnI, lnSubMenuID + + Select MenuTools.Prompt ; + , Separator ; + , SubMenuID ; + , PRGName ; + , MenuTools.StatusBar ; + , Cast (Nvl (MenuDefinitions.StatusBar, '') As M) As MenuStatusBar ; + From MenuTools ; + Left Join MenuDefinitions ; + On SubMenuID = MenuDefinitions.Id ; + Where MenuID = lnMenuID ; + Order By MenuTools.sortorder ; + Into Array laMenuTools + + For lnI = 1 To _Tally + lcPrompt = Alltrim (laMenuTools (lnI, 1)) + llSeparator = laMenuTools (lnI, 2) + lnSubMenuID = laMenuTools (lnI, 3) + lcPRGName = Evl (tcActionPrefix, '') + Alltrim (laMenuTools (lnI, 4)) + lcStatusBar = Strtran (Left (Alltrim (laMenuTools (lnI, 5)), 250), ccCRLF, ' ') + lcMenuStatusBar = Strtran (Left (Alltrim (laMenuTools (lnI, 6)), 250), ccCRLF, ' ') + + Do Case + Case llSeparator + loContextMenu.AddMenuItem () + Case lnSubMenuID # 0 + If Empty (tcActionPrefix) ; + And Indexseek (lnSubMenuID, .T., 'MenuDefinitions', 'ID') ; + And MenuDefinitions.HotKeyID # 0 + Indexseek (MenuDefinitions.HotKeyID, .T., 'HotKeyDefinitions', 'ID') + lcKeystroke = Alltrim (HotKeyDefinitions.Descript) + Else + lcKeystroke = '' + Endif + + loContextMenu.AddSubMenu (lcPrompt, lcMenuStatusBar, lcKeystroke) + This.AddMenuItems (loContextMenu, lnSubMenuID, tcFolder, tcActionPrefix) + loContextMenu.EndSubMenu () + Case Upper (lcPRGName) = Upper (ccINTERNALEDITPRG) + loContextMenu.AddMenuItem (lcPrompt, [ExecScript(_Screen.cThorDispatcher, '] + lcPRGName + [')], lcStatusBar, This.oThorEngine.GetOption ('ThorHotKey')) + Case Upper (lcPRGName) = Upper (ccINTERNALALLTOOLSPRG) + loContextMenu.AddSubMenu (lcPrompt, lcMenuStatusBar) + This.AddAllTools (loContextMenu, tcFolder, , ) &&ccModify) + loContextMenu.EndSubMenu () + Case Upper (lcPRGName) = Upper (ccINTERNALMODIFY) + loContextMenu.AddSubMenu (lcPrompt, lcMenuStatusBar) + This.AddAllTools (loContextMenu, tcFolder, , ccModify) + loContextMenu.EndSubMenu () + Case Upper (lcPRGName) = Upper (ccOPENFOLDERS) + loContextMenu.AddSubMenu (lcPrompt, lcMenuStatusBar) + This.AddOpenFolders (loContextMenu) + loContextMenu.EndSubMenu () + Case Upper (lcPRGName) = Upper (ccSOURCEFILES) + loContextMenu.AddSubMenu (lcPrompt, lcMenuStatusBar) + This.AddSourceFiles (loContextMenu) + loContextMenu.EndSubMenu () + Case Upper (lcPRGName) = Upper (ccINTERNALTOOLLINK) + loContextMenu.AddSubMenu (lcPrompt, lcMenuStatusBar) + This.AddAllTools (loContextMenu, tcFolder, , ccLink) + loContextMenu.EndSubMenu () + + Case Upper (lcPRGName) = Upper ('Thor-Forums') + loContextMenu.AddSubMenu ('Forums', '') + This.AddForums(loContextMenu, 'ForumName', 'ForumLink') + loContextMenu.EndSubMenu () + + Case Upper (lcPRGName) = Upper ('Thor-Blogs') + loContextMenu.AddSubMenu ('Blogs', '') + This.AddForums(loContextMenu, 'BlogName', 'BlogLink') + loContextMenu.EndSubMenu () + + Case Upper (lcPRGName) = Upper ('Thor-ChangeLogs') + loContextMenu.AddSubMenu ('Change Logs', '') + This.AddForums(loContextMenu, 'ChangeLogName', 'ChangeLogLink') + loContextMenu.EndSubMenu () + + Case Upper (lcPRGName) = Upper ('Thor-ERs') + loContextMenu.AddMenuItem ('Thor ERs', [ExecScript(_Screen.cThorDispatcher, 'Thor_Proc_Shell', 'https://docs.google.com/document/d/1TPFfbNKLhcqT_EzPVYw5jdikSoRn12hvAIq4M10beIQ/edit')]) + + Case Upper (lcPRGName) = Upper ('Thor-Videos') + *** DH 2018-04-10: new URL + * loContextMenu.AddMenuItem ('Thor Videos', [ExecScript(_Screen.cThorDispatcher, 'Thor_Proc_Shell', 'http://vfpx.codeplex.com/wikipage?title=Thor%20Videos')]) + loContextMenu.AddMenuItem ('Thor Videos', [ExecScript(_Screen.cThorDispatcher, 'Thor_Proc_Shell', 'https://github.com/VFPX/Thor/blob/master/Docs/Thor_videos.md')]) + + Case Upper (lcPRGName) = Upper (ccDEBUGMODE) + loContextMenu.AddMenuItem (lcPrompt, [ExecScript(_Screen.cThorDispatcher, '] + ccTOGGLEDEBUGMODE + [')], lcStatusBar, Nvl(lcKeystroke, '')) + This.cDebugMenuName = loContextMenu.cMenuName + This.nDebugMenuBar = loContextMenu.nMenuBar + Otherwise + If Indexseek (Upper (lcPRGName), .T., 'ToolHotKeyAssignments', 'PrgName') And ToolHotKeyAssignments.HotKeyID # 0 + Indexseek (ToolHotKeyAssignments.HotKeyID, .T., 'HotKeyDefinitions', 'ID') + lcKeystroke = Alltrim (HotKeyDefinitions.Descript) + Else + lcKeystroke = '' + Endif + + loContextMenu.AddMenuItem (lcPrompt, [ExecScript(_Screen.cThorDispatcher, '] + lcPRGName + [')], lcStatusBar, lcKeystroke) + Endcase + Endfor + + + ENDPROC + + PROCEDURE addopenfolder + Lparameters loContextMenu, lcCaption, lcFolder + + If Directory(lcFolder) + loContextMenu.AddMenuItem (lcCaption, [ExecScript(_Screen.cThorDispatcher, 'Thor_Proc_OpenFolder', '] + lcFolder + [')]) + EndIf + + ENDPROC + + PROCEDURE addopenfolders + Lparameters loContextMenu + + Local lcFolder, lcToolFolder, loTool + lcToolFolder = Addbs (Execscript (_Screen.cThorDispatcher, 'Tool Folder=')) + + This.AddOpenFolder (loContextMenu, 'My Tools', lcToolFolder + 'My Tools') + This.AddOpenFolder (loContextMenu, 'Tools', lcToolFolder ) + This.AddOpenFolder (loContextMenu, 'Procs', lcToolFolder + 'Procs') + + loContextMenu.AddMenuItem () + + This.AddOpenFolder (loContextMenu, 'Apps', lcToolFolder + 'Apps' ) + This.AddOpenFolder (loContextMenu, 'Components', lcToolFolder + 'Components' ) + This.AddOpenFolder (loContextMenu, 'Downloads', Addbs(Sys(2023)) + 'Thor Downloads') + + + ENDPROC + + PROCEDURE addpopuphotkeys + *============================================================================== + * Method: AddPopUpHotKeys + * Purpose: Adds all of the hot key definitions for pop-ups to the collection + * Author: Jim Nelson + * Last revision: 03/22/2011 + * Parameters: loCollection -- one item per hot key + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters loCollection + + Local loMacro As 'Empty' + Local laHotKeys[1], lcDescript, lcFKYValue, lcMacro, lcPRGName, lnI + Select Descript, FKYValue, MenuDefinitions.Id, nshifts, Descript ; + From MenuDefinitions ; + Join HotKeyDefinitions ; + On MenuDefinitions.hotkeyid = HotKeyDefinitions.Id ; + And FKYValue # ' ' ; + Into Array laHotKeys + + For lnI = 1 To _Tally + lcDescript = Trim (laHotKeys (lnI, 1)) + lcFKYValue = laHotKeys (lnI, 2) + lcPRGName = ccPOPUPID + Transform (laHotKeys (lnI, 3)) + + lcMacro = This.CreateMacro ('Thor:' + lcDescript, lcFKYValue, This.cDedicatedHotKeyFkyValue, lcPRGName + Chr(13)) + loMacro = Createobject ('Empty') + AddProperty (loMacro, 'Text', lcMacro) + AddProperty (loMacro, 'NShifts', laHotKeys (lnI, 4)) + AddProperty (loMacro, 'Descript', laHotKeys (lnI, 5)) + AddProperty (loMacro, 'Execute', lcPRGName) + + loCollection.Add (loMacro) + Endfor + + ENDPROC + + PROCEDURE addsourcefile + Lparameters loContextMenu, lcSourceFileURL + + Local laLines[1] + If Alines (laLines, lcSourceFileURL, 1, '=') > 1 + loContextMenu.AddMenuItem (laLines(1), [ExecScript(_Screen.cThorDispatcher, 'Thor_Proc_Shell', '] + Trim (laLines[2]) + [')]) + EndIf + + ENDPROC + + PROCEDURE addsourcefiles + Lparameters loContextMenu + + Local lcSourceFileURL, lnI, loOtherUpdaters, loThorUpdater + + loThorUpdater = Execscript (_Screen.cThorDispatcher, 'Thor_Proc_GetUpdateList', .T.) + For lnI = 1 To loThorUpdater.Count + lcSourceFileURL = loThorUpdater (lnI).SourceFileURL + If Not Empty (lcSourceFileURL) + This.AddSourceFile (loContextMenu, lcSourceFileURL) + Endif + Endfor + + loOtherUpdaters = Execscript (_Screen.cThorDispatcher, 'Thor_Proc_GetUpdateList', .F.) + For lnI = 1 To loOtherUpdaters.Count + lcSourceFileURL = loOtherUpdaters (lnI).SourceFileURL + If Not Empty (lcSourceFileURL) + This.AddSourceFile (loContextMenu, lcSourceFileURL) + Endif + Endfor + + + + ENDPROC + + PROCEDURE addtoolhotkeys + *============================================================================== + * Method: AddToolHotKeys + * Purpose: Adds all of the hot key definitions for tools to the collection + * Author: Jim Nelson + * Last revision: 03/22/2011 + * Parameters: tcFolder -- main Thor folder + * loCollection -- one item per hot key + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tcFolder, loCollection + + Local loMacro As 'Empty' + Local laHotKeys[1], lcDescript, lcFKYValue, lcMacro, lcPRGName, lnI + Select Descript, fkyvalue, prgname, nshifts, Descript ; + From ToolHotKeyAssignments ; + Join HotKeyDefinitions ; + On ToolHotKeyAssignments.hotkeyid = HotKeyDefinitions.Id ; + And fkyvalue # ' ' ; + Into Array laHotKeys + + For lnI = 1 To _Tally + lcDescript = Trim (laHotKeys (lnI, 1)) + lcFKYValue = laHotKeys (lnI, 2) + lcPRGName = Trim (laHotKeys (lnI, 3)) + + lcMacro = This.CreateMacro ('Thor:' + lcDescript, lcFKYValue, This.cDedicatedHotKeyFkyValue, lcPRGName + Chr(13)) + loMacro = Createobject ('Empty') + AddProperty (loMacro, 'Text', lcMacro) + AddProperty (loMacro, 'NShifts', laHotKeys (lnI, 4)) + AddProperty (loMacro, 'Descript', laHotKeys (lnI, 5)) + AddProperty (loMacro, 'Execute', lcPRGName) + + loCollection.Add (loMacro) + Endfor + + ENDPROC + + PROCEDURE assignallhotkeys + Local loKeysCollection + + With This + + .AssignDedicatedHotKey() + + .ClearHotKeys() + + loKeysCollection = .GetHotKeysCollection(.cThorFolder + 'Tools\') + + .AssignSimpleHotKeys (loKeysCollection) + + .AssignMultipleHotKeys (loKeysCollection) + + Endwith + ENDPROC + + PROCEDURE assigndedicatedhotkey + *============================================================================== + * Method: AssignDedicatedHotKey + * Purpose: Assigns the On Key Label hotkey dedicated for use by Thor for executing macros + * Author: Jim Nelson + * Last revision: 04/14/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Local lcHotKey + + lcHotKey = Evl(This.oThorEngine.GetOption ('ThorHotKey'), This.cDedicatedHotKey) + Try + On Key Label &lcHotKey Execscript (_Screen.cThorDispatcher) + This.cDedicatedHotKey = lcHotKey + Catch + lcHotKey = This.cDedicatedHotKey + On Key Label &lcHotKey Execscript (_Screen.cThorDispatcher) + Endtry + + This.cDedicatedHotKeyFkyValue = This.oThorEngine.GetKeyValueFromKeyName (lcHotKey) + + ENDPROC + + PROCEDURE assignhotkeys + *============================================================================== + * Method: AssignHotKeys + * Purpose: Assigns both kinds of hot keys, using RESTORE MACROS + * Author: Jim Nelson + * Last revision: 03/21/2011 + * Parameters: tcFolder ... main Thor folder + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters loHotKeysCollection + + Local lcFKYFile, lcMacros, lnCount, lnI + + lnCount = loHotKeysCollection.Count + If lnCount = 0 + Return + Endif + + lcMacros = Chr(0xFF) + Chr(0x79) + ; + Replicate (Chr(32), 13) + Chr(0) + ; + Chr (lnCount % 256) + Chr (Int (lnCount / 256)) + For lnI = 1 To lnCount + lcMacros = lcMacros + loHotKeysCollection.Item (lnI) + Endfor + + lcFKYFile = Addbs (Sys(2023)) + Forceext (Sys(2015), 'FKY') + This.EraseFile(lcFKYFile) + + Strtofile (lcMacros, lcFKYFile) + Restore Macros From (lcFKYFile) + + This.EraseFile(lcFKYFile) + + ENDPROC + + PROCEDURE assignmultiplehotkeys + *============================================================================== + * Method: AssignMultipleKeys + * Purpose: Assigns both kinds of hot keys, using RESTORE MACROS + * Author: Jim Nelson + * Last revision: 03/21/2011 + * Parameters: tcFolder ... main Thor folder + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters loHotKeysCollection + + Local lcFKYFile, lcMacros, lnCount, lnI, lnTotalMacros, loMacro + + lnCount = loHotKeysCollection.Count + If lnCount = 0 + Return + Endif + + lcMacros = '' + lnTotalMacros = 0 + For lnI = 1 To lnCount + loMacro = loHotKeysCollection.Item (lnI) + If (Inlist (loMacro.nShifts, 3, 5, 6, 7) or (loMacro.nShifts = 0 and InList(loMacro.Descript, 'F6', 'F7', 'F8'))) + lcMacros = lcMacros + loMacro.Text + lnTotalMacros = lnTotalMacros + 1 + Endif + Endfor + + lcMacros = Chr(0xFF) + Chr(0x79) + ; + Replicate (Chr(32), 13) + Chr(0) + ; + Chr (lnTotalMacros % 256) + Chr (Int (lnCount / 256)) + ; + lcMacros + + lcFKYFile = Addbs (Sys(2023)) + Forceext (Sys(2015), 'FKY') + This.EraseFile(lcFKYFile) + + Strtofile (lcMacros, lcFKYFile) + Restore Macros From (lcFKYFile) + + This.EraseFile(lcFKYFile) + + ENDPROC + + PROCEDURE assignsimplehotkeys + *============================================================================== + * Method: AssignMultipleKeys + * Purpose: Assigns both kinds of hot keys, using RESTORE MACROS + * Author: Jim Nelson + * Last revision: 03/21/2011 + * Parameters: tcFolder ... main Thor folder + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters loHotKeysCollection + + Local loMacro, lcExecute, lcKey, lcOnKeyLabel, lnI + + For lnI = 1 To loHotKeysCollection.Count + loMacro = loHotKeysCollection.Item (lnI) + If not (Inlist (loMacro.nShifts, 3, 5, 6, 7) or (loMacro.nShifts = 0 and InList(loMacro.Descript, 'F6', 'F7', 'F8'))) + lcKey = loMacro.Descript + lcExecute = loMacro.Execute + lcOnKeyLabel = ccOnKeyLabelPrefix + lcExecute + ccOnKeyLabelSuffix + On Key Label &lcKey &lcOnKeyLabel + Endif + Endfor + + ENDPROC + + PROCEDURE assignthordispatcher + *============================================================================== + * Method: AssignThorDispatcher + * Purpose: Creates the actual dispatcher which reads the keyboard buffer to ascertain + * the name of the tool selected, and calls the PRG. + * The executable code is stored in _Screen.cThorExecute + * Author: Jim Nelson + * Last revision: 04/14/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tcThorApp, tcFolder + + Local lcHomeDir, lcPublishedClasses, lcPublishedClassesHelp, lcThorExecute, lcHomeFolder + + lcPublishedClasses = This.GetPublishedClasses() + lcPublishedClassesHelp = Evl (This.GetPublishedClasses (.T.), '[]') + lcHomeFolder = Addbs(JustPath(tcThorApp)) + + **************************************************************** + Text To lcThorExecute Noshow Textmerge + LParameters lcPRGName, lxP1, lxP2, lxP3, lxP4, lxP5, lxP6, lxP7, lxP8, lxP9, lxP10 + + Local loGetThor As 'GetThorRun' + Local lcFile, lcFolder, lcSys16, lcThorApp, lcThorFolder, llFirst, llThorInkey, lnI, lnInkey, lnPopUpID + Local lnWindowOnTop, loLink, loPEME_Tools, loResult, loThorEngine, loThorInfo, loThorRun + + lcFolder = '<>' + lcThorApp = lcFolder + '<>' + lcThorFolder = lcFolder + '<>' + _Screen.AddProperty('cThorFolder', lcThorFolder) + + llThorInkey = .F. + If Empty (lcPRGName) + llThorInkey = .T. + lcPRGName = '' + Do While Chrsaw() + lnInkey = Inkey() + If lnInkey = 13 + Exit + Endif + lcPRGName = lcPRGName + Chr (lnInkey) + EndDo + Endif + + Do Case + Case Atc('Thor_', lcPrgName) = 1 + If PemStatus(_Screen, 'oThor', 5) = .F. or Vartype(_Screen.oThor) # 'O' + _Screen.AddProperty('oThor', Newobject ('oThor', 'Thor.vcx', lcThorApp, lcThorFolder)) + EndIf + Return ExecuteThorProc(lcPRGName, lcThorFolder, llThorInkey, .F., Pcount(), @lxP1, @lxP2, @lxP3, @lxP4, @lxP5, @lxP6, @lxP7, @lxP8, @lxP9, @lxP10) + + Case Atc([<>], lcPrgName) = 1 + lcFile = GetFullFileName (Alltrim (Substr (lcPRGName, At ('=', lcPRGName) + 1)), lcThorFolder) + Return lcFile + + Case Atc([<>], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcherClasses, lcPRGName, lcThorAPP, Pcount(), lxP1, lxP2, lxP3, lxP4, lxP5) + + Case Atc([<>], lcPrgName) = 1 + loGetThor = Createobject ('GetThorRun') + loThorRun = loGetThor.GetThorRun (lcThorApp, lcThorFolder) + lnPopUpID = Val (Substr (lcPRGName, 1 + At ('=', lcPRGName))) + loThorRun.ExecutePopup (lnPopUpID, lcThorFolder, Set ('DataSession')) + + Case Atc([<>], lcPrgName) = 1 + _Screen.xThorResult = lxP1 + Return lxP1 + + Case Empty (lcPRGName) + Do (lcThorApp) With 'Edit' + + Case Atc([FORMRUNTOOL], lcPrgName) = 1 + Do (lcThorApp) With 'FORMRUNTOOL' + + Case Atc([?], lcPrgName) = 1 + Return ExecScript(_Screen.cThorDispatcherHelp) + + Case Atc([<>], lcPrgName) = 1 + loGetThor = Createobject ('GetThorRun') + loThorRun = loGetThor.GetThorRun (lcThorApp, lcThorFolder) + loThorRun.Run() + + Case Atc([<>], lcPrgName) = 1 + Return lcThorFolder + 'Tools\' + + Case Atc([<>], lcPrgName) = 1 + Return ccThorVersion + + Case Atc([<>], lcPrgName) = 1 + loThorEngine = FetchThorEngine(lcThorApp, lcThorFolder) + Return loThorEngine + + Case Atc([<>], lcPrgName) = 1 + loGetThor = Createobject ('Getthorinfo') + loThorInfo = loGetThor.Getthorinfo (lcThorApp) + Return loThorInfo + + Case Atc([Get Option=], lcPrgName) = 1 + loThorEngine = FetchThorEngine(lcThorApp, lcThorFolder) + Return loThorEngine.GetOption(lxP1, lxP2) + + Case Atc([Set Option=], lcPrgName) = 1 + loThorEngine = FetchThorEngine(lcThorApp, lcThorFolder) + Return loThorEngine.SetOption(lxP1, lxP2, lxP3) + + Case Atc([<>], lcPrgName) = 1 + loGetThor = Createobject ('Getthorinfo') + loThorInfo = loGetThor.Getthorinfo (lcThorApp) + Return loThorInfo.GetSampleToolCode() + + Case Atc([<>], lcPrgName) = 1 + Do (lcThorApp) With 'Clear HotKeys' + + Case Atc([<>], lcPrgName) = 1 + _Screen.lThorDebugMode = not _Screen.lThorDebugMode + Set Mark of Bar <> of <> to _Screen.lThorDebugMode + If _Screen.lThorDebugMode + Set Asserts on + EndIf + + Case Atc([<>], lcPrgName) = 1 + lcFile = GetFullFileName (Alltrim (Substr (lcPRGName, At ('=', lcPRGName) + 1)), lcThorFolder) + If Empty (lcFile) + Return .Null. + Endif + + Return ExecuteThorProc('Thor_Proc_EditProc', lcThorFolder, llThorInkey, .F., 2, lcFile) + + Case Atc([<>], lcPrgName) = 1 + lcFile = GetFullFileName (Alltrim (Substr (lcPRGName, At ('=', lcPRGName) + 1)), lcThorFolder) + If Empty (lcFile) + Return .Null. + Endif + + loThorInfo = Newobject ('ThorInfo', 'Thor_Utils.vcx', lcThorApp) + Do (lcFile) With loThorInfo + loThorInfo.PrgName = Justfname (lcFile) + loThorInfo.FullFileName = lcFile + If Empty (loThorInfo.Link) + loThorEngine = FetchThorEngine(lcThorApp, lcThorFolder) + Messagebox (loThorEngine.GetToolDescription (loThorInfo)) + Else + loLink = Newobject ('_ShellExecute', Home() + 'FFC\_Environ.vcx') + loLink.ShellExecute (loThorInfo.Link) + Endif + + * Get ToolInfo for tool + Case Atc([<>], lcPrgName) = 1 + loResult = .Null. + If Empty (lxP1) Or 'C' # Vartype (lxP1) + Return loResult + Endif + + lcFile = GetFullFileName (lxP1, lcThorFolder) + If Empty (lcFile) + Return loResult + Endif + + Try + loThorInfo = Newobject ('ThorInfo', 'Thor_Utils.vcx', lcThorApp) + Do (lcFile) With loThorInfo + loThorInfo.PrgName = Justfname (lcFile) + loThorInfo.FullFileName = lcFile + loResult = loThorInfo + Catch + + Endtry + Return loResult + + Case Atc([<>], lcPrgName) = 1 + lcPRGName = '' + llFirst = .F. + For lnI = Program (-1) To 1 Step - 1 + lcSys16 = Sys(16, lnI) + Do Case + Case Upper (Getwordnum (lcSys16, 1)) = 'PROCEDURE' + Case Not llFirst + llFirst = .T. + Otherwise + lcPRGName = JustStem (lcSys16) + Exit + Endcase + Endfor + + Return ExecuteThorProc (lcPRGName, lcThorFolder, llThorInkey, .T., Pcount(), @lxP1, @lxP2, @lxP3, @lxP4, @lxP5, @lxP6, @lxP7, @lxP8, @lxP9, @lxP10) + + Otherwise + Return ExecuteThorProc(lcPRGName, lcThorFolder, llThorInkey, .F., Pcount(), @lxP1, @lxP2, @lxP3, @lxP4, @lxP5, @lxP6, @lxP7, @lxP8, @lxP9, @lxP10) + + Endcase + + Return + + + Procedure ExecuteThorProc + Lparameters lcPRGName, lcThorFolder, llThorInkey, llDoDefault, lnPCount, lxP1, lxP2, lxP3, lxP4, lxP5, lxP6, lxP7, lxP8, lxP9, lxP10, lcFileText + + Local lcFullPRGName, lcParams, lnI + lcFullPRGName = GetFullFileName(lcPRGName, lcThorFolder, llDoDefault) + If Empty(lcFullPRGName) + Return .Null. + Endif + + _Screen.lThorInkey = _Screen.lThorInkey Or llThorInkey + _Screen.xThorResult = .T. + If lnPCount < 2 + lcParams = '' + Else + lcParams = 'with lxP1' + For lnI = 2 To lnPCount - 1 + *** DH 2018-10-12: as suggested by Toni Koehler, use ALLTRIM(STR()) instead of + *** TRANSFORM() because with SET POINT TO ',' and SET FIXED ON, TRANSFORM(1) + *** gives "1,000" which looks like multiple parameters: lcP1,lxP2,000,lxP3,000, etc. + * lcParams = lcParams + ', lxP' + Transform(lnI) + lcParams = lcParams + ', lxP' + alltrim(str(lnI)) + Endfor + Endif + + Assert Not _Screen.lThorDebugMode Message 'Debug: ' + Juststem(lcFullPRGName) + Do(lcFullPRGName) &lcParams + + _Screen.lThorInkey = _Screen.lThorInkey And Type('llThorInkey') = 'L' And Not llThorInkey + Return _Screen.xThorResult + Endproc + + + Function GetFullFileName (lcPRGName, lcThorFolder, llDoDefault) + Local lcFile, lcFullPRGName1, lcFullPRGName2 + + If Empty(JustExt(lcPRGName)) + lcFile = Forceext (lcPRGName, 'prg') + Else + lcFile = lcPRGName + EndIf + lcFullPRGName1 = Forcepath (lcFile, lcThorFolder + 'Tools\' + ccMyTools) + lcFullPRGName2 = Forcepath (lcFile, lcThorFolder + 'Tools\' + ccProcs) + lcFullPRGName3 = Forcepath (lcFile, lcThorFolder + 'Tools\') + Do Case + Case File (lcFile) and not llDoDefault + lcFile = Fullpath (lcFile) + Case File (lcFullPRGName1) and not llDoDefault + lcFile = lcFullPRGName1 + Case File (lcFullPRGName2) + lcFile = lcFullPRGName2 + Case File (lcFullPRGName3) + lcFile = lcFullPRGName3 + Otherwise + lcFile = '' + Endcase + Return lcFile + EndFunc + + Function FetchThorEngine(lcThorApp, lcThorFolder) + Local loGetThor As 'GetThorEngine' + Local loThorEngine + If PemStatus(_Screen, 'oThorEngine', 5) and Vartype(_Screen.oThorEngine) = 'O' + loThorEngine = _Screen.oThorEngine + Else + loGetThor = Createobject('GetThorEngine') + loThorEngine = loGetThor.GetThorEngine(lcThorApp, lcThorFolder) + _Screen.AddProperty('oThorEngine', loThorEngine) + EndIf + Return loThorEngine + Endfunc + + Define Class GetThorRun As Session + + Procedure GetThorRun (lcThorApp, lcThorFolder) + Local loThorRun + loThorRun = Newobject ('Thor_Run', 'thor_run.vcx', lcThorApp, lcThorApp, lcThorFolder) + loThorRun.AddProperty('cApplication', lcThorApp) + Return loThorRun + Endproc + + Enddefine + + Define Class GetThorEngine As Session + + Procedure GetThorEngine (lcThorApp, lcThorFolder) + Return Newobject ('Thor_Engine', 'Thor.vcx', lcThorApp, lcThorFolder) + Endproc + + Enddefine + + Define Class GetThorInfo As Session + + Procedure GetThorInfo (lcThorApp) + Return Newobject ('ThorInfo', 'Thor_Utils.vcx', lcThorApp) + Endproc + + Enddefine + + EndText + + lcThorExecute = Chrtran(lcThorExecute, ccLF, '') + lcThorExecute = Chrtran(lcThorExecute, ccCR + ccCR, ccCR) + + **************************************************************** + + lcPropertyName = 'cThorDispatcher' + Removeproperty (_Screen, lcPropertyName) + + _Screen.AddProperty (lcPropertyName, lcThorExecute) + _Screen.AddProperty ('lThorInkey', .F.) + _Screen.AddProperty ('xThorResult', .F.) + _Screen.AddProperty ('lThorExecScript', .F.) + _Screen.AddProperty ('lThorDebugMode', .F.) + + *!* * Removed 2/3/2013 / JRN + *!* If 'C' # Type ('_Screen._MemberData') + *!* _Screen.AddProperty ('_MemberData', ccThorMemberData) + *!* Endif + + Return + + + ENDPROC + + PROCEDURE assignthordispatcherclasses + Lparameters tcThorApp, tcFolder + + Local lcHomeDir, lcPropertyName, lcPublishedClasses, lcPublishedClassesHelp, lcThorExecute + + lcPublishedClasses = This.GetPublishedClasses() + + Text To lcThorExecute Noshow Textmerge + Lparameters lcPRGName, lcThorAPP, lnPCount, lxP1, lxP2, lxP3, lxP4, lxP5 + Local lcClass, lcClassLib, lcClassName, lcFileName, loEditorWin, loObject + lcClassName = Alltrim (Substr (lcPRGName, 1 + Len (ccClass))) + Do Case + Case Lower (lcClassName) = 'contextmenu' + Return Newobject ('contextmenu', 'thor_menu.vcx', lcThorAPP, , , lxP1) + Case Lower (lcClassName) = 'settings' + Return Newobject ('thor_resource', 'thor_foxresource.vcx', lcThorAPP) + Case Lower (lcClassName) = 'thorformsettings' + Return Newobject ('thor_form_settings', 'thor_foxresource.vcx', lcThorAPP, lxP1) + Case Lower (lcClassName) = 'formruntool' + Return Newobject ('formruntool', 'thor_ui.vcx', lcThorAPP, Addbs(JustPath(lcThorAPP))) + Case Lower (lcClassName) = 'optionrenderengine' + lcFileName = Execscript (_Screen.cThorDispatcher, 'Full Path=Thor_Proc_DynamicForm.prg') + Return Newobject ('Thor_Proc_DynamicFormRenderEngine', lcFileName) + Case Lower (lcClassName) = 'dynamicformdesktop' + lcFileName = Execscript (_Screen.cThorDispatcher, 'Full Path=Thor_Proc_DynamicForm.prg') + Return Newobject ('Thor_DynamicFormDeskTop', lcFileName) + Case Lower (lcClassName) = 'dynamicform' + lcFileName = Execscript (_Screen.cThorDispatcher, 'Full Path=Thor_Proc_DynamicForm.prg') + Return Newobject ('Thor_DynamicForm', lcFileName) + Case Lower (lcClassName) = 'findexe' + Return Newobject ('FindEXE', 'thor_utils.vcx', lcThorAPP) + << lcPublishedClasses >> + Otherwise + lcClass = Getwordnum (lcClassName, 1) + lcClassLib = Getwordnum (lcClassName, Getwordcount (lcClassName)) + lcFileName = Execscript (_Screen.cThorDispatcher, 'Full Path=' + lcClassLib) + Do Case + Case lnPCount < 2 + loObject = Newobject (lcClass, lcFileName) + Case lnPCount = 2 + loObject = Newobject (lcClass, lcFileName, '', lxP1) + Case lnPCount = 3 + loObject = Newobject (lcClass, lcFileName, '', lxP1, lxP2) + Case lnPCount = 4 + loObject = Newobject (lcClass, lcFileName, '', lxP1, lxP2, lxP3) + Case lnPCount = 5 + loObject = Newobject (lcClass, lcFileName, '', lxP1, lxP2, lxP3, lxP4) + Case lnPCount = 6 + loObject = Newobject (lcClass, lcFileName, '', lxP1, lxP2, lxP3, lxP4, lxP5) + Otherwise + Endcase + Return loObject + EndCase + Endtext + + **************************************************************** + lcPropertyName = 'cThorDispatcherClasses' + Removeproperty (_Screen, lcPropertyName) + + _Screen.AddProperty (lcPropertyName, lcThorExecute) + + ENDPROC + + PROCEDURE assignthordispatcherhelp + *============================================================================== + * Method: AssignThorDispatcher + * Purpose: Creates the actual dispatcher which reads the keyboard buffer to ascertain + * the name of the tool selected, and calls the PRG. + * The executable code is stored in _Screen.cThorExecute + * Author: Jim Nelson + * Last revision: 04/14/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tcThorApp, tcFolder + + Local lcPropertyName, lcPublishedClassesHelp, lcThorExecute, lcFolder + lcQuote = IIF(' ' $ tcFolder, ['], '') + lcPublishedClassesHelp = Evl (This.GetPublishedClasses (.T.), '[]') + + **************************************************************** + + Text To lcThorExecute Noshow Textmerge + loResult = Createobject ('Empty') + + lxResult = '' + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [* get an option] + lxResult = lxResult + ccCR + ccLF + [lxValue |] + [Get Option=] + [", cKey, cTool] + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [* set an option] + lxResult = lxResult + ccCR + ccLF + [Set Option=] + [", cKey, cTool, xValue] + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [lcVersion |] + [<>] + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [lcToolFolder |] + [<>] + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [* Return full file name and path] + lxResult = lxResult + ccCR + ccLF + [lcFileName |] + [<>] + [" + ToolName) &] + [& e.g., "Thor_Tool_GoFish4] + lxResult = lxResult + ccCR + ccLF + [Empty] + *** DH 2018-04-10: new URL + *lxResult = lxResult + ccCR + ccLF + [* ContextMenu home page = http://vfpx.codeplex.com/wikipage?title=Thor%20Framework%20ContextMenu] + lxResult = lxResult + ccCR + ccLF + [* ContextMenu home page = https://github.com/VFPX/Thor/blob/master/Docs/Thor_framework_contextmenu.md] + lxResult = lxResult + ccCR + ccLF + [Local loContextMenu as ContextMenu of <>Source\Thor_Menu.vcx<>] + lxResult = lxResult + ccCR + ccLF + [loContextMenu|] + [<>] + lxResult = lxResult + ccCR + ccLF + [Empty] + *** DH 2018-04-10: new URL + *lxResult = lxResult + ccCR + ccLF + [* ThorFormSettings home page = http://vfpx.codeplex.com/wikipage?title=Thor%20Framework%20FormSettings] + lxResult = lxResult + ccCR + ccLF + [* ThorFormSettings home page = https://github.com/VFPX/Thor/blob/master/Docs/Thor_framework_formsettings.md] + lxResult = lxResult + ccCR + ccLF + [Local loSettings as Thor_Form_Settings of <>Source\Thor_FoxResource.vcx<>] + lxResult = lxResult + ccCR + ccLF + [loSettings |] + [<>] + *!* * Removed 10/13/2011 + *!* lxResult = lxResult + ccCR + ccLF + [Empty] + *!* lxResult = lxResult + ccCR + ccLF + [<>] + + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [* Execute default procedure] + lxResult = lxResult + ccCR + ccLF + [lxResult |] + [<>] + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [* Retrieve ThorInfo object for a Tool] + lxResult = lxResult + ccCR + ccLF + [Local loThorInfo as ThorInfo of <>Source\Thor_Utils.vcx<>] + lxResult = lxResult + ccCR + ccLF + [loThorInfo |] + [<>] + [" , ToolName) &] + [& e.g., "Thor_Tool_GoFish4] + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [* Object used by APPs which self-register with Thor] + lxResult = lxResult + ccCR + ccLF + [Local loRegister as Thorinfo of <>Source\Thor_Utils.vcx<>] + lxResult = lxResult + ccCR + ccLF + [loRegister |] + [<>] + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [* Main Thor Engine] + lxResult = lxResult + ccCR + ccLF + [Local loThor as Thor_Engine of <>Source\Thor.vcx<>] + lxResult = lxResult + ccCR + ccLF + [loThor |] + [<>] + + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [* Retrieve sample tool template] + lxResult = lxResult + ccCR + ccLF + [lcTemplate |] + [<>] + + lxResult = lxResult + ccCR + ccLF + [Empty] + lxResult = lxResult + ccCR + ccLF + [<>] + lxResult = lxResult + ccCR + ccLF + [Edit] + lxResult = lxResult + ccCR + ccLF + [<>] + + AddProperty (loResult, 'Internal', lxResult) + + lxResult = << lcPublishedClassesHelp >> + AddProperty (loResult, 'External', lxResult) + + Return loResult + Endtext + + **************************************************************** + lcPropertyName = 'cThorDispatcherHelp' + Removeproperty (_Screen, lcPropertyName) + + _Screen.AddProperty (lcPropertyName, lcThorExecute) + + ENDPROC + + PROCEDURE clear && Clears the contents of a ComboBox or ListBox control. + *============================================================================== + * Method: Clear + * Purpose: Clears out Thor, removing system menu + * Author: Jim Nelson + * Last revision: 04/14/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Set Sysmenu To Default + + + ENDPROC + + PROCEDURE clearhotkeys && Removes all the Thor-assigned hotkeys + Local loHotKeysCollection As 'Collection' + Local lcFKYFile, lcFKYFileName, lcMacro, lcMacroName, lnCount, lnI, lnLength, lnNextByte + Local lnTotalLength + + lcFKYFileName = Addbs (Sys(2023)) + Forceext (Sys(2015), 'FKY') + This.EraseFile(lcFKYFileName) + + Save Macros To (lcFKYFileName) + lcFKYFile = Filetostr (lcFKYFileName) + This.EraseFile(lcFKYFileName) + + lnCount = (256 * Asc (Substr (lcFKYFile, 18))) + Asc (Substr (lcFKYFile, 17)) + + loHotKeysCollection = Createobject ('Collection') + lnNextByte = 19 + For lnI = 1 To lnCount + lnLength = (256 * Asc (Substr (lcFKYFile, lnNextByte + 21))) + Asc (Substr (lcFKYFile, lnNextByte + 20)) + lnTotalLength = 24 + (2 * lnLength) + lcMacro = Substr (lcFKYFile, lnNextByte, lnTotalLength) + lnNextByte = lnNextByte + lnTotalLength + + lcMacroName = Left (lcMacro, 20) + If Upper (lcMacroName) # Upper ('Thor:') + loHotKeysCollection.Add (lcMacro) + Endif + Endfor && lnI = 1 to lnCount + + Clear Macros + This.AssignHotKeys (loHotKeysCollection) + + + + + ENDPROC + + PROCEDURE createmacro + *============================================================================== + * Method: CreateMacro + * Purpose: Creates the character string entry for a single macro (for a FKY file) + * Author: Jim Nelson + * Last revision: 03/22/2011 + * Parameters: tcMacroName -- Name of the macro, up to length 20 + * tcKeyCode -- Internal (FKY) representation of key being defined (two bytes) + * tcLeadingKeystrokes -- Internal representation of leading keys in macro (two bytes each) + * tcCommand -- Remainder of macro definition (normal character string) + * Returns: The macro text + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tcMacroName, ; + tcKeyCode, ; + tcLeadingKeystrokes, ; + tcCommand + + Local lcCode, lcMacro, lcMacros, lnI + + lcMacros = Padr (Trim (tcMacroName), 20, Chr(0)) + ; + Chr (Len (tcCommand) + Len (tcLeadingKeystrokes) / 2) + Chr(0) + ; + tcKeyCode + ; + tcLeadingKeystrokes + + For lnI = 1 To Len (tcCommand) + lcMacros = lcMacros + Substr (tcCommand, lnI, 1) + Chr(0) + Next lnI + + Return lcMacros + + ENDPROC + + PROCEDURE createtoolbar + Local lcName, lcToolTip, lnI, loToolBar + + Select *, ; + Upper(Caption) As UCaption ; + From ToolBarTools ; + Where Enabled ; + Order By UCaption, Order ; + Into Cursor crsr_ToolBars Readwrite + + If _Tally = 0 + Return + Endif + + If Type('_Screen.oThor_ToolBar') = 'O' And Vartype(_Screen.oThor_toolbar) = 'O' + loToolBar = _Screen.oThor_toolbar + For lnI = m.loToolBar.ControlCount To 1 Step - 1 + m.loToolBar.RemoveObject(m.loToolBar.Controls[m.lnI].Name) + Endfor + Else + loToolBar = Newobject('Thor_ToolBar', 'Thor_Run.VCX', This.cApplication) + Endif + + Select crsr_ToolBars + Scan + lcName = 'Button' + Transform(Recno()) + m.loToolBar.Newobject(m.lcName, 'Thor_ToolBar_Button', 'Thor_Run.VCX', This.cApplication) + lcToolTip = Trim(ToolTip) + If Seek(Upper(PRGName), 'ToolHotKeyAssignments', 'PRGName') + If Seek(ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + lcToolTip = m.lcToolTip + ' (' + Trim(HotKeyDefinitions.Descript) + ')' + Endif + Endif + With m.loToolBar.&lcName + .ToolTipText = m.lcToolTip + .Picture = Trim(Icon) + .Caption = Trim(Caption) + .Visible = .T. + .cAction = Trim(PRGName) + Endwith + Endscan + + If This.oThorEngine.GetOption ('ThorToolsBarDock0') And m.loToolBar.DockPosition # 0 + m.loToolBar.Dock(0) + Endif + m.loToolBar.Show() + + _Screen.AddProperty('oThor_ToolBar', m.loToolBar) + + ENDPROC + + PROCEDURE createtoplevelbars + *============================================================================== + * Method: CreateTopLevelBars + * Purpose: Adds bars to all top level pads + * Author: Jim Nelson + * Last revision: 03/21/2011 + * Parameters: tcFolder ... folder for tools + * Returns: none + * Environment in: Table MenuDefinitions + * Environment out: none + *============================================================================== + + Lparameters tcFolder + Local loContextMenu As 'ContextMenu' Of 'Thor_Menu.vcx' + Local laTopLevel[1], lcPopupName, lnI, loMenu + + Select Id ; + , PopupName ; + From MenuDefinitions ; + Where TopLevel ; + And (PopupName = ccRunAllTools ; + Or Id In ( ; + Select MenuID ; + From MenuTools ; + Where Not Deleted())) ; + And Not Deleted() ; + Into Array laTopLevel + + For lnI = 1 To _Tally + lcPopupName = Alltrim (laTopLevel (lnI, 2)) + If lcPopupName = ccRunAllTools and not This.oThorEngine.GetOption ('ThorToolsSystemMenu') + Loop + EndIf + loContextMenu = Newobject ('ContextMenu', 'Thor_Menu.vcx', This.cThorApp, lcPopupName, 31416) + If lcPopupName = ccRunAllTools + This.AddAllTools (loContextMenu, tcFolder, , ) &&ccModify) + Else + This.AddMenuItems (loContextMenu, laTopLevel (lnI, 1), tcFolder) + EndIf + loMenu = .Null. + Endfor + + + ENDPROC + + PROCEDURE createtoplevelpads + *============================================================================== + * Method: CreateTopLevelPads + * Purpose: Cleans up previous top level pads, removing any user-defined pads, + * and removes all bars added to internal pads; then adds any user-defined pads + * Author: Jim Nelson + * Last revision: 03/21/2011 + * Parameters: none + * Returns: none + * Environment in: Table MenuDefinitions + * Environment out: none + *============================================================================== + + Local lcKey, lcKeyx, lcLastPopupName, lcPopupName, lcPrompt, lcStatusBar, llSystemMenuPads + + * This.Clear() + + *** JRN 5/17/2011 : system menu pads managed by other programs (VPM, e.g.) + * llSystemMenuPads = This.oThorEngine.GetOption ('SystemMenuPads') + Select MenuDefinitions + Set Order To Sortorder + + *** JRN 2011-06-19 : Wish I didn't have to do this ... + Release Pad _PEMEditor Of _Msysmenu + + lcLastPopupName = '' + + Scan + lcPrompt = Alltrim(Prompt) + lcPopupName = Alltrim(PopupName) + lcStatusBar = Evl(Alltrim(StatusBar), 'Help not defined') + Do Case + + Case Internal + * remove all other entries + *!* If Not llSystemMenuPads + *!* Release Bar All Of &lcPopupName + *!* Release Pad All Of &lcPopupName + *!* Endif + lcLastPopupName = lcPopupName + + Case TopLevel + * remove all other entries + Release Pad &lcPopupName Of _Msysmenu + + If lcPopupName = ccRunAllTools And Not This.oThorEngine.GetOption('ThorToolsSystemMenu') + Loop + Endif + * and create the new entry, positioning as required + + lcKey = '' + If '\<' $ lcPrompt + lcKeyx = Substr(lcPrompt, At('\<', lcPrompt) + 2, 1) + If Isalpha(lcKeyx) Or Isdigit(lcKeyx) + lcKey = 'Key Alt+' + lcKeyx + Endif + Endif + + If Empty(lcLastPopupName) + Define Pad &lcPopupName Of _Msysmenu Prompt lcPrompt &lcKey Before _Mfile Message(lcStatusBar) + Else + Define Pad &lcPopupName Of _Msysmenu Prompt lcPrompt &lcKey After &lcLastPopupName Message(lcStatusBar) + Endif + + On Pad &lcPopupName Of _Msysmenu Activate Popup &lcPopupName + Define Popup &lcPopupName Margin Relative Shadow Color Scheme 4 + lcLastPopupName = lcPopupName + + Otherwise + * remove all other entries + Release Pad &lcPopupName Of _Msysmenu + + Endcase + + Endscan + + ENDPROC + + PROCEDURE erasefile + Lparameters lcFileName + + Local loException + Try + Erase (m.lcFileName) + Catch To m.loException + + Endtry + + ENDPROC + + PROCEDURE executepopup + *============================================================================== + * Method: ExecutePopUp + * Purpose: Pops up a popup menu; called by hot key by way of ThorDispatcher + * Author: Jim Nelson + * Last revision: 03/28/2011 + * Parameters: lnMenuID -- ID of the Menu in MenuDefinitions + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters lnMenuID, tcFolder, tnDataSession + + Local loContextMenu As 'ContextMenu' Of 'Thor_Menu.vcx' + + loContextMenu = Newobject ('ContextMenu', 'Thor_Menu.vcx', This.cThorApp) + This.AddMenuItems (loContextMenu, lnMenuID, tcFolder + 'Tools\') + + loContextMenu.SetDataSession (tnDataSession) + + loContextMenu.Activate() + + + ENDPROC + + PROCEDURE gethotkeyscollection + Lparameters tcFolder + Local loHotKeysCollection As 'Collection' + + loHotKeysCollection = Createobject ('Collection') + + This.AddToolHotKeys (tcFolder, loHotKeysCollection) + This.AddPopUpHotKeys (loHotKeysCollection) + + Return loHotKeysCollection + ENDPROC + + PROCEDURE getpublishedclasses + Lparameters tlForHelp + + Local laClasses[1], laClasslist[1], lcAppName, lcClass, lcClassInfo, lcClassLib, lcFullAppName + Local lcNewText, lcResult, lnCount, lnI, lnPos, loTool, loTools + + loTools = This.oToolsCollection + + Create Cursor crsr_Classes (AppName C(40), Class C(250), FullAPPName C(200), VarName C(40)) + For Each loTool In loTools FoxObject + If Not Empty (loTool.Classes) + lnCount = Alines (laClasses, loTool.Classes, .T., ',') + For lnI = 1 To lnCount + lcClass = laClasses (lnI) + If '=' $ lcClass + lnPos = At('=', lcClass) + lcVariable = allTrim(Left(lcClass, lnPos - 1)) + lcClass = Alltrim(Substr(lcClass, lnPos + 1)) + Else + lcVariable = '' + EndIf + If tlForHelp + lcClass = Lower (lcClass) + Else + lcClass = Lower (Getwordnum (lcClass, 1, '|')) + Endif + Insert Into crsr_Classes Values (Juststem (Lower (loTool.AppName)), lcClass, Lower (loTool.FullAPPName), lcVariable) + Endfor + Endif + Endfor && each loTool in loTools foxobject + + Select Distinct AppName ; + , Class ; + , FullAPPName ; + , VarName ; + From crsr_Classes ; + Into Array laClasslist + + lcResult = '' + For lnI = 1 To _Tally + lcClassInfo = Trim (laClasslist (lnI, 2)) + lcAppName = Evl(Juststem (Trim (laClasslist (lnI, 1))), JustFname(GetWordNum(lcClassInfo,3))) + lcFullAppName = Trim (laClasslist (lnI, 3)) + lcVariable = Trim (laClasslist (lnI, 4)) + + lcClass = Getwordnum (lcClassInfo, 1) + lcClassLib = Getwordnum (lcClassInfo, Getwordcount (Class)) + + Do Case + Case tlForHelp + TEXT To lcNewText Textmerge Noshow + + ccCR + ccLF + [<><> <> from <><>] + ENDTEXT + If Empty (lcResult) + lcResult = lcNewText + Else + lcResult = lcResult + ';' + ccCR + ccLF + Space(19) + lcNewText + Endif + + Case lcClass == 'tools' And lcAppName = 'pemeditor' + TEXT To lcNewText Textmerge Noshow + Case Lower(lcClassName) = '<> from <>' + ExecScript(_Screen.cThorDispatcher, 'PEMEditor_StartIDETools') + Return _oPEMEditor.oTools + + ENDTEXT + lcResult = lcResult + lcNewText + + Case lcClass == 'editorwin' And lcAppName = 'pemeditor' + TEXT To lcNewText Textmerge Noshow + Case Lower(lcClassName) = '<> from <>' + ExecScript(_Screen.cThorDispatcher, 'PEMEditor_StartIDETools') + loEditorWin = _oPEMEditor.oEditorWin + loEditorWin.FindWindow() + Return loEditorWin + + ENDTEXT + lcResult = lcResult + lcNewText + + Otherwise + TEXT To lcNewText Textmerge Noshow + Case Lower(lcClassName) = '<> from <>' + Return NewObject('<>', '<>', '<>') + + ENDTEXT + lcResult = lcResult + lcNewText + + Endcase + Endfor + + Return lcResult + ENDPROC + + PROCEDURE Init + *============================================================================== + * Method: Init + * Purpose: Creates property .oThorEngine and opens all tables + * Author: Jim Nelson + * Last revision: 03/28/2011 + * Parameters: lnMenuID -- ID of the Menu in MenuDefinitions + * tcFolder -- folder for tools + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tcThorApp, tcFolder + + With This + + .cThorApp = tcThorApp + .cThorFolder = tcFolder + + .oThorEngine = Newobject ('Thor_Engine', 'Thor.vcx', tcThorApp, tcFolder) + .oThorEngine.OpenTables() + .oToolsCollection = .oThorEngine.GetToolsCollection (.cThorFolder + 'Tools\') + + Endwith + + Set Deleted On + + ENDPROC + + PROCEDURE popupalltools + *============================================================================== + * Method: AddAllTools + * Purpose: For the internal sub-menu 'All Tools', adds ALL tools + * Author: Jim Nelson + * Last revision: 04/14/2011 + * Parameters: None + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tnDataSession, tcOnlySource + Local loContextMenu As 'ContextMenu' Of 'Thor_Menu.vcx' + + loContextMenu = Newobject ('ContextMenu', 'Thor_Menu.vcx', This.cThorApp) + This.AddAllTools (loContextMenu, This.cThorFolder + 'Tools\', tcOnlySource) + + loContextMenu.SetDataSession (tnDataSession) + + loContextMenu.Activate() + + ENDPROC + + PROCEDURE run && Occurs when an Active Document is ready to execute your application code. + *============================================================================== + * Method: Run + * Purpose: Assigns hot keys, creates pop-up menus, updates system menus, and all sub-menus + * Author: Jim Nelson + * Last revision: 03/21/2011 + * Parameters: llNoStartUps + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + Lparameters llNoStartUps + + * #Define * WriteDebugInfo StrToFile(Transform(Lineno()) + ' / ' + Transform(Seconds() - lnSeconds) + chr[13] + chr[10], lcFile, 1) + lcFile = Sys(2023) + '\Thor_' + Sys(2015) + '.txt' + lnSeconds = Seconds() + + With This + + * WriteDebugInfo + .AssignDedicatedHotKey() + + * Create _Screen.cThorDispatcher + * WriteDebugInfo + .AssignThorDispatcherHelp (.cThorApp, .cThorFolder) + * WriteDebugInfo + .AssignThorDispatcherClasses (.cThorApp, .cThorFolder) + * WriteDebugInfo + .AssignThorDispatcher (.cThorApp, .cThorFolder) + + * create all top level bars, removing traces of previously defined bars + * WriteDebugInfo + .CreateTopLevelPads() + + * and then add in their tools and sub-menus + * WriteDebugInfo + .CreateTopLevelBars (.cThorFolder + 'Tools\') + + * and all the hotkeys + * WriteDebugInfo + .ClearHotKeys() + + * AGAIN -- so we can set up Debug Mode for dispatcher + * WriteDebugInfo + .AssignThorDispatcher (.cThorApp, .cThorFolder) + + * Create Tool Bar + .CreateToolBar() + + * WriteDebugInfo + .AssignAllHotKeys() + + * WriteDebugInfo + .UpdateOptionsList() + + * and run any startups + * WriteDebugInfo + If not llNoStartUps + .RunStartupPRGs + EndIf + + Endwith + + + ENDPROC + + PROCEDURE runstartupprgs + *============================================================================== + * Method: RunStartupPRGS + * Purpose: Runs all of the startups (if any) + * Author: Jim Nelson + * Last revision: 05/02/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Select PRGName ; + from StartupTools ; + where Startup ; + into cursor crsr_StartUps + + Scan + ExecScript(_Screen.cThorDispatcher, Trim(PRGName), .T.) + Endscan + + + ENDPROC + + PROCEDURE updateoptionslist + Local laClasses[1], lcClass, lcClassName, lcLibrary, lnCounter, lnI, lnJ, lnValue, loClass, loTool + + For lnI = 1 To This.oToolsCollection.Count + loTool = This.oToolsCollection[lnI] + If Not Empty(loTool.OptionClasses) + lnCounter = Alines(laClasses, loTool.OptionClasses, 5, ',') + For lnJ = 1 To lnCounter + lcClass = laClasses[lnJ] + loClass = Newobject(lcClass, loTool.FullFileName) + lcClassName = loClass.EditClassName + Do Case + Case Getwordcount(lcClassName) = 0 + lcLibrary = '' + lcClassName = '' + Case Getwordcount(lcClassName) = 1 + lcLibrary = loTool.FullFileName + Otherwise + lcLibrary = Execscript(_Screen.cThorDispatcher, 'Full Path=' + Getwordnum(lcClassName, Getwordcount(lcClassName))) + lcClassName = Getwordnum(lcClassName, 1) + Endcase + + Do Case + Case Not This.oThorEngine.FindOption(loClass.Key, loClass.Tool) + Insert Into Thor(Key, Tool, Class, Library) ; + Values ; + (loClass.Key, loClass.Tool, lcClassName, lcLibrary) + If Pemstatus(loClass, 'Value', 5) + This.oThorEngine.SetOption(loClass.Key, loClass.Tool, loClass.Value) + Else + This.oThorEngine.SetOption(loClass.Key, loClass.Tool, Null) + Endif + + Case Upper(Thor.Class) == Upper(lcClassName) ; + And Upper(Thor.Library) == Upper(lcLibrary) + + Otherwise + Replace Class With lcClassName ; + Library With lcLibrary ; + In Thor + Endcase + Endfor + Endif + Endfor && lnI = 1 to This.oToolsCollection.Count + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_toolbar AS toolbar + *< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: savesettings + *p: ndockposition + *p: osettings + *p: _memberdata && XML Metadata for customizable properties + * + + Caption = "THOR Quick Access" + DataSession = 2 + Left = 0 + Name = "thor_toolbar" + ndockposition = 0 + osettings = .NULL. + Top = 0 + _memberdata = + + + + && XML Metadata for customizable properties + + PROCEDURE AfterDock + This.SaveSettings() + + ENDPROC + + PROCEDURE Destroy + This.SaveSettings() + This.oSettings = .Null. + ENDPROC + + PROCEDURE Init + *** 2018-04-10: new URL: https://github.com/VFPX/Thor/blob/master/Docs/Thor_framework_formsettings.md + * ThorFormSettings home page = http://vfpx.codeplex.com/wikipage?title=Thor%20Framework%20FormSettings + Local loSettings as Thor_Form_Settings of 'C:\VISUAL FOXPRO\PROGRAMS\9.0\COMMON\Thor\Source\Thor_FoxResource.vcx' + Set Talk Off + loSettings = ExecScript(_Screen.cThorDispatcher, "Class= ThorFormSettings", 'ThorToolBar') + + lnSelect = Select() + loSettings.Restore(This) + loSettings.Restore(This, 'nDockPosition') + If This.nDockPosition >= 0 + This.Dock(This.nDockPosition) + EndIf + + This.oSettings = loSettings + Select (lnSelect) + + ENDPROC + + PROCEDURE Moved + This.SaveSettings() + + ENDPROC + + PROCEDURE savesettings + If Type('This.oSettings') = 'O' And Vartype(This.oSettings) = 'O' + This.nDockPosition = This.DockPosition + This.oSettings.Save (This) + Endif + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_toolbar_button AS commandbutton + *< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: caption_assign + *m: picture_assign + *p: caction + *p: _memberdata && XML Metadata for customizable properties + * + + caction = + Caption = "" + FontSize = 8 + Height = 24 + Name = "thor_toolbar_button" + Picture = + SpecialEffect = 2 + Width = 24 + _memberdata = + + + + + + && XML Metadata for customizable properties + + PROCEDURE caption_assign + Lparameters tCaption + This.Caption = tCaption + + If Empty(tCaption) + Return + Endif + + With This + .AutoSize = .T. + .AutoSize = .F. + .Width = .Width - 7 + .Height = 22 + Endwith + ENDPROC + + PROCEDURE Click + Set Datasession to 1 + ExecScript(_Screen.cThorDispatcher, This.cAction) + + ENDPROC + + PROCEDURE picture_assign + lparameters tPicture + This.Picture = tPicture + + This.Height = 22 + This.Width = 24 + ENDPROC + + PROCEDURE RightClick + Execscript (_Screen.cThorDispatcher, 'Thor_Proc_EditProc', This.cAction) + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_toolbar_separator AS separator + *< CLASSDATA: Baseclass="separator" Timestamp="" Scale="Pixels" Uniqueid="" /> + + Height = 0 + Left = 0 + Name = "thorseparator" + Style = 0 + Top = 0 + Width = 0 + +ENDDEFINE diff --git a/Thor/Source/thor_sf_splitter.vc2 b/Thor/Source/thor_sf_splitter.vc2 new file mode 100644 index 00000000..133d50f4 --- /dev/null +++ b/Thor/Source/thor_sf_splitter.vc2 @@ -0,0 +1,739 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_sf_splitter.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS gripper AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="GripperDot1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="GripperDot2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="GripperDot3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="GripperDot4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="GripperDot5" UniqueID="" Timestamp="" /> + + * + *m: setupforhorizontalsplitter && A method to set the positions of the dots to a vertical orientation. + *m: setupforverticalsplitter && A method to set the positions of the dots to a horizontal orientation. + *m: setupgripper && The setup method to positiosn the dots according to the orientation of the splitter, also sets up the number of dots. + *p: ndots && Enter a number from 0 to 5 to indicate how many gripper dots to show. Enter 0 for none. + *p: _memberdata && XML Metadata for customizable properties + * + + BackStyle = 0 + BorderWidth = 0 + Height = 19 + Name = "gripper" + ndots = 5 && Enter a number from 0 to 5 to indicate how many gripper dots to show. Enter 0 for none. + Width = 36 + _memberdata = + + + + + && XML Metadata for customizable properties + + ADD OBJECT 'GripperDot1' AS gripperdot WITH ; + Left = 2, ; + Name = "GripperDot1", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sf_splitter.vcx" BaseClass="container" /> + + ADD OBJECT 'GripperDot2' AS gripperdot WITH ; + Left = 6, ; + Name = "GripperDot2", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sf_splitter.vcx" BaseClass="container" /> + + ADD OBJECT 'GripperDot3' AS gripperdot WITH ; + Left = 10, ; + Name = "GripperDot3", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sf_splitter.vcx" BaseClass="container" /> + + ADD OBJECT 'GripperDot4' AS gripperdot WITH ; + Left = 14, ; + Name = "GripperDot4", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sf_splitter.vcx" BaseClass="container" /> + + ADD OBJECT 'GripperDot5' AS gripperdot WITH ; + Left = 18, ; + Name = "GripperDot5", ; + Top = 4, ; + ShapeDark.BackStyle = 0, ; + ShapeDark.Name = "ShapeDark", ; + ShapeDark.ZOrderSet = 0, ; + ShapeLight.Name = "ShapeLight", ; + ShapeLight.ZOrderSet = 1, ; + ShapeMiddle.Name = "ShapeMiddle", ; + ShapeMiddle.ZOrderSet = 2 + *< END OBJECT: ClassLib="thor_sf_splitter.vcx" BaseClass="container" /> + + PROCEDURE MouseMove + * If the user starts a drag on us, bubble it up to the splitter. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + + PROCEDURE setupforhorizontalsplitter && A method to set the positions of the dots to a vertical orientation. + local lnDotHeight, ; + lnI, ; + loDot + with This + + * Position the dots in a vertical orientation for a horizontal splitter. + + lnDotHeight = .GripperDot1.Height + for lnI = 1 to 5 + loDot = evaluate('.GripperDot' + transform(lnI)) + loDot.Left = 2 + loDot.Top = (lnDotHeight * lnI - 1) + 1 + next lnI + + * Adjust the container so it shows the correct number of dots. + + .Height = .nDots * lnDotHeight + .Width = lnDotHeight + 1 + + * Center the container and set Anchor so it stays centered. + + .Left = (.Parent.Width - .Width)/2 - 1 + .Top = (.Parent.Height - .Height)/2 + .Anchor = 512 + endwith + + ENDPROC + + PROCEDURE setupforverticalsplitter && A method to set the positions of the dots to a horizontal orientation. + local lnDotWidth, ; + lnI, ; + loDot + with This + + * Position the dots in a horizontal orientation for a vertical splitter. + + lnDotWidth = .GripperDot1.Width + for lnI = 1 to 5 + loDot = evaluate('.GripperDot' + transform(lnI)) + loDot.Left = (lnDotWidth * lnI - 1) + 1 + loDot.Top = 2 + next lnI + + * Adjust the container so it shows the correct number of dots. + + .Width = .nDots * lnDotWidth + .Height = lnDotWidth + 1 + + * Center the container and set Anchor so it stays centered. + + .Top = (.Parent.Height - .Height)/2 - 1 + .Left = (.Parent.Width - .Width)/2 + .Anchor = 256 + endwith + + ENDPROC + + PROCEDURE setupgripper && The setup method to positiosn the dots according to the orientation of the splitter, also sets up the number of dots. + local loDot + with This + + * Get the number of dots to use. + + .nDots = .Parent.nDots + + * Use the same MousePointer as the splitter, both for ourselves and each dot. + + .MousePointer = .Parent.MousePointer + for each loDot in .Controls foxobject + loDot.SetAll('MousePointer', .MousePointer) + next loDot + + * Adjust the gripper based on whether this is a vertical or horizontal + * splitter. + + if .Parent.Width > .Parent.Height + .SetupForVerticalSplitter() + else + .SetupForHorizontalSplitter() + endif .Parent.Width > .Parent.Height + endwith + + ENDPROC + +ENDDEFINE + +DEFINE CLASS gripperdot AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="ShapeDark" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ShapeLight" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ShapeMiddle" UniqueID="" Timestamp="" /> + + BackStyle = 0 + BorderWidth = 0 + Height = 4 + Name = "gripperdot" + Width = 4 + + ADD OBJECT 'ShapeDark' AS shape WITH ; + BackStyle = 1, ; + BorderStyle = 0, ; + BorderWidth = 0, ; + FillColor = 80,80,80, ; + FillStyle = 0, ; + Height = 2, ; + Left = 1, ; + Name = "ShapeDark", ; + Top = 1, ; + Width = 2 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'ShapeLight' AS shape WITH ; + BackStyle = 1, ; + BorderStyle = 0, ; + BorderWidth = 0, ; + FillColor = 250,250,250, ; + FillStyle = 0, ; + Height = 2, ; + Left = 2, ; + Name = "ShapeLight", ; + Top = 2, ; + Width = 2 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'ShapeMiddle' AS shape WITH ; + BackStyle = 1, ; + BorderStyle = 0, ; + BorderWidth = 0, ; + FillColor = 173,209,255, ; + FillStyle = 0, ; + Height = 1, ; + Left = 2, ; + Name = "ShapeMiddle", ; + Top = 2, ; + Width = 1 + *< END OBJECT: BaseClass="shape" /> + + PROCEDURE MouseMove + * If the user starts a drag on us, bubble it up to our container. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + + PROCEDURE ShapeDark.MouseMove + * If the user starts a drag on us, bubble it up to our container. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + + PROCEDURE ShapeLight.MouseMove + * If the user starts a drag on us, bubble it up to our container. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + + PROCEDURE ShapeMiddle.MouseMove + * If the user starts a drag on us, bubble it up to our container. + + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + This.Parent.MouseMove(tnButton, tnShift, tnXCoord, tnYCoord) + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_sfsplitter AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Gripper" UniqueID="" Timestamp="" /> + + * + *m: adjustminimum && Adjusts the form so it can't be sized too small + *m: getobject1size && Gets the size for Object 1 + *m: getobject2size && Gets the size for Object 2 + *m: getposition && Returns the new position: X for a horizontal splitter and Y for a vertical splitter + *m: moveobject1 && Moves Object 1 to the new position + *m: moveobject2 && Moves Object 2 to the new position + *m: movesplittertoposition && Moves the splitter to the specified position + *m: setposition && Sets the new position for the splitter + *m: setupgripper && A method to setup various properties on the gripper to visually configure it for Vertical or Horizontal configuration. + *m: splittermoved && Called after the splitter is moved + *p: cobject1name && The name of the object above (for a vertical splitter) or to the left of (for a horizontal splitter) the splitter + *p: cobject2name && The name of the object below (for a vertical splitter) or to the right of (for a horizontal splitter) the splitter + *p: lshowgripper && .T. to display the splitter visually including the gripper control + *p: ndots && Enter a value between 0 and 5 for the number of dots to be shown on the gripper. Enter 0 for none. + *p: nobject1minsize && The minimum height (for a vertical splitter) or width (for a horizontal splitter) of Object 1 + *p: nobject2minsize && The minimum height (for a vertical splitter) or width (for a horizontal splitter) of Object 2 + *p: _memberdata && XML Metadata for customizable properties + * + + BackColor = 192,192,192 + BackStyle = 0 + BorderColor = 255,0,0 + BorderWidth = 2 + cobject1name = && The name of the object above (for a vertical splitter) or to the left of (for a horizontal splitter) the splitter + cobject2name = && The name of the object below (for a vertical splitter) or to the right of (for a horizontal splitter) the splitter + Height = 248 + lshowgripper = .F. && .T. to display the splitter visually including the gripper control + Name = "sfsplitter" + ndots = 5 && Enter a value between 0 and 5 for the number of dots to be shown on the gripper. Enter 0 for none. + nobject1minsize = 0 && The minimum height (for a vertical splitter) or width (for a horizontal splitter) of Object 1 + nobject2minsize = 0 && The minimum height (for a vertical splitter) or width (for a horizontal splitter) of Object 2 + Width = 10 + _memberdata = + + + + + + + + + + + + + + + + + && XML Metadata for customizable properties + + ADD OBJECT 'Gripper' AS gripper WITH ; + Height = 12, ; + Left = 1, ; + Name = "Gripper", ; + Top = -1, ; + Visible = .F., ; + Width = 20, ; + Gripperdot1.Name = "Gripperdot1", ; + Gripperdot1.ShapeDark.Name = "ShapeDark", ; + Gripperdot1.ShapeLight.Name = "ShapeLight", ; + Gripperdot1.ShapeMiddle.Name = "ShapeMiddle", ; + Gripperdot2.Name = "Gripperdot2", ; + Gripperdot2.ShapeDark.Name = "ShapeDark", ; + Gripperdot2.ShapeLight.Name = "ShapeLight", ; + Gripperdot2.ShapeMiddle.Name = "ShapeMiddle", ; + Gripperdot3.Name = "Gripperdot3", ; + Gripperdot3.ShapeDark.Name = "ShapeDark", ; + Gripperdot3.ShapeLight.Name = "ShapeLight", ; + Gripperdot3.ShapeMiddle.Name = "ShapeMiddle", ; + Gripperdot4.Name = "Gripperdot4", ; + Gripperdot4.ShapeDark.Name = "ShapeDark", ; + Gripperdot4.ShapeLight.Name = "ShapeLight", ; + Gripperdot4.ShapeMiddle.Name = "ShapeMiddle", ; + Gripperdot5.Name = "Gripperdot5", ; + Gripperdot5.ShapeDark.Name = "ShapeDark", ; + Gripperdot5.ShapeLight.Name = "ShapeLight", ; + Gripperdot5.ShapeMiddle.Name = "ShapeMiddle" + *< END OBJECT: ClassLib="thor_sf_splitter.vcx" BaseClass="container" /> + + PROCEDURE adjustminimum && Adjusts the form so it can't be sized too small + * Abstract method. + + ENDPROC + + PROTECTED PROCEDURE getobject1size && Gets the size for Object 1 + * Abstract method. + + lparameters toObject + + ENDPROC + + PROTECTED PROCEDURE getobject2size && Gets the size for Object 2 + * Abstract method. + + lparameters toObject + + ENDPROC + + PROTECTED PROCEDURE getposition && Returns the new position: X for a horizontal splitter and Y for a vertical splitter + * Abstract method. + + lparameters tnXCoord, ; + tnYCoord + + ENDPROC + + PROCEDURE Init + with This + + * Set BorderWidth to 0 so it doesn't appear at run time. + + .BorderWidth = 0 + + * If we're showing a gripper image (thanks to Matt Slay for the gripper + * controls), set BackStyle so we can see the color and set up the gripper. + + if .lShowGripper + .BackStyle = 1 + .SetupGripper() + endif .lShowGripper + + * Call AdjustMinimum to adjust the form so it can't be sized too small. + + .AdjustMinimum() + endwith + dodefault() + + ENDPROC + + PROCEDURE MouseMove + lparameters tnButton, ; + tnShift, ; + tnXCoord, ; + tnYCoord + local lnPosition + with This + if tnButton = 1 and .Enabled + lnPosition = .GetPosition(tnXCoord, tnYCoord) + .MoveSplitterToPosition(lnPosition) + endif tnButton = 1 ... + endwith + + ENDPROC + + PROTECTED PROCEDURE moveobject1 && Moves Object 1 to the new position + * Abstract method. + + lparameters toObject + + ENDPROC + + PROTECTED PROCEDURE moveobject2 && Moves Object 2 to the new position + * Abstract method. + + lparameters toObject + + ENDPROC + + PROCEDURE movesplittertoposition && Moves the splitter to the specified position + lparameters tnPosition + local lnPosition, ; + laObjects1[1], ; + lnObjects1, ; + lnI, ; + loObject, ; + laObjects2[1], ; + lnObjects2, ; + lnAnchor + with This + + * Move the splitter to the specified position. Ensure it doesn't go too far, + * based on the nObject1MinSize and nObject2MinSize settings. + + lnPosition = tnPosition + lnObjects1 = alines(laObjects1, .cObject1Name, 4, ',') + for lnI = 1 to lnObjects1 + loObject = evaluate('.Parent.' + laObjects1[lnI]) + lnPosition = max(lnPosition, .GetObject1Size(loObject)) + next lnI + lnObjects2 = alines(laObjects2, .cObject2Name, 4, ',') + for lnI = 1 to lnObjects2 + loObject = evaluate('.Parent.' + laObjects2[lnI]) + lnPosition = min(lnPosition, .GetObject2Size(loObject)) + next lnI + lnAnchor = .Anchor + .Anchor = 0 + .SetPosition(lnPosition) + .Anchor = lnAnchor + + * Now move the objects as well. + + for lnI = 1 to lnObjects1 + loObject = evaluate('.Parent.' + laObjects1[lnI]) + with loObject + lnAnchor = .Anchor + .Anchor = 0 + This.MoveObject1(loObject) + .Anchor = lnAnchor + endwith + next lnI + for lnI = 1 to lnObjects2 + loObject = evaluate('.Parent.' + laObjects2[lnI]) + with loObject + lnAnchor = .Anchor + .Anchor = 0 + This.MoveObject2(loObject) + .Anchor = lnAnchor + endwith + next lnI + + * Since the object sizes have changed, we need to adjust the form as necessary. + + .AdjustMinimum() + + * Call a hook method. + + .SplitterMoved() + endwith + + ENDPROC + + PROTECTED PROCEDURE setposition && Sets the new position for the splitter + * Abstract method. + + lparameters tnPosition + + ENDPROC + + PROCEDURE setupgripper && A method to setup various properties on the gripper to visually configure it for Vertical or Horizontal configuration. + with This + .Gripper.Visible = .T. + .Gripper.SetupGripper() + endwith + + ENDPROC + + PROCEDURE splittermoved && Called after the splitter is moved + * Abstract method. + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_sfsplitterh AS thor_sfsplitter OF "thor_sf_splitter.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + Anchor = 13 + MousePointer = 9 + Name = "thor_sfsplitterh" + gripper.Gripperdot1.Name = "Gripperdot1" + gripper.Gripperdot1.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot1.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot1.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot2.Name = "Gripperdot2" + gripper.Gripperdot2.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot2.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot2.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot3.Name = "Gripperdot3" + gripper.Gripperdot3.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot3.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot3.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot4.Name = "Gripperdot4" + gripper.Gripperdot4.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot4.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot4.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot5.Name = "Gripperdot5" + gripper.Gripperdot5.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot5.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot5.ShapeMiddle.Name = "ShapeMiddle" + gripper.Name = "gripper" + + PROCEDURE adjustminimum && Adjusts the form so it can't be sized too small + * Don't allow the form to be sized smaller than the left object should be. + + *!* * Removed 6/11/2012 / JRN + *!* local laObjects[1], ; + *!* lnObjects, ; + *!* lnWidth, ; + *!* lnI, ; + *!* loObject + *!* with This + *!* lnObjects = alines(laObjects, .cObject1Name, 4, ',') + *!* lnWidth = -1 + *!* for lnI = 1 to lnObjects + *!* loObject = evaluate('.Parent.' + laObjects[lnI]) + *!* lnWidth = max(lnWidth, loObject.Width) + *!* next lnI + *!* Thisform.MinWidth = max(Thisform.MinWidth, Thisform.Width - lnWidth + ; + *!* .nObject1MinSize) + *!* endwith + + ENDPROC + + PROCEDURE getobject1size && Gets the size for Object 1 + lparameters toObject + return toObject.Left + This.nObject1MinSize + + ENDPROC + + PROCEDURE getobject2size && Gets the size for Object 2 + lparameters toObject + return toObject.Left + toObject.Width - This.nObject2MinSize - This.Width + + ENDPROC + + PROCEDURE getposition && Returns the new position: X for a horizontal splitter and Y for a vertical splitter + lparameters tnXCoord, ; + tnYCoord + return tnXCoord + This.Left - objtoclient(This, 2) + + ENDPROC + + PROCEDURE moveobject1 && Moves Object 1 to the new position + lparameters toObject + with toObject + .Move(.Left, .Top, This.Left - .Left, .Height) + endwith + + ENDPROC + + PROCEDURE moveobject2 && Moves Object 2 to the new position + lparameters toObject + with toObject + .Move(This.Left + This.Width, .Top, max(.Width + .Left - This.Left - ; + This.Width, 0), .Height) + endwith + + ENDPROC + + PROCEDURE setposition && Sets the new position for the splitter + lparameters tnPosition + This.Left = tnPosition + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_sfsplitterv AS thor_sfsplitter OF "thor_sf_splitter.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + Anchor = 14 + Height = 10 + MousePointer = 7 + Name = "sfsplitterv" + Width = 200 + gripper.Gripperdot1.Name = "Gripperdot1" + gripper.Gripperdot1.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot1.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot1.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot2.Name = "Gripperdot2" + gripper.Gripperdot2.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot2.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot2.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot3.Name = "Gripperdot3" + gripper.Gripperdot3.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot3.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot3.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot4.Name = "Gripperdot4" + gripper.Gripperdot4.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot4.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot4.ShapeMiddle.Name = "ShapeMiddle" + gripper.Gripperdot5.Name = "Gripperdot5" + gripper.Gripperdot5.ShapeDark.Name = "ShapeDark" + gripper.Gripperdot5.ShapeLight.Name = "ShapeLight" + gripper.Gripperdot5.ShapeMiddle.Name = "ShapeMiddle" + gripper.Name = "gripper" + + PROCEDURE adjustminimum && Adjusts the form so it can't be sized too small + * Don't allow the form to be sized smaller than the top object should be. + + local laObjects[1], ; + lnObjects, ; + lnHeight, ; + lnI, ; + loObject + with This + lnObjects = alines(laObjects, .cObject1Name, 4, ',') + lnHeight = -1 + for lnI = 1 to lnObjects + loObject = evaluate('.Parent.' + laObjects[lnI]) + lnHeight = max(lnHeight, loObject.Height) + next lnI + Thisform.MinHeight = max(Thisform.MinHeight, Thisform.Height - lnHeight + ; + .nObject1MinSize) + endwith + + ENDPROC + + PROCEDURE getobject1size && Gets the size for Object 1 + lparameters toObject + return toObject.Top + This.nObject1MinSize + + ENDPROC + + PROCEDURE getobject2size && Gets the size for Object 2 + lparameters toObject + return toObject.Top + toObject.Height - This.nObject2MinSize - This.Height + + ENDPROC + + PROCEDURE getposition && Returns the new position: X for a horizontal splitter and Y for a vertical splitter + lparameters tnXCoord, ; + tnYCoord + return tnYCoord + This.Top - objtoclient(This, 1) + + ENDPROC + + PROCEDURE moveobject1 && Moves Object 1 to the new position + lparameters toObject + with toObject + .Move(.Left, .Top, .Width, This.Top - .Top) + endwith + + ENDPROC + + PROCEDURE moveobject2 && Moves Object 2 to the new position + lparameters toObject + with toObject + .Move(.Left, This.Top + This.Height, .Width, max(.Height + .Top - This.Top - ; + This.Height, 0)) + endwith + + ENDPROC + + PROCEDURE setposition && Sets the new position for the splitter + lparameters tnPosition + This.Top = tnPosition + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thor_sfcombotree.vc2 b/Thor/Source/thor_sfcombotree.vc2 new file mode 100644 index 00000000..2ad478ca --- /dev/null +++ b/Thor/Source/thor_sfcombotree.vc2 @@ -0,0 +1,550 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_sfcombotree.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS sfcombotree AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cboCombo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="oTree" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="shpTreeView" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="oImageList" UniqueID="" Timestamp="" /> + + * + *m: closecontrol && Closes the control + *m: enabled_assign + *m: fontname_assign + *m: fontsize_assign + *m: itemselected && Called when an item is selected and the control closed + *m: loadexpandednode && Loads the specified node as it's expanded + *m: loadimages && Loads images used by the ImageList + *m: loadtree && Loads the TreeView + *m: opencontrol && Opens the control + *m: value_access + *m: value_assign + *p: fontname && The font name for the control + *p: fontsize && The font size for the control + *p: lchanged && .T. if the user selected a different value + *p: lcloseonclick && .T. to close the control when an item in the TreeView is clicked + *p: lcloseondblclick && .T. to close the control when an item in the TreeView is double-clicked + *p: lcombotreeopen && .T. if the TreeView is displayed + *p: lloadimagesoninit && .T. to load images from Init + *p: lloadtreeoninit && .T. to load the TreeView from Init + *p: lmovetoback && .T. to set the ZOrder of the control to the back when it's closed + *p: lnoclose && .T. to not have LostFocus close the control + *p: nfired && When cboCombo.DropDown last fired so we can handle multiple firing + *p: ninitialformheight + *p: noriginalheight && The original height of the control + *p: nsavedanchor && The original Anchor value + *p: nspaceabovetreeview + *p: value && The value of the control + *a: aparentheights[1,0] && An array containing heights of parent containers before opening the control + *p: _memberdata && XML Metadata for customizable properties + * + + PROTECTED aparentheights,ninitialformheight,nsavedanchor + Anchor = 10 + BackColor = 255,255,255 + BackStyle = 1 + BorderWidth = 0 + fontname = Tahoma && The font name for the control + fontsize = 9 && The font size for the control + Height = 24 + lchanged = .F. && .T. if the user selected a different value + lcloseonclick = .F. && .T. to close the control when an item in the TreeView is clicked + lcloseondblclick = .F. && .T. to close the control when an item in the TreeView is double-clicked + lcombotreeopen = .F. && .T. if the TreeView is displayed + lloadimagesoninit = .F. && .T. to load images from Init + lloadtreeoninit = .F. && .T. to load the TreeView from Init + lmovetoback = .T. && .T. to set the ZOrder of the control to the back when it's closed + lnoclose = .F. && .T. to not have LostFocus close the control + Name = "sfcombotree" + nfired = 0 && When cboCombo.DropDown last fired so we can handle multiple firing + ninitialformheight = 0 + noriginalheight = 227 && The original height of the control + nsavedanchor = 0 && The original Anchor value + nspaceabovetreeview = 0 + Style = 0 + value = && The value of the control + Width = 170 + _memberdata = + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + && XML Metadata for customizable properties + + ADD OBJECT 'cboCombo' AS combobox WITH ; + FontName = "Tahoma", ; + Height = 24, ; + ItemTips = .T., ; + Name = "cboCombo", ; + RowSourceType = 1, ; + SelectOnEntry = .T., ; + Style = 2, ; + Top = 0, ; + Width = 168 + *< END OBJECT: BaseClass="combobox" /> + + ADD OBJECT 'oImageList' AS olecontrol WITH ; + Height = 100, ; + Left = 120, ; + Name = "oImageList", ; + Top = 40, ; + Width = 100 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\system32\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDmBcu4hcwBAwAAAEABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXAAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAAQAAAAAAAAABAAAAAIAAAD+/////v////7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////8jfyQskYXREbFqAMDwKDYoIUM0EggAAADtAwAA7QMAAIB+4eYAAAYAIAAAAAAAAADAwMAA//9EAAHvzasAAAUAXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTF+AEMAXgAsAEsARgB2ADgAWgAhAFAAQwBlAHEARwA3ADMAOAABAACAKwAxACYAOAA2AFsAYwA5ADcANAB0AEYAbgAxAGsATwB1AEIAUQB+AGUAMAArAGkAeQAnAEcAQQBfAF4AWMEbAAYAAAD/////BQAAgAAAAAAAAAAAAAAAAG8AfQBvAEAAeQA/ACkAKABxAHMAdwBNACkALgB1AF0AdgBSAFsAXgBEAEoAKAA9AC0AKQB+ACgAWwBJAG4AcwBfAHIAUwBWACEASwA5AEcAaQA1ACsAPwBSADcAcQApAHUAOQAnADAAWgBeAAIAUAByAG8AZAB1AGMAdABGAGkAbABlAHMAAAAAAAAAbgAAbgRtAAAg9MIAiO/CAHcAYQByAGUAXABNAGkAYwByAG8AcwBvAGYAdABcAFcAaQBuAGQAbwB3AHMAXABDAHUAcgByAGUAbgB0AFYAZQByAHMAaQBvAA==" /> + + ADD OBJECT 'oTree' AS basetree WITH ; + Height = 174, ; + Left = 5, ; + Name = "oTree", ; + Top = 29, ; + Width = 166 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="olecontrol" OLEObject="c:\windows\system32\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7///8EAAAA/v///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDmBcu4hcwBAwAAAIACAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiwAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAACcBAAAAAAAACAAAAAIAAAD+////BAAAAAUAAAAGAAAABwAAAP7///8JAAAA/v////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////+2kEHHiYXREbFqAMDwKDYoIUM0EggAAAAoEQAA/BEAALE8wWoBAAYAIgAAAD0AAAAJAQAADAAAAAmjHwYB782rXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAKNsAAAAAAADg2wAAAAAAAIjcAAAAAAAAkNIAAAAAAAABAACADgAAAEhpZGVTZWxlY3Rpb24ABQAAAEwAAAAADAAAAEluZGVudGF0aW9uABEAAABODQAAAAcAAAAAAAAAAAAkQAoAAABMYWJlbEVkaXQACQAAAEkKAAAAAQAAAAoAAABMaW5lU3R5bGUACQAAAEkKAAAAAQAAAA0AAABNb3VzZVBvaW50ZXIACQAAAEkKAAAAAAAAAA4AAABQYXRoU2VwYXJhdG9yAAoAAABIAAAAAAEAAABcDAAAAE9MRURyYWdNb2RlAAkAAABJCgAAAAAAAAAMAAAAT0xFRHJvcE1vZGUACQAAAEkKAAAAAAAAAAsAAABBcHBlYXJhbmNlAAkAAABJCgAAAAAAAAAMAAAASG90VHJhY2tpbmcABQAAAEwBAAAAAF4PAQAAAAAAnA4BAAAAAADkEAEAAAAAAAAABQAAAAAAAgBjAAAAAAAFAACAnOkSAAEAAABcAB/e7L0BAAUA4ekSAANS4wuRj84RneMAqgBLuFEBAAAAkAGQXwEABlRhaG9tYQBfAEEAYwBjAGUAcwBzACIALwA+ADwAbQBlAG0AYgBlAHIAZABhAHQAYQAgAG4AYQBtAGUAPQAiAHYAYQBsAHUAZQBfAGEAcwBzAGkAZwBuACIAIAB0AHkAcABlAD0AIgBwAHIAbwBwAGUAcgB0AHkAIgAgAGQAaQBzAHAAbABhAHkAPQAiAFYAYQBsAHUAZQBfAEEAcwBzAGkAZwBuACIALwA+ADwAbQBlAG0AYgBlAHIAZABhAHQAYQAgAG4AYQBtAGUAPQAiAGYAbwBuAHQAbgBhAG0AZQAiACAAdAB5AHAAZQA9ACIAcAByAG8AcABlAHIAdAB5ACIAIABkAGkAcwBwAGwAYQB5AD0AIgBGAG8AbgB0AE4AYQBtAGUAIgAvAD4APABtAGUAbQBiAGUAcgBkAGEAdABhACAAbgBhAG0AZQA9ACIAZgBvAG4AdABuAGEAbQBlAF8AYQBzAHMAaQBnAG4AIgAgAHQAeQBwAGUAPQAiAHAAcgBvAHAAZQByAHQAeQAiACAAZABpAHMAcABsAGEAeQA9ACIARgBvAG4AdABOAGEAbQBlAF8AQQBzAHMA" /> + + ADD OBJECT 'shpTreeView' AS shape WITH ; + BackColor = 255,255,255, ; + BackStyle = 1, ; + Height = 176, ; + Left = 0, ; + Name = "shpTreeView", ; + SpecialEffect = 1, ; + Top = 25, ; + Width = 168 + *< END OBJECT: BaseClass="shape" /> + + PROCEDURE closecontrol && Closes the control + lparameters tlKeepFocus, ; + tlSelected + local loParent, ; + lnParent, ; + lnParents, ; + lnAnchor + with This + + * Turn off anchoring since we're changing our Height. + + store 0 to .Anchor, .cboCombo.Anchor, .oTree.Anchor, .shpTreeView.Anchor + + * Adjust the properties of the control. + + .Height = .cboCombo.Height + .oTree.Visible = .F. + .shpTreeView.Visible = .F. + .lComboTreeOpen = .F. + + * Restore the height and anchor of any parent containers we adjusted in + * OpenControl or resized while we were open and the form was resized. Note that + * if the parent doesn't support vertical resizing, we'll restore Height to its + * original value. Otherwise, we'll account for any difference in the form + * height made while we were open. + + loParent = .Parent + lnParent = 1 + lnParents = alen(.aParentHeights, 1) + do while vartype(loParent) = 'O' and ; + lower(loParent.BaseClass) = 'container' and lnParents > lnParent + lnParent = lnParent + 1 + if vartype(.aParentHeights[lnParent, 1]) = 'N' + loParent.Anchor = 0 + lnAnchor = .aParentHeights[lnParent, 3] + if not bittest(lnAnchor, 0) and not bittest(lnAnchor, 2) + loParent.Height = .aParentHeights[lnParent, 1] + else + loParent.Height = .aParentHeights[lnParent, 1] + ; + loParent.Height - .aParentHeights[lnParent, 2] + endif not bittest(lnAnchor, 0) ... + loParent.Anchor = lnAnchor + endif vartype(.aParentHeights[lnParent, 1]) = 'N' + loParent = loParent.Parent + enddo while vartype(loParent) = 'O' ... + + * Restore anchoring and ensure we're at the back of ZOrder. + .cboCombo.Left = .cboCombo.Left + .cboCombo.Width = .cboCombo.Width + + store .nSavedAnchor to .Anchor, .cboCombo.Anchor + if .lMoveToBack + .shpTreeView.ZOrder(1) + .oTree.ZOrder(1) + .ZOrder(1) + endif .lMoveToBack + + * Set focus to the combobox if we're supposed to. + + if tlKeepFocus + .cboCombo.SetFocus() + endif tlKeepFocus + + * Ensure the combobox matches the selected item. + + if tlSelected and vartype(.oTree.SelectedItem) = 'O' + if not .oTree.SelectedItem.Text == .cboCombo.Value + .lChanged = .T. + endif not .oTree.SelectedItem.Text == .cboCombo.Value + .Value = .oTree.SelectedItem.Text + + * Call ItemSelected to do any custom behavior. + + .ItemSelected() + endif tlSelected ... + endwith + + ENDPROC + + PROCEDURE enabled_assign + lparameters tlEnabled + This.Enabled = tlEnabled + This.SetAll('Enabled', tlEnabled) + + ENDPROC + + PROCEDURE fontname_assign + lparameters tuNewValue + with This + store tuNewValue to .FontName, .cboCombo.FontName, .oTree.Font.Name + endwith + + ENDPROC + + PROCEDURE fontsize_assign + lparameters tuNewValue + with This + store tuNewValue to .FontSize, .cboCombo.FontSize, .oTree.Font.Size + endwith + + ENDPROC + + PROCEDURE Init + with This + + * Set up the combobox. + + .cboCombo.Anchor = 0 + .cboCombo.Width = .Width - .cboCombo.Left + .cboCombo.Anchor = .Anchor + .cboCombo.ToolTipText = .ToolTipText + + * Save the current height of the control and the form and our Anchor value. + + dimension .aParentHeights[1, 2] + .aParentHeights[1, 1] = .Height + .aParentHeights[1, 2] = .Height + .nInitialFormHeight = Thisform.Height + .nSavedAnchor = .Anchor + + * Set our font name and size to their own values so Assign takes care of + * setting the other controls. + + .FontName = .FontName + .FontSize = .FontSize + + * Call CloseControl so everything is sized properly for a closed appearance. + + .CloseControl() + + * If we're supposed to, load the images now. + + if .lLoadImagesOnInit + .LoadImages() + endif .lLoadImagesOnInit + + * If we have any images, use the ImageList control with the TreeView. + + if .oImageList.ListImages.Count > 0 + .oTree.Object.ImageList = .oImageList + endif .oImageList.ListImages.Count > 0 + + * If we're supposed to, load the TreeView now. + + if .lLoadTreeOnInit + .LoadTree() + endif .lLoadTreeOnInit + endwith + + ENDPROC + + PROCEDURE itemselected && Called when an item is selected and the control closed + * Abstract method. + + ENDPROC + + PROCEDURE loadexpandednode && Loads the specified node as it's expanded + * Abstract method + + lparameters toNode + + ENDPROC + + PROCEDURE loadimages && Loads images used by the ImageList + ENDPROC + + PROCEDURE loadtree && Loads the TreeView + * Abstract method + + ENDPROC + + PROCEDURE LostFocus + * Close the control when we lose focus, although we'll do nothing if we were + * called from CloseControl (since that may be a recursive call) or if lNoClose + * is .T., since that means we temporarily lost focus because of kludge code in + * cboCombo.DropDown. + + local laStack[1], ; + lnI, ; + llClose + if not This.lNoClose + lnStack = astackinfo(laStack) + for lnI = lnStack to 1 step -1 + if 'closecontrol' $ laStack[lnI, 3] + llClose = .T. + exit + endif 'closecontrol' $ laStack[lnI, 3] + next lnI + if This.lComboTreeOpen and not llClose + This.CloseControl(.F., .T.) + endif This.lComboTreeOpen ... + endif not This.lNoClose + + ENDPROC + + PROCEDURE opencontrol && Opens the control + local lnAnchor, ; + loParent, ; + lnParent, ; + lnI, ; + loNode + with This + + * If we haven't already done so, load the TreeView the first time we're opened. + + if .oTree.Nodes.Count = 0 + .LoadTree() + endif .oTree.Nodes.Count = 0 + + * If we loaded images later than from Init, use the ImageList control with the + * TreeView. + + if not .lLoadImagesOnInit and .oImageList.ListImages.Count > 0 + .oTree.Object.ImageList = .oImageList + endif not .lLoadImagesOnInit ... + + * Turn off anchoring since we'll be resizing and moving controls. + + lnAnchor = .Anchor + store 0 to .Anchor, .cboCombo.Anchor, .oTree.Anchor, .shpTreeView.Anchor + + * Save our height, then set it to the desired height, accounting for any resize + * of the form. + + .aParentHeights[1, 1] = .Height + .Height = min(.nOriginalHeight + Thisform.Height - ; + .nInitialFormHeight, Thisform.Height - This.Top - 5) + .aParentHeights[1, 2] = .Height + + * Save the height of all parent containers and adjust them if necessary. Also, + * save the current anchor values and add 5 if necessary so they resize + * vertically. + + loParent = This.Parent + lnParent = 1 + do while vartype(loParent) = 'O' and ; + lower(loParent.BaseClass) = 'container' + lnParent = lnParent + 1 + dimension .aParentHeights[lnParent, 3] + if loParent.Height < .Top + .Height + .aParentHeights[lnParent, 3] = loParent.Anchor + loParent.Anchor = 0 + .aParentHeights[lnParent, 1] = loParent.Height + loParent.Height = .Top + .Height + .aParentHeights[lnParent, 2] = loParent.Height + loParent.Anchor = .aParentHeights[lnParent, 3] + if not bittest(loParent.Anchor, 0) and ; + not bittest(loParent.Anchor, 2) + loParent.Anchor = loParent.Anchor + 5 + endif not bittest(loParent.Anchor, 0) ... + endif loParent.Height < .Top + .Height + loParent = loParent.Parent + enddo while vartype(loParent) = 'O' ... + + * Adjust the size of the TreeView and shape in case the container was resized + * while we were closed. + + *!* .oTree.Width = .Width - 2 + *!* .oTree.Height = .Height - .cboCombo.Height - 4 + *!* .oTree.Left = .shpTreeView.Left + 1 + *!* .oTree.Top = .shpTreeView.Top + 1 + *!* .shpTreeView.Width = .Width + *!* .shpTreeView.Height = .Height - .cboCombo.Height - 2 + + .shpTreeView.Width = .Width + .shpTreeView.Top = .cboCombo.Height + 1 + .nSpaceAboveTreeView + .shpTreeView.Height = .Height - .shpTreeView.Top - 1 + .oTree.Width = .shpTreeView.Width - 2 + .oTree.Height = .shpTreeView.Height - 2 + .oTree.Left = .shpTreeView.Left + 1 + .oTree.Top = .shpTreeView.Top + 1 && + .nSpaceAboveTreeView + + * If the current value doesn't match the selected item in the TreeView, find + * and select the appropriate item. + + if vartype(.oTree.SelectedItem) <> 'O' or ; + (not empty(.cboCombo.DisplayValue) and ; + not .cboCombo.DisplayValue == .oTree.SelectedItem.Text) + for lnI = 1 to .oTree.Nodes.Count + loNode = .oTree.Nodes.Item(lnI) + if .cboCombo.DisplayValue == loNode.Text + loNode.Selected = .T. + exit + endif .cboCombo.DisplayValue == loNode.Text + next lnI + endif vartype(.oTree.SelectedItem) <> 'O' ... + + * Enable the controls appropriately, then set focus to the TreeView. + + .oTree.Visible = .T. + .shpTreeView.Visible = .T. + .ZOrder(0) + .shpTreeView.ZOrder(0) + .oTree.ZOrder(0) + .lComboTreeOpen = .T. + .oTree.SetFocus() + + * Restore anchoring and add 5 to it so we resize vertically. + + .cboCombo.Anchor = lnAnchor + store lnAnchor + 5 to .Anchor, .oTree.Anchor, .shpTreeView.Anchor + endwith + + ENDPROC + + PROCEDURE value_access + return This.cboCombo.DisplayValue + + ENDPROC + + PROCEDURE value_assign + lparameters tuNewValue + store tuNewValue to This.cboCombo.Value, This.cboCombo.DisplayValue + + ENDPROC + + PROCEDURE cboCombo.DropDown + local lnCol, ; + lnRow + + * Prevent the usual behavior. + + nodefault + with This.Parent + do case + + * If the control isn't open, open it. + + case not .lComboTreeOpen + .OpenControl() + + * If the control is open and we weren't just fired, close the control. + * Otherwise, click to the right of the control then move the mouse back. This + * avoids a weird behavior: if you open and close the control, then open it + * again using the mouse, DropDown fires continously as long as the mouse is + * over the control. So, we move the move off the control, click, and move it + * back to the original spot to stop this. + + case seconds() > .nFired + 0.25 + .CloseControl(.T., .T.) + otherwise + .lNoClose = .T. + lnCol = mcol(Thisform.Name, 3) + lnRow = mrow(Thisform.Name, 3) + mouse click at lnRow, objtoclient(This.Parent, 2) + .Width + 5 pixels ; + window (Thisform.Name) + doevents force + mouse at lnRow, lnCol pixels window (Thisform.Name) + doevents force + .lNoClose = .F. + .oTree.SetFocus() + endcase + .nFired = seconds() + endwith + + ENDPROC + + PROCEDURE cboCombo.KeyPress + * Prevent Ctrl-0 from inserting a null value. + + lparameters tnKeyCode, ; + tnShiftAltCtrl + if tnKeyCode = asc('0') and bittest(tnShiftAltCtrl, 1) + nodefault + endif tnKeyCode = asc('0') ... + + ENDPROC + + PROCEDURE oTree.DblClick + * Close the control if we're supposed to. + + if This.Parent.lCloseOnDblClick + This.Parent.CloseControl(.F., .T.) + endif This.Parent.lCloseOnDblClick + + ENDPROC + + PROCEDURE oTree.Expand + lparameters toNode + if toNode.Children > 0 and toNode.Child.Text = 'Loading...' + This.Parent.LoadExpandedNode(toNode) + endif toNode.Children > 0 ... + + ENDPROC + + PROCEDURE oTree.KeyDown + lparameters tnKeyCode, ; + tnShift + do case + case tnKeyCode = 27 + This.Parent.CloseControl(.F., .T.) + endcase + + ENDPROC + + PROCEDURE oTree.NodeClick + * Close the control if we're supposed to. + + lparameters toNode + if This.Parent.lCloseOnClick + This.Parent.CloseControl(.F., .T.) + endif This.Parent.lCloseOnClick + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thor_starting_prgs.db2 b/Thor/Source/thor_starting_prgs.db2 new file mode 100644 index 00000000..fcb2a04e --- /dev/null +++ b/Thor/Source/thor_starting_prgs.db2 @@ -0,0 +1,168 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_starting_prgs.dbf" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000030 + Visual FoxPro + + + + PRGNAME + C + 40 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SAMPLE + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CODE + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + + + + + THOR_TOOL_TOGGLECOMMENTCOLORS.PRG + .T. + + + + + + +
+ diff --git a/Thor/Source/thor_ui.vc2 b/Thor/Source/thor_ui.vc2 new file mode 100644 index 00000000..106d0f10 --- /dev/null +++ b/Thor/Source/thor_ui.vc2 @@ -0,0 +1,8159 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_ui.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS edittoolbutton AS basecommandbutton OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor_ui.h" + * + *p: cprgname && The PRGname of the tool + * + + Caption = "\ + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="lblFilter" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtFilter" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *p: ctarget && The object containing cToolFilter + * + + ctarget = && The object containing cToolFilter + Height = 23 + Name = "filtercontrols" + Width = 228 + _memberdata = + + + + ADD OBJECT 'lblFilter' AS baselabel WITH ; + Caption = "Tool filter", ; + Left = 0, ; + Name = "lblFilter", ; + Top = 4 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'txtFilter' AS basetextbox WITH ; + Height = 24, ; + Left = 60, ; + Name = "txtFilter", ; + Top = 0, ; + Width = 167 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="textbox" /> + + PROCEDURE lblFilter.Init + This.Caption = ccFILTER + dodefault() + + ENDPROC + + PROCEDURE txtFilter.LostFocus + local loObject + loObject = evaluate(This.Parent.cTarget) + with loObject + .cToolFilter = trim(This.Value) + Thisform.lRefreshTools = .T. + .Refresh() + Thisform.lRefreshTools = .F. + endwith + + ENDPROC + +ENDDEFINE + +DEFINE CLASS formruntool AS baseform OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="lblVersion" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame.Frame" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Basecheckbox2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame.Frame.Basepage2.edtNoneFound" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame.Frame.Basepage2.oTree" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame.Frame.Basepage3.Selecttoolforlauncher1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame.Frame.Basepage3.Selecttoolforlauncher1.Basecheckbox2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame.cmdRight" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1.cntFrame.cmdLeft" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="oImageList" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Basecheckbox1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdRefresh" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: addpemeditortools + *m: assignallhotkeys + *m: createtoolbar + *m: edittool && Edits the specified tool + *m: gethotkeydescription + *m: help + *m: loadtree && Loads the TreeView + *m: notthorinternalmenu + *m: refreshtools && Refreshes the tools + *m: runthor && Runs Thor to update the hotkeys and menus + *m: runtool + *m: setfontsize + *m: setpage + *p: cthorfolder + *p: lfavoritesonly + *p: lopeningform + *p: lrefreshcustomtooltreeview + *p: lrefreshselecttooltreeview + *p: lrefreshtools && Flags that we're refreshing tools + *p: lreopen + *p: lsearchtoolnamesonly + *p: nfontsize + *p: noptionssplitterleft + *p: nsplitterposition + *p: oselecttool + *p: othor && A reference to a Thor_Engine object + *p: otools && A reference to a collection of tools + * + + AutoCenter = .F. + BindControls = .F. + Caption = "Run Tool" + cfoxuserid = ThorRunTool + cfoxusername = ThorRunTool + cthorfolder = + DataSession = 2 + DoCreate = .T. + Height = 300 + Icon = thor16.ico + ldockable = .T. + Left = 0 + lfavoritesonly = .F. + lopeningform = .T. + lrefreshcustomtooltreeview = .F. + lrefreshselecttooltreeview = .F. + lrefreshtools = .F. && Flags that we're refreshing tools + lreopen = .F. + lsearchtoolnamesonly = .F. + MinHeight = 100 + MinWidth = 100 + Name = "formruntool" + nfontsize = 9 + noptionssplitterleft = 0 + nsplitterposition = -1 + oselecttool = .NULL. + othor = .NULL. && A reference to a Thor_Engine object + otools = .NULL. && A reference to a collection of tools + Top = 1 + Visible = .T. + Width = 644 + _memberdata = + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + cmdEscape.Name = "cmdEscape" + + ADD OBJECT 'Basecheckbox1' AS basecheckbox WITH ; + Alignment = 0, ; + Anchor = 4, ; + Caption = "Re-open form after executing tool", ; + ControlSource = "Thisform.lReOpen", ; + Left = 42, ; + Name = "Basecheckbox1", ; + TabIndex = 4, ; + Top = 278 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'cmdRefresh' AS basecommandbutton WITH ; + Anchor = 4, ; + Caption = "", ; + Left = 12, ; + Name = "cmdRefresh", ; + Picture = refresh2.bmp, ; + TabIndex = 2, ; + Top = 275, ; + Width = 23 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'lblVersion' AS baselabel WITH ; + Alignment = 1, ; + Anchor = 12, ; + Caption = "Version", ; + Left = 587, ; + Name = "lblVersion", ; + TabIndex = 3, ; + Top = 278 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'oImageList' AS olecontrol WITH ; + Height = 26, ; + Left = 488, ; + Name = "oImageList", ; + Top = 92, ; + Width = 36 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\syswow64\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAPBOJHCNWs8BAwAAAEABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXAAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAAQAAAAAAAAABAAAAAIAAAD+/////v////7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////8jfyQskYXREbFqAMDwKDYoIUM0EggAAADtAwAA7QMAAIB+4eYAAAYAIAAAAAAAAADAwMAA//9MAAHvzasAAAUAXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAYAUAD/////BQAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==" /> + + ADD OBJECT 'Toolkeys1' AS toolkeysbase WITH ; + BackColor = 255,255,255, ; + BackStyle = 1, ; + Height = 261, ; + Left = 6, ; + Name = "Toolkeys1", ; + TabIndex = 1, ; + Top = 6, ; + cmdCreateTool.Left = 331, ; + cmdCreateTool.Name = "cmdCreateTool", ; + cmdCreateTool.Top = 273, ; + cmdCreateTool.Visible = .F., ; + cmdCreateTool.ZOrderSet = 1, ; + cmdOpenToolFolder.Left = 464, ; + cmdOpenToolFolder.Name = "cmdOpenToolFolder", ; + cmdOpenToolFolder.Top = 273, ; + cmdOpenToolFolder.Visible = .F., ; + cmdOpenToolFolder.ZOrderSet = 2, ; + cntToolInfo.chkFavorite.Alignment = 0, ; + cntToolInfo.chkFavorite.Name = "chkFavorite", ; + cntToolInfo.chkStartup.Alignment = 0, ; + cntToolInfo.chkStartup.Name = "chkStartup", ; + cntToolInfo.chkToolBar.Alignment = 0, ; + cntToolInfo.chkToolBar.Name = "chkToolBar", ; + cntToolInfo.cmdEditTool.Name = "cmdEditTool", ; + cntToolInfo.cmdRemoveTool.Name = "cmdRemoveTool", ; + cntToolInfo.cmdToolBarIcon.Name = "cmdToolBarIcon", ; + cntToolInfo.Edittoolbutton1.Name = "Edittoolbutton1", ; + cntToolInfo.Height = 260, ; + cntToolInfo.Name = "cntToolInfo", ; + cntToolInfo.oHotKeyControls.CMDCLEAR.Name = "CMDCLEAR", ; + cntToolInfo.oHotKeyControls.cmdGetHotKey.Name = "cmdGetHotKey", ; + cntToolInfo.oHotKeyControls.LBLHOTKEY.Name = "LBLHOTKEY", ; + cntToolInfo.oHotKeyControls.Name = "oHotKeyControls", ; + cntToolInfo.oHotKeyControls.txtHotKey.Name = "txtHotKey", ; + cntToolInfo.oToolInfo.edtToolInfo.Height = 159, ; + cntToolInfo.oToolInfo.edtToolInfo.Name = "edtToolInfo", ; + cntToolInfo.oToolInfo.edtToolInfo.Width = 339, ; + cntToolInfo.oToolInfo.Height = 177, ; + cntToolInfo.oToolInfo.lblLink.Name = "lblLink", ; + cntToolInfo.oToolInfo.lblOptions.Name = "lblOptions", ; + cntToolInfo.oToolInfo.lblPlugIns.Name = "lblPlugIns", ; + cntToolInfo.oToolInfo.lblVideo.Name = "lblVideo", ; + cntToolInfo.oToolInfo.Name = "oToolInfo", ; + cntToolInfo.oToolInfo.Width = 340, ; + cntToolInfo.Top = 0, ; + cntToolInfo.ZOrderSet = 0, ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.Name = "GRIPPERDOT1", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.Name = "GRIPPERDOT2", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.Name = "GRIPPERDOT3", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.Name = "GRIPPERDOT4", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.Name = "GRIPPERDOT5", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.Name = "GRIPPER", ; + THOR_SFSPLITTERH1.Name = "THOR_SFSPLITTERH1", ; + THOR_SFSPLITTERH1.nobject1minsize = 100, ; + THOR_SFSPLITTERH1.nobject2minsize = 100, ; + THOR_SFSPLITTERH1.ZOrderSet = 3 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'Toolkeys1.cntFrame' AS basecontainer WITH ; + Anchor = 15, ; + Height = 261, ; + Left = 0, ; + Name = "cntFrame", ; + Top = 0, ; + Width = 268 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="container" /> + + ADD OBJECT 'Toolkeys1.cntFrame.cmdLeft' AS basecommandbutton WITH ; + Anchor = 8, ; + Caption = "", ; + Height = 21, ; + Left = 237, ; + Name = "cmdLeft", ; + Picture = thor_left_arrow.bmp, ; + SpecialEffect = 2, ; + TabIndex = 3, ; + Top = 2, ; + Width = 23 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Toolkeys1.cntFrame.cmdRight' AS basecommandbutton WITH ; + Anchor = 8, ; + Caption = "", ; + Height = 21, ; + Left = 237, ; + Name = "cmdRight", ; + Picture = thor_right_arrow.bmp, ; + SpecialEffect = 2, ; + TabIndex = 2, ; + Top = 2, ; + Width = 23 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Toolkeys1.cntFrame.Frame' AS basepageframe WITH ; + Anchor = 15, ; + ErasePage = .T., ; + Height = 261, ; + Left = 0, ; + Name = "Frame", ; + PageCount = 3, ; + TabIndex = 1, ; + Top = 0, ; + Visible = .T., ; + Width = 268, ; + basepage1.Caption = "System List", ; + basepage1.Name = "basepage1", ; + basepage1.PageOrder = 1, ; + Basepage2.Caption = "Custom List", ; + Basepage2.Name = "Basepage2", ; + Basepage2.PageOrder = 3, ; + Basepage3.Caption = "Favorites", ; + Basepage3.Name = "Basepage3", ; + Basepage3.PageOrder = 2 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="pageframe" /> + + ADD OBJECT 'Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1' AS selecttoolforlauncher WITH ; + Height = 230, ; + Left = 0, ; + Name = "Selecttoolforlauncher1", ; + Top = 0, ; + Visible = .T., ; + Width = 265, ; + Baselabel1.Left = 7, ; + Baselabel1.Name = "Baselabel1", ; + Baselabel1.TabIndex = 3, ; + Baselabel1.Top = 5, ; + oTree.Height = 182, ; + oTree.Left = 1, ; + oTree.Name = "oTree", ; + oTree.TabIndex = 2, ; + oTree.Top = 48, ; + oTree.Width = 261, ; + txtcNewFilter.Name = "txtcNewFilter", ; + txtcNewFilter.TabIndex = 1, ; + txtcNewFilter.Width = 193 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Basecheckbox2' AS basecheckbox WITH ; + Alignment = 0, ; + Anchor = 0, ; + Caption = "Search tool names only", ; + ControlSource = "Thisform.lSearchToolNamesOnly", ; + Left = 47, ; + Name = "Basecheckbox2", ; + TabIndex = 4, ; + Top = 28 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Toolkeys1.cntFrame.Frame.Basepage2.edtNoneFound' AS baseeditbox WITH ; + Anchor = 15, ; + Height = 232, ; + Left = 0, ; + Name = "edtNoneFound", ; + ReadOnly = .T., ; + Top = 0, ; + Visible = .F., ; + Width = 264 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="editbox" /> + + ADD OBJECT 'Toolkeys1.cntFrame.Frame.Basepage2.oTree' AS basetree WITH ; + Anchor = 15, ; + Height = 229, ; + Left = 0, ; + Name = "oTree", ; + Top = 0, ; + Visible = .T., ; + Width = 264, ; + ZOrderSet = 1 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="olecontrol" OLEObject="c:\windows\syswow64\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOC2IXCNWs8BAwAAAIABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAagAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAEQAAAAAAAAABAAAAAIAAAD+////BQAAAP7////+//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////+2kEHHiYXREbFqAMDwKDYoIUM0EggAAABJGwAAqxcAALE8wWoBAAYAIgAAAJ0AAAAJAQAACAAAAAEAAAAB782rXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAAAAAAAEAAAABAAAAAQAAAAEAAAAAAAAAAAAAAAAAAAABAACADAAAAEluZGVudGF0aW9uABEAAABODQAAAAcAAAAAAAAAAAAkQAoAAABMaW5lU3R5bGUACQAAAEkKAAAAAAAFADDjGAAGAAAAAAAAAAUAAIAw4xgAAQAAAFwAH97svQEABQB44xgAAAAGAAAAAAAAAAAAAADbIQrrAAAAAAEAAAABAAAAAQAAAAEAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABQABANSV0AAAAAAAKwAwAXUACADQAhUA0AIVAAAAkgW+MIF8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE8ARQBcAFQATQBBAFMAXwBPAEUASABvAA==" /> + + ADD OBJECT 'Toolkeys1.cntFrame.Frame.Basepage3.Selecttoolforlauncher1' AS selecttoolforlauncher WITH ; + Height = 230, ; + Left = 0, ; + Name = "Selecttoolforlauncher1", ; + Top = 0, ; + Visible = .T., ; + Width = 265, ; + Baselabel1.Left = 7, ; + Baselabel1.Name = "Baselabel1", ; + Baselabel1.TabIndex = 3, ; + Baselabel1.Top = 5, ; + oTree.Height = 182, ; + oTree.Left = 1, ; + oTree.Name = "oTree", ; + oTree.TabIndex = 2, ; + oTree.Top = 48, ; + oTree.Width = 261, ; + txtcNewFilter.Name = "txtcNewFilter", ; + txtcNewFilter.TabIndex = 1, ; + txtcNewFilter.Width = 193 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'Toolkeys1.cntFrame.Frame.Basepage3.Selecttoolforlauncher1.Basecheckbox2' AS basecheckbox WITH ; + Alignment = 0, ; + Anchor = 0, ; + Caption = "Search tool names only", ; + ControlSource = "Thisform.lSearchToolNamesOnly", ; + Left = 47, ; + Name = "Basecheckbox2", ; + TabIndex = 4, ; + Top = 28 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + PROCEDURE addpemeditortools + Lparameters toTree, lcParentKey, lnMenuID, raTools, lcFilter + + Local laMenuTools[1], lcHotKey, lcKey, lcKeystroke, lcMenuStatusBar, lcPRGName, lcPrompt + Local lcStatusBar, llSeparator, lnHotKeyID, lnI, lnID, lnIndex, lnSubMenuID, loNode + + Select MenuTools.Prompt ; + , Separator ; + , SubMenuID ; + , PRGName ; + , MenuTools.Id ; + , MenuDefinitions.HotKeyID ; + From MenuTools ; + Left Join MenuDefinitions ; + On SubMenuID = MenuDefinitions.Id ; + Where MenuID = lnMenuID ; + Order By MenuTools.sortorder ; + Into Array laMenuTools + + For lnI = 1 To _Tally + lcPrompt = Alltrim (laMenuTools (lnI, 1)) + llSeparator = laMenuTools (lnI, 2) + lnSubMenuID = laMenuTools (lnI, 3) + lcPRGName = Alltrim (laMenuTools (lnI, 4)) + lnID = laMenuTools (lnI, 5) + lnHotKeyID = laMenuTools (lnI, 6) + + Do Case + Case llSeparator + * loNode = toTree.Nodes.Add (lcParentKey, 4, lcParentKey + '\' + Str (lnID), Replicate('-', 30)) + Case lnSubMenuID # 0 + lcKey = lcParentKey + '\' + Chrtran (lcPrompt, '/\', '__') + lcHotKey = Thisform.GetHotKeyDescription (lnHotKeyID) + loNode = toTree.Nodes.Add (lcParentKey, 4, lcKey, ; + lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_MENU) + This.AddPEMEditorTools (toTree, lcKey, lnSubMenuID, @raTools, lcFilter) + loNode.Expanded = Not Empty (lcFilter) + Otherwise + If Empty (lcFilter) Or 0 # Ascan (raTools, lcPRGName, 6, -1, -1, 15) + lcKey = lcParentKey + '\' + Str (lnID) + = Seek (Upper (lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + lcHotKey = Thisform.GetHotKeyDescription (ToolHotKeyAssignments.HotKeyID) + loNode = toTree.Nodes.Add (lcParentKey, 4, lcKey, ; + lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_TOOL) + lnIndex = Thisform.oTools.GetKey (Upper (lcPRGName)) + If lnIndex > 0 + loNode.Tag = Thisform.oTools (lnIndex) + Endif + Endif + Endcase + Endfor + + If toTree.Nodes (lcParentKey).Children = 0 + toTree.Nodes.Remove (lcParentKey) + Endif + + ENDPROC + + PROCEDURE assignallhotkeys + *============================================================================== + * Method: RunThor + * Purpose: Runs Thor to update the hotkeys and menus + * Author: Doug Hennig + * Last revision: 04/09/2011 + * Parameters: none + * Returns: none + * Environment in: This.cThorFolder contains the Thor folder + * Environment out: Thor_Run has been instantiated and its Run method called + *============================================================================== + + local lcApp, ; + lcFolder, ; + loRunThor + lcApp = This.cThorFolder + 'Thor.App' + lcFolder = This.cThorFolder + 'Thor\' + loRunThor = newobject ('Thor_Run', 'thor_run.vcx', '', lcApp, lcFolder) + loRunThor.AddProperty('cApplication', lcApp) + loRunThor.AssignAllHotKeys() + + ENDPROC + + PROCEDURE createtoolbar + *============================================================================== + * Method: RunThor + * Purpose: Runs Thor to update the hotkeys and menus + * Author: Doug Hennig + * Last revision: 04/09/2011 + * Parameters: none + * Returns: none + * Environment in: This.cThorFolder contains the Thor folder + * Environment out: Thor_Run has been instantiated and its Run method called + *============================================================================== + + local lcApp, ; + lcFolder, ; + loRunThor + lcApp = This.cThorFolder + 'Thor.App' + lcFolder = This.cThorFolder + 'Thor\' + loRunThor = newobject ('Thor_Run', 'thor_run.vcx', '', lcApp, lcFolder) + loRunThor.AddProperty('cApplication', lcApp) + loRunThor.CreateToolBar() + + ENDPROC + + PROCEDURE Destroy + * Run Thor to update all hotkeys and menus. + + _Screen.oThorRunTool = .Null. + This.oSelectTool = .Null. + + * Close all tables. + + Close Tables All + DoDefault() + + ENDPROC + + PROCEDURE edittool && Edits the specified tool + *============================================================================== + * Method: EditTool + * Purpose: Edits the specified tool + * Author: Doug Hennig + * Last revision: 04/23/2011 + * Parameters: tcPRGName - the name of the PRG to edit + * Returns: none + * Environment in: This.oThor contains a reference to a ThorEngine object + * Environment out: if the PRG is found, it's opened in an editor window + *============================================================================== + + Lparameters tcPRGName + Local lcFile, loPEME_Tools + lcFile = This.oThor.FindFile (tcPRGName) + If Empty (lcFile) + Messagebox (Strtran (ccCANT_FIND, '%1', tcPRGName), MB_OK + MB_ICONSTOP, ; + ccTHOR_CAPTION) + Else + Execscript (_Screen.cThorDispatcher, 'Thor_Proc_EditProc', lcFile) + Endif Empty (lcFile) + + ENDPROC + + PROCEDURE gethotkeydescription + Lparameters tnHotKeyID + + If Seek (tnHotKeyID, 'HotKeyDefinitions', 'ID') + Return Trim (HotKeyDefinitions.Descript) + Else + Return '' + Endif + + ENDPROC + + PROCEDURE help + Local loLink + loLink = Newobject('_ShellExecute', Home() + 'FFC\_Environ.vcx') + loLink.ShellExecute(ThorHelpURL) + + ENDPROC + + PROCEDURE Init + Lparameters tcThorFolder + With This + + With This.oImageList + .ListImages.Add(1, ccIMAGE_MENU, LoadPicture ('Menus.ico')) + .ListImages.Add(2, ccIMAGE_TOOL, LoadPicture ('Programs.ico')) + .ListImages.Add(3, ccIMAGE_POPUP, LoadPicture ('Popup.ico')) + Endwith + + * Create a Thor_Engine object and open its tables. + + .oThor = Newobject ('Thor_Engine', 'Thor.vcx', '', tcThorFolder + 'Thor\') + .oThor.OpenTables() + + * Set the caption. + + .lblVersion.Caption = ccTHORVERSION + *!* * Removed 6/10/2012 / JRN + *!* .lblFolder.Caption = Lower (tcThorFolder) + + * Save the passed parameters. + + .oTools = .oThor.GetToolsCollection (tcThorFolder + 'Thor\Tools\') + .cThorFolder = tcThorFolder + + * Don't allow the form to be sized smaller than the default. + + *!* * Removed 6/11/2012 / JRN + *!* .MinHeight = .Height + *!* .MinWidth = .Width + + * Activate the first page so the TreeView loads. + .nFontSize = .oThor.GetOption ('LauncherFontSize') + .SetFontSize (.nFontSize) + + .BindControls = .T. + + Endwith + DoDefault() + + This.Refresh() + + ENDPROC + + PROCEDURE loadtree && Loads the TreeView + Lparameters toTree, tcFilter + + Local laPrev[1], laThis[1], laTools[1], lcCategory, lcFilter, lcHotKey, lcKey, lcPRGName + Local lcParentKey, lcPrev, lcPreviousCategory, lcPrompt, lcSortKey, lcSource, lcSubCategory, lcThis + Local lnI, lnJ, lnK, lnMax1, lnMax2, lnPersonalBackColor, lnPersonalForeColor, lnPrivateBackColor + Local lnPrivateForeColor, lnSort, lnStart, lnToolCount, loNode, loTool, loTools + + lcFilter = Chrtran(tcFilter, ',.;:', ' ') + toTree.Nodes.Clear() + loTools = Thisform.oTools + lnToolCount = 0 + + lnPrivateBackColor = Nvl(This.oThor.GetOption ('PrivateBackColor'), cnDefaultPrivateBackColor) + lnPrivateForeColor = Nvl(This.oThor.GetOption ('PrivateForeColor'), cnDefaultPrivateForeColor) + + lnPersonalBackColor = Nvl(This.oThor.GetOption ('PersonalBackColor'), cnDefaultPersonalBackColor) + lnPersonalForeColor = Nvl(This.oThor.GetOption ('PersonalForeColor'), cnDefaultPersonalForeColor) + + For lnI = 1 To loTools.Count + loTool = loTools.Item(lnI) + lcSource = Evl(Trim(loTool.Source), '(No Source)') + lcCategory = Evl(Trim(loTool.Category), lcSource) + lcSubCategory = Trim(loTool.SubCategory) + lnSort = Evl(loTool.Sort, 9999) + lcSortKey = loTool.InternalSort + lcPRGName = loTool.PRGName + + If FilterTool (lcFilter, loTool) + If (Thisform.lFavoritesOnly = .F.) Or ; + (Seek (Upper (lcPRGName), 'Favorites', 'PRGName') And Favorites.startup) + lnToolCount = lnToolCount + 1 + Dimension laTools(lnToolCount, 6) + laTools(lnToolCount, 1) = lnI + laTools(lnToolCount, 2) = lcSource + laTools(lnToolCount, 3) = lcCategory + laTools(lnToolCount, 4) = lcSubCategory + laTools(lnToolCount, 5) = lcSortKey + laTools(lnToolCount, 6) = lcPRGName + Endif + Endif + Endfor + + If lnToolCount > 0 + Asort(laTools, 5) + lcPreviousCategory = '' + + For lnI = 1 To lnToolCount + + loTool = loTools.Item(laTools(lnI, 1)) + lcSource = laTools(lnI, 2) + lcCategory = laTools(lnI, 3) + + *!* * Removed 2/3/2012 + *!* If lcSource == 'Thor' + *!* Loop + *!* Endif + + If Not lcCategory == lcPreviousCategory + lnMax1 = Alines(laPrev, lcPreviousCategory, 5, '|') + lnMax2 = Alines(laThis, lcCategory, 5, '|') + If lnI = 1 + lnJ = 1 + Else + lnStart = 1 + Min(lnMax1, lnMax2) + lcKey = '' + For lnJ = 1 To Min(lnMax1, lnMax2) + lcPrev = laPrev[lnJ] + lcThis = laThis[lnJ] + If Not Upper(lcPrev) == Upper(lcThis) + lnStart = lnJ + Exit + Endif + lcKey = Upper(lcKey + Iif(lnJ > 1, '\', '') + lcThis) + Endfor + Endif + For lnK = lnJ To lnMax2 + If lnK = 1 + lcKey = Upper(laThis[1]) + loNode = toTree.Nodes.Add(, 1, lcKey, laThis[1], ccIMAGE_MENU) + loNode.Expanded = .T. + loNode.Bold = .T. + Else + lcParentKey = Upper(lcKey) + lcKey = Upper(lcParentKey + '\' + Chrtran(laThis[lnK], '.,;\/', '-----')) + loNode = toTree.Nodes.Add(lcParentKey, 4, lcKey, laThis[lnK], ccIMAGE_MENU) + loNode.Expanded = Thisform.lFavoritesOnly Or Not Empty(lcFilter) + Endif + Endfor + Endif + + lcPrompt = loTool.Prompt + lcPRGName = loTool.PRGName + = Seek(Upper(lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + lcHotKey = Thisform.GetHotKeyDescription(ToolHotKeyAssignments.HotKeyID) + loNode = toTree.Nodes.Add(lcKey, 4, lcKey + '\' + lcPRGName ; + , lcPrompt + Iif(Empty(lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_TOOL) + Do Case + Case loTool.PrivateCopy = 1 + loNode.ForeColor = m.lnPersonalForeColor + loNode.BackColor = m.lnPersonalBackColor + Case loTool.PrivateCopy = -1 + loNode.ForeColor = m.lnPrivateForeColor + loNode.BackColor = m.lnPrivateBackColor + Endcase + loNode.Tag = loTool + + lcPreviousCategory = lcCategory + + Endfor && lnI = 1 To lnToolCount + + Else + + lcKey = 'No matches found' + loNode = toTree.Nodes.Add(, 1, lcKey, lcKey, ccIMAGE_MENU) + loNode.Bold = .T. + loNode.ForeColor = Rgb(255, 0, 0) + + Endif + + ENDPROC + + PROCEDURE notthorinternalmenu + Do Case + Case Trim (MenuDefinitions.PopupName) == 'Thor_Internal' + Return .F. + Case Trim (MenuDefinitions.PopupName) == ccRunAllTools + Return .F. + Otherwise + Return .T. + Endcase + ENDPROC + + PROCEDURE refreshtools && Refreshes the tools + *============================================================================== + * Method: RefreshTools + * Purpose: Refreshes the tools + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: none + * Returns: none + * Environment in: This.oTools.Tag contains the tools folder + * Environment out: the tools collection has been recreated and controls on the + * form refreshed + *============================================================================== + + with This + .oTools = .oThor.GetToolsCollection(.oTools.Tag) + .lRefreshTools = .T. + + .lRefreshSelectToolTreeView = .T. + .lRefreshCustomToolTreeView = .T. + + .Refresh() + .lRefreshTools = .F. + *!* * Removed 6/22/2012 / JRN + *!* messagebox(ccTOOLS_REFRESHED, MB_OK, ccTHOR_CAPTION) + endwith + + ENDPROC + + PROCEDURE restoresettings + DoDefault() + + * Restore saved settings from FOXUSER. + + With This + .lReopen = Nvl(.oPersist.Get('ReopenAfterExecuting'), .F.) + .lSearchToolNamesOnly = Nvl(.oPersist.Get('ToolNamesOnly'), .F.) + .nSplitterPosition = Nvl(.oPersist.Get('SplitterPosition'), -1) + .Toolkeys1.cntFrame.Frame.ActivePage = Nvl(.oPersist.Get('StartPage'), 1) + Endwith + + ENDPROC + + PROCEDURE runthor && Runs Thor to update the hotkeys and menus + *============================================================================== + * Method: RunThor + * Purpose: Runs Thor to update the hotkeys and menus + * Author: Doug Hennig + * Last revision: 04/09/2011 + * Parameters: none + * Returns: none + * Environment in: This.cThorFolder contains the Thor folder + * Environment out: Thor_Run has been instantiated and its Run method called + *============================================================================== + + local lcApp, ; + lcFolder, ; + loRunThor + lcApp = This.cThorFolder + 'Thor.App' + lcFolder = This.cThorFolder + 'Thor\' + loRunThor = newobject ('Thor_Run', 'thor_run.vcx', '', lcApp, lcFolder) + loRunThor.AddProperty('cApplication', lcApp) + loRunThor.Run(.T.) && but no startups + + *!* * Removed 9/12/2012 / JRN + *!* * Display a message if we're supposed to. + + *!* if This.oThor.GetOption('UpdateMessage') + *!* messagebox (ccRUN_THOR_DONE, MB_OK, ccTHOR_CAPTION, 3000) + *!* endif This.oThor.GetOption('UpdateMessage') + + ENDPROC + + PROCEDURE runtool + Lparameters lcPRGName + + Local lnDataSession, lnDockPosition, lnHeight, lnLeft, lnTop, lnWidth + lnDataSession = Set('Datasession') + Set DataSession To 1 + + lnDockPosition = Thisform.DockPosition + + lnTop = Thisform.Top + lnLeft = Thisform.Left + lnHeight = Thisform.Height + lnWidth = Thisform.Width + + Thisform.Hide() + Do(m.lcPRGName) + Set DataSession To(m.lnDataSession) + + If Thisform.lReOpen + Thisform.LockScreen = .T. + + Thisform.Show() + If m.lnDockPosition # Thisform.DockPosition + Thisform.Dock(m.lnDockPosition) + Endif + + Thisform.Top = m.lnTop + Thisform.Left = m.lnLeft + Thisform.Height = m.lnHeight + Thisform.Width = m.lnWidth + + Thisform.LockScreen = .F. + Else + + * following is necessary if form is dockable; the values for Top and Left get hosed + * so we persist the real values now and not these bad values + Thisform.oPersist.Set('Dockable', Thisform.Dockable) + Thisform.oPersist.Set('Top', m.lnTop) + Thisform.oPersist.Set('Left', m.lnLeft) + Thisform.oPersist.Set('Height', m.lnHeight) + Thisform.oPersist.Set('Width', m.lnWidth) + Thisform.lPersistSizePosition = .F. + + Thisform.Release() + Endif + + + ENDPROC + + PROCEDURE savesettings + With This + + .oPersist.Set ('ReopenAfterExecuting', .lReopen) + .oPersist.Set ('ToolNamesOnly', .lSearchToolNamesOnly) + .oPersist.Set ('SplitterPosition', .toolkeys1.thor_sfsplitterh1.Left) + .oPersist.Set ('StartPage', .Toolkeys1.cntFrame.Frame.ActivePage) + + Endwith + + DoDefault() + + ENDPROC + + PROCEDURE setfontsize + Lparameters tnFontSize + + Local lnFontsize + lnFontsize = Nvl (tnFontSize, 8) + With This + .FontSize = lnFontsize + .SetAll ('FontSize', lnFontsize) + This.Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.oTree.Font.Size = lnFontsize + Endwith + + ENDPROC + + PROCEDURE setpage + Lparameters lnPage + This.Toolkeys1.cntFrame.Frame.Activepage = lnPage + ENDPROC + + PROCEDURE cmdRefresh.Click + Thisform.RefreshTools() + Thisform.RunThor() + + + ENDPROC + + PROCEDURE cmdRefresh.Init + This.ToolTipText = ccTOOL_TOOLTIP + DoDefault() + + ENDPROC + + PROCEDURE lblVersion.Move + LPARAMETERS nLeft, nTop, nWidth, nHeight + + This.Visible = This.Left > 450 + + + + ENDPROC + + PROCEDURE lblVersion.Refresh + This.Visible = This.Left > 350 + + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.cmdLeft.Click + Thisform.ResizeForm(.T.) + Thisform.Refresh() + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.cmdLeft.Init + This.ToolTipText = 'Shrink form, hiding all the controls on the right' + DoDefault() + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.cmdLeft.Refresh + This.Visible = Not Thisform.lHideRightSide + + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.cmdRight.Click + Thisform.ResizeForm(.F.) + Thisform.Refresh() + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.cmdRight.Init + This.ToolTipText = 'Expand form, revealing all the controls on the right' + DoDefault() + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.cmdRight.Refresh + This.Visible = Thisform.lHideRightSide + + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.basepage1.Activate + Thisform.lFavoritesOnly = .F. + This.Parent.Parent.Parent.cntToolInfo.Visible = .F. + + DoDefault() + If Thisform.lOpeningForm + Thisform.lOpeningForm = .F. + With This.selecttoolforlauncher1.txtcNewFilter + .SetFocus() + Keyboard '{CTRL+A}' + Endwith + Endif + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Basecheckbox2.Valid + This.Parent.ReLoadTree() + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.selectitem + *============================================================================== + * Method: SelectItem + * Purpose: Selects the specified item in the ListView + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: tuItem - a node or a node key + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tuItem + + Local lcPRGName, loItem + loItem = tuItem.Tag + With This.Parent.Parent.Parent.Parent + .SelectItem (loItem) + Endwith + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.Activate + This.Parent.Parent.Parent.cntToolInfo.Visible = .F. + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.edtNoneFound.Init + TEXT to This.Value Noshow + Use this custom list as a single place for all the tools you have found useful. + + Your list is now empty. + + To add tools to this list, open the Thor Configuration form and create one or more popup menus (or use existing menus). + + Mark the checkbox "Show in Launcher" for each of these popup menus. + + Then add the tools that you find of interest to the popup menus. You can add sub-menus, if you like, and order the tools in whatever way makes sense to you. + + NOTE: You can also access these popup menus by using hot keys. Assign a hot key to them in the right hand panel of the configuration form, below the checkbox. + ENDTEXT + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.oTree.DblClick + * If the selected item is a tool, run it on a double-click. + + If (Not Empty (This.Parent.Parent.Parent.Parent.cPRGName)) and not Thisform.lHideRightSide + Thisform.RunTool (This.Parent.Parent.Parent.Parent.oTool.FullFileName) + Endif + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.oTree.getitemkey + *============================================================================== + * Method: GetItemKey + * Purpose: Gets the item key from the specified node key + * Author: Doug Hennig + * Last revision: 03/19/2011 + * Parameters: toNode - the node to get the item key from + * Returns: the item key + * Environment in: none + * Environment out: none + * Note: Keys are stored as a path. For example, for the Display UI + * item (tool ID 4) in the Thor submenu (menu ID 8) of the + * Tools menu (menu ID 6), the key is VFP\M6\M8\T4. This + * method returns T4 in that case + *============================================================================== + + lparameters toNode + + If 'O' # Vartype(toNode) + Return '' + EndIf + + lcKey = toNode.Key + lnPos = rat(ccKEY_SEPARATOR, lcKey) + if lnPos > 0 + lcKey = substr(lcKey, lnPos + 1) + endif lnPos > 0 + return lcKey + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.oTree.loadchildnodes + *============================================================================== + * Method: LoadChildNodes + * Purpose: Loads the submenus of the specified menu + * Author: Doug Hennig + * Last revision: 03/24/2011 + * Parameters: tnID - the ID for the menu item to load submenus for + * Returns: none + * Environment in: MenuTools is open and is ordered by SortOrder + * Environment out: nodes for the submenus and tools have been loaded into the + * TreeView + *============================================================================== + + lparameters tnID, ; + tcParentKey + Local ; + loNode AS Object ,; + loTag AS Object + Local lcPrompt, lnRecno, lnSelect + lnSelect = select() + select MenuTools + scan for MenuID = tnID + do case + case SubMenuID = 0 + + * This is a tool or separator, so add it under the menu. + + if Separator + lcPrompt = ccSEPARATOR_PROMPT + else + If not Empty(PRGName) + lcPrompt = trim(Prompt) + Try + loTag = Thisform.oTools(Upper(Alltrim(PRGName))) + Catch + loTag = '' + EndTry + Else + lcPrompt = ccNoToolSelected + loTag = '' + EndIf + = seek(upper(PRGName), 'ToolHotKeyAssignments', 'PRGName') + if seek(ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + lcPrompt = lcPrompt + ' (' + ; + trim(HotKeyDefinitions.Descript) + ')' + EndIf + endif Separator + loNode = This.LoadNode(tcParentKey, lcPrompt, ccIMAGE_TOOL, ID) + loNode.Tag = loTag + + * If this is a submenu, find the menu's record, add a node under the menu we're + * we're working on, and process all child nodes. + + case seek(MenuTools.SubMenuID, 'MenuDefinitions', 'ID') + = seek(MenuTools.SubMenuID, 'MenuDefinitions', 'ID') + lcPrompt = trim(MenuDefinitions.Prompt) + if seek(MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + lcPrompt = lcPrompt + ' (' + ; + trim(HotKeyDefinitions.Descript) + ')' + endif seek(MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + loNode = This.LoadNode(tcParentKey, lcPrompt, ; + ccIMAGE_MENU, SubMenuID) + loNode.Expanded = .T. + lnRecno = recno() + This.LoadChildNodes(SubMenuID, loNode.Key) + go lnRecno + endcase + endscan for MenuID = tnID + select (lnSelect) + return + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.oTree.loadnode + *============================================================================== + * Method: LoadNode + * Purpose: Loads a node in the TreeView + * Author: Doug Hennig + * Last revision: 03/19/2011 + * Parameters: tcParentKey - the key of the parent node to add this under + * tcPrompt - the text for the node + * tcIcon - the icon for the node + * tnID - the ID of the record the node represents + * Returns: a reference to the node + * Environment in: none + * Environment out: a node was added to the TreeView + *============================================================================== + + lparameters tcParentKey, ; + tcPrompt, ; + tcIcon, ; + tnID + local lcKey, ; + loNode + lcKey = tcParentKey + ccKEY_SEPARATOR + left(tcIcon, 1) + transform(tnID) + loNode = This.Nodes.Add(tcParentKey, cnCHILD_NODE, lcKey, Strtran(tcPrompt, '\<', ''), ; + tcIcon) + return loNode + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.oTree.loadtree + *============================================================================== + * Method: LoadTree + * Purpose: Loads the TreeView control with menus and the tools in them + * Author: Doug Hennig + * Last revision: 03/20/2011 + * Parameters: none + * Returns: none + * Environment in: MenuDefinitions and MenuTools are open + * Environment out: MenuDefinitions and MenuTools are both ordered on SortOrder + * the TreeView is loaded with menu and tool nodes + *============================================================================== + + Lparameters tlReload + Local lcPrompt, lnRecno, lnRecno1, lnRecno2, lnSortOrder, loNode, loTree + With This + loTree = This + loTree.Nodes.Clear() + + * If we're reloading the TreeView, preserve the expanded status of nodes and + * the selected node, then clear the TreeView. + + If tlReload + loTree.SaveExpandedNodes() + lnRecno1 = Recno ('MenuDefinitions') + lnRecno2 = Recno ('MenuTools') + Endif tlReload + + * Go through the defined menus and add them and their tools to the TreeView. + + Set Order To SortOrder In MenuTools + * First, correct existing SortOrder in MenuDefinitions + * (there may be holes, or duplicates) + Select MenuDefinitions + Set Order To + Replace All SortOrder With SortOrder + 1000 For TopLevel + Set Order To SortOrder + lnSortOrder = 0 + Scan For TopLevel + lnSortOrder = lnSortOrder + 1 + Replace SortOrder With lnSortOrder + Endscan + + Select * From MenuDefinitions; + where Launcher And Not Internal; + order By Prompt; + into Cursor cursor_MenuDefinitions + + Scan + lcPrompt = Trim (Prompt) + If Seek (MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + lcPrompt = lcPrompt + ' (' + ; + Trim (HotKeyDefinitions.Descript) + ')' + Endif Seek (MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + + loNode = loTree.Nodes.Add (, 0, 'M' + Transform (Recno()), lcPrompt, ; + ccIMAGE_MENU) + loNode.Expanded = .T. + loNode.Bold = .T. + lnRecno = Recno() + .LoadChildNodes (Id, loNode.Key) + Endscan + + Use In cursor_MenuDefinitions + + * If we reloaded the TreeView, reexpanded formerly expanded nodes, reselect the + * former node, and restore the saved record pointers. Otherwise, select the + * first node. + + If tlReload + loNode = loTree.RestoreExpandedNodes() + If Vartype (loNode) = 'O' + .Selectitem (loNode) + Endif + If Between (lnRecno1, 1, Reccount ('MenuDefinitions')) + Go lnRecno1 In MenuDefinitions + Endif Between (lnRecno1 ... + If Between (lnRecno2, 1, Reccount ('MenuTools')) + Go lnRecno2 In MenuTools + Endif Between (lnRecno2... + Else + *!* * Removed 6/21/2012 / JRN + *!* .SelectItem(loTree.Nodes(1)) + Endif tlReload + Endwith + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.oTree.NodeClick + Lparameters Node + + Local loItem + + loItem = Node.Tag + With This.Parent.Parent.Parent.Parent + .SelectItem (loItem) + Endwith + + If (Not Empty (This.Parent.Parent.Parent.Parent.cPRGName)) And Thisform.lHideRightSide + Thisform.RunTool (This.Parent.Parent.Parent.Parent.oTool.FullFileName) + Endif + + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.oTree.Refresh + Local llShowTreeView + If Thisform.oTools.Count # 0 And Thisform.lRefreshCustomToolTreeView + This.LoadTree() + Thisform.lRefreshCustomToolTreeView = .F. + + llShowTreeView = This.Nodes.Count # 0 + This.Visible = Not llShowTreeView + This.Visible = llShowTreeView + This.Parent.edtNoneFound.Visible = Not llShowTreeView + Endif + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage2.oTree.UIEnable + Lparameters tlEnable + If tlEnable And This.Nodes.Count = 0 + This.Object.ImageList = Thisform.oImageList + This.LoadTree() + Endif tlEnable ... + + This.Font.Size = Thisform.FontSize + + If This.Nodes.Count # 0 + This.Visible = Not tlEnable + This.Visible = tlEnable + This.Parent.edtNoneFound.Visible = .F. + Else + This.Visible = .T. + This.Visible = .F. + This.Parent.edtNoneFound.Visible = .T. + Endif + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage3.Activate + Thisform.lFavoritesOnly = .T. + This.Parent.Parent.Parent.cntToolInfo.Visible = .F. + + DoDefault() + If Thisform.lOpeningForm + Thisform.lOpeningForm = .F. + With This.selecttoolforlauncher1.txtcNewFilter + .SetFocus() + Keyboard '{CTRL+A}' + Endwith + Endif + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage3.Selecttoolforlauncher1.Basecheckbox2.Valid + This.Parent.ReLoadTree() + + ENDPROC + + PROCEDURE Toolkeys1.cntFrame.Frame.Basepage3.Selecttoolforlauncher1.selectitem + *============================================================================== + * Method: SelectItem + * Purpose: Selects the specified item in the ListView + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: tuItem - a node or a node key + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tuItem + + Local lcPRGName, loItem + loItem = tuItem.Tag + With This.Parent.Parent.Parent.Parent + .SelectItem (loItem) + Endwith + + ENDPROC + + PROCEDURE Toolkeys1.cntToolInfo.cmdToolBarIcon.Click + DoDefault() + ThisForm.CreateToolBar() + + ENDPROC + + PROCEDURE Toolkeys1.cntToolInfo.cmdToolBarIcon.RightClick + DoDefault() + ThisForm.CreateToolBar() + + ENDPROC + + PROCEDURE Toolkeys1.cntToolInfo.oHotKeyControls.CMDCLEAR.Click + DoDefault() + Thisform.AssignAllHotKeys() + + ENDPROC + + PROCEDURE Toolkeys1.cntToolInfo.oHotKeyControls.cmdGetHotKey.Click + DoDefault() + Thisform.AssignAllHotKeys() + + ENDPROC + + PROCEDURE Toolkeys1.THOR_SFSPLITTERH1.movesplittertoposition + Lparameters tnPosition + + DoDefault (tnPosition) + Thisform.nSplitterPosition = tnPosition + ENDPROC + + PROCEDURE Toolkeys1.THOR_SFSPLITTERH1.Refresh + *!* * Removed 6/26/2012 / JRN + *!* If Thisform.nSplitterPosition # This.Left And Thisform.nSplitterPosition >= 0 + *!* This.MoveSplitterToPosition (Thisform.nSplitterPosition) + *!* Endif + + ENDPROC + +ENDDEFINE + +DEFINE CLASS hotkeycontrols AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdGetHotKey" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblHotKey" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtHotKey" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdClear" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: cancelhotkey && Cancels the hotkey waiting + *m: clearhotkey && Clears the current hotkey + *m: keypressed && Called when the user presses a hotkey + *m: onclearhotkey && Called when the hotkey is cleared + *m: onkeypressed && Called from KeyPressed so an instance can do the appropriate thing + *m: onpreupdate && Called from KeyPressed before updating the HotKeyID field + *m: starthotkey && Starts the process of getting a hot key + *p: calias && The alias HotKeyID is in + *p: chotkeydescription && The description for the selected hot key + *p: csavedmacrosfile + *p: lonkeylabelonly + *p: lrefreshform + *p: ninkey + *p: oeventhandler && A reference to a IDEWindowsEvents object + *p: oform && A reference to the PressKeyPrompt form + * + + calias = && The alias HotKeyID is in + chotkeydescription = && The description for the selected hot key + csavedmacrosfile = + Height = 25 + lonkeylabelonly = .F. + lrefreshform = .F. + Name = "hotkeycontrols" + ninkey = 0 + oeventhandler = .NULL. && A reference to a IDEWindowsEvents object + oform = .NULL. && A reference to the PressKeyPrompt form + Width = 236 + _memberdata = + + + + + + ADD OBJECT 'cmdClear' AS basecommandbutton WITH ; + Caption = "Clear", ; + Height = 24, ; + Left = 191, ; + Name = "cmdClear", ; + TabIndex = 7, ; + Top = 0, ; + Width = 43 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdGetHotKey' AS basecommandbutton WITH ; + Caption = "...", ; + Height = 24, ; + Left = 165, ; + Name = "cmdGetHotKey", ; + TabIndex = 7, ; + Top = 0, ; + Width = 24 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'lblHotKey' AS baselabel WITH ; + Caption = "\ + + ADD OBJECT 'txtHotKey' AS basetextbox WITH ; + DisabledForeColor = 0,0,0, ; + Enabled = .F., ; + Height = 22, ; + Left = 65, ; + Name = "txtHotKey", ; + TabIndex = 6, ; + Top = 1, ; + Width = 98 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="textbox" /> + + PROCEDURE cancelhotkey && Cancels the hotkey waiting + *!* * Removed 06/17/2011 + *!* *============================================================================== + *!* * Method: CancelHotKey + *!* * Purpose: Cancels the hotkey waiting + *!* * Author: Doug Hennig + *!* * Last revision: 04/12/2011 + *!* * Parameters: none + *!* * Returns: none + *!* * Environment in: none + *!* * Environment out: event binding is turned off + *!* * This.oEventHandler is nulled + *!* * if This.oForm references a form, it's released and nulled + *!* * hot keys are restored + *!* *============================================================================== + + *!* unbindevents(0) + with This + .oEventHandler = .NULL. + if vartype(.oForm) = 'O' + .oForm.Release() + endif vartype(.oForm) = 'O' + .oForm = .NULL. + endwith + *!* pop key + *!* restore macros from (This.cSavedMacrosFile) + + ENDPROC + + PROCEDURE clearhotkey && Clears the current hotkey + *============================================================================== + * Method: ClearHotKey + * Purpose: Clears the current hotkey + * Author: Doug Hennig + * Last revision: 05/20/2011 + * Parameters: llNoForm + * Returns: none + * Environment in: This.cAlias contains the desired alias + * that table is positioned to the desired record + * Environment out: HotKeyID in the table specified in This.cAlias is zeroed + * This.cHotKeyDescription is blanked + * controls are refreshed + * see This.CancelHotKey for other changes + *============================================================================== + Lparameters llNoForm + with This + *!* * Removed 06/17/2011 + *!* If not llNoForm + *!* .CancelHotKey() + *!* EndIf + replace HotKeyID with 0 in (.cAlias) + .OnClearHotKey() + .cHotKeyDescription = '' + .Refresh() + endwith + + ENDPROC + + PROCEDURE Init + *!* * Removed 06/17/2011 + *!* * Define a location to temporarily save macros. + + *!* This.cSavedMacrosFile = addbs(sys(2023)) + 'Macros.fky' + + ENDPROC + + PROCEDURE keypressed && Called when the user presses a hotkey + *============================================================================== + * Method: KeyPressed + * Purpose: Called when the user presses a hotkey + * Author: Doug Hennig + * Last revision: 06/17/2011 JRN + * Parameters: hWnd - the hWnd of the form + * Msg - the ID of the Windows message + * wParam - the scancode of the key pressed + * lParam - modifiers for the keypress (see WM_KEYDOWN in MSDN + * for details) + * Returns: none + * Environment in: HotKeyDefinitions is open + * Environment out: if the user pressed a valid hotkey and it isn't already + * used by another record, a record for it is added to + * HotKeyDefinitions (if there isn't already one), the + * HotKeyID field in the tables specified in This.cAlias + * is updated, OnKeyPressed is called so an instance can + * do the appropriate thing, and controls are refreshed + * see This.CancelHotKey for other changes + *============================================================================== + + * Create a HotKey object, set nScanCode to the scan code for the key the user + * pressed, get the current state of the modifier keys, and see if we have a + * valid hotkey. + + Local loKey As 'HotKey' Of 'Thor_Utils.vcx' + Local lcAlias, lcDescrip, lcFkyValue, lcHotKeyDescription, lcThorKey, llFound, lnHotKeyID, lnID + Local lnRecno, lnScanCode, lnSelect, lnShift, lnShifts + + loKey = Newobject ('HotKey', 'Thor_Utils.vcx') + loKey.GetKeyState() + lnScanCode = loKey.GetScanCode (This.nInKey) + loKey.nScanCode = lnScanCode + If loKey.IsValid(This.lOnKeyLabelOnly) + lcDescrip = loKey.GetHotKeyDescription() + lnShift = loKey.GetModifiersValue() + + * Find the HotKeyDefinitions record for the hotkey; add one if necessary. + + lnSelect = Select() + Select HotKeyDefinitions + + lnShifts = loKey.GetShifts() + Locate For nKeyCode = lnScanCode And nShifts = lnShifts + lcFkyValue = loKey.GetKeyCode() + If Found() + Replace FkyValue With lcFkyValue + Else + lcFkyValue = loKey.GetKeyCode() + Insert Into HotKeyDefinitions (nKeyCode, nShifts, Descript, FkyValue) ; + Values (lnScanCode, lnShifts, lcDescrip, lcFkyValue) + Endif Not Found() + lnHotKeyID = Id + + * See if the hotkey is already in use by another record. + + lcAlias = Upper (This.cAlias) + lnID = Evaluate (lcAlias + '.ID') + lnRecno = Recno (lcAlias) + llFound = Seek (lnHotKeyID, 'MenuDefinitions', 'HotKeyID') And ; + (lcAlias # 'MENUDEFINITIONS' Or MenuDefinitions.Id # lnID) + llFound = llFound Or ; + (Seek (lnHotKeyID, 'ToolHotKeyAssignments', 'HotKeyID') And ; + (lcAlias # 'TOOLHOTKEYASSIGNMENTS' Or ; + ToolHotKeyAssignments.Id # lnID)) + If Between (lnRecno, 1, Reccount (lcAlias)) + Go lnRecno In (lcAlias) + Endif Between (lnRecno, 1, Reccount (lcAlias)) + Select (lnSelect) + + * Make sure it's not being used by Thor itself. + + lcThorKey = Thisform.oThor.GetOption ('ThorHotKey') + llFound = llFound Or lcThorKey = lcDescrip + If llFound + Messagebox (ccHOTKEY_ALREADY_USED, MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + = Seek(0, 'HotKeyDefinitions', 'ID') + && find a non-existent record on purpose + + * Call the OnPreUpdate hook method, update the HotKeyID in the desired table, + * refresh the controls, and call the OnKeyPressed hook method. + + Else + This.OnPreUpdate() + Replace HotKeyID With lnHotKeyID In (lcAlias) + lcHotKeyDescription = Trim (HotKeyDefinitions.Descript) + This.cHotKeyDescription = lcHotKeyDescription + This.Refresh() + This.OnKeyPressed() + Endif llFound + Else + + * Tell the user that we don't have a valid hotkey. + + If Not Inlist(This.nInKey, 0, 13, 27) + Messagebox (ccINVALID_HOT_KEY, MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + Endif + Endif loKey.IsValid() + + ENDPROC + + PROCEDURE onclearhotkey && Called when the hotkey is cleared + *============================================================================== + * Method: OnClearHotKey + * Purpose: Called when the hotkey is cleared + * Author: Doug Hennig + * Last revision: 03/25/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + * Abstract method + + ENDPROC + + PROCEDURE onkeypressed && Called from KeyPressed so an instance can do the appropriate thing + *============================================================================== + * Method: OnKeyPressed + * Purpose: Called from KeyPressed so an instance can do the + * appropriate thing + * Author: Doug Hennig + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 03/20/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + * Abstract method + + ENDPROC + + PROCEDURE onpreupdate && Called from KeyPressed before updating the HotKeyID field + *============================================================================== + * Method: OnPreUpdate + * Purpose: Called from KeyPressed before updating the HotKeyID field + * Author: Doug Hennig + * Last revision: 03/25/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + * Abstract method + + ENDPROC + + PROCEDURE Refresh + This.txtHotKey.Value = This.cHotKeyDescription + + ENDPROC + + PROCEDURE starthotkey && Starts the process of getting a hot key + *============================================================================== + * Method: StartHotKey + * Purpose: Starts the process of getting a hot key + * Author: Doug Hennig + * Last revision: 06/19/2011 JRN + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + *!* * Removed 06/17/2011 + *!* push key clear + *!* save macros to (This.cSavedMacrosFile) + *!* clear macros + with This + .nInKey = 0 + If This.lOnKeyLabelOnly + .oForm = newobject('PressKeyPromptOKL', 'Thor_UI.vcx', '', ThisForm.FontSize) + Else + .oForm = newobject('PressKeyPrompt', 'Thor_UI.vcx', '', ThisForm.FontSize) + EndIf + *!* .oEventHandler = newobject('IDEWindowsEvents', 'Thor_Utils.vcx') + *!* bindevent(.oForm.HWnd, WM_KEYUP, .oEventHandler, 'EventHandler') + *!* bindevent(.oForm.HWnd, WM_SYSKEYUP, .oEventHandler, 'EventHandler') + *!* bindevent(.oEventHandler, 'EventHandler', This, 'KeyPressed') + .oForm.Show() + endwith + + This.nInkey = Inkey(10) + This.oForm.Release() + If not InList(This.nInKey, 0, 13, 27) + This.KeyPressed() + EndIf + + + ENDPROC + + PROCEDURE cmdClear.Click + This.Parent.ClearHotKey(.T.) + + ENDPROC + + PROCEDURE cmdClear.Init + This.Caption = ccCLEAR + dodefault() + + ENDPROC + + PROCEDURE cmdGetHotKey.Click + This.Parent.StartHotKey() + + ENDPROC + + PROCEDURE lblHotKey.Init + This.Caption = ccHOTKEY + dodefault() + + ENDPROC + + PROCEDURE txtHotKey.Refresh + This.Enabled = .F. + ENDPROC + +ENDDEFINE + +DEFINE CLASS hotkeylist AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="gridKeys" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColHotKey.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColHotKey.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColSource.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColSource.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColDescription.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColDescription.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdToClipboard" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: createcursor + *m: griddoubleclick + *m: loadlist + *m: setdescriptionwidth + *m: setgridorder + *p: ignorenextloadlist + * + + Anchor = 15 + Height = 212 + ignorenextloadlist = .F. + Name = "hotkeylist" + Width = 332 + _memberdata = + + + + + + + ADD OBJECT 'cmdToClipboard' AS basecommandbutton WITH ; + Anchor = 4, ; + AutoSize = .T., ; + Caption = "To Clipboard", ; + Left = 89, ; + Name = "cmdToClipboard", ; + TabIndex = 5, ; + Top = 180 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'gridKeys' AS basegrid WITH ; + Anchor = 15, ; + ColumnCount = 3, ; + DeleteMark = .F., ; + GridLineColor = 192,192,192, ; + Height = 167, ; + Left = 6, ; + Name = "gridKeys", ; + ReadOnly = .T., ; + RecordMark = .F., ; + RecordSource = "crsr_GridKeys", ; + Top = 6, ; + Width = 320, ; + Column1.ControlSource = "", ; + Column1.DynamicFontBold = "crsr_GridKeys.Bold", ; + Column1.DynamicForeColor = "IIF(crsr_GridKeys.Red, 255, 0)", ; + Column1.Name = "ColHotKey", ; + Column1.ReadOnly = .T., ; + Column1.Width = 120, ; + Column2.ControlSource = "", ; + Column2.DynamicFontBold = "crsr_GridKeys.Bold", ; + Column2.DynamicForeColor = "IIF(crsr_GridKeys.Red, 255, 0)", ; + Column2.Name = "ColSource", ; + Column2.ReadOnly = .T., ; + Column2.Width = 100, ; + Column3.ControlSource = "", ; + Column3.DynamicBackColor = "IIF(Abs(PrivateCop) = 1, RGB(255,255,0), RGB(255,255,255))", ; + Column3.DynamicFontBold = "crsr_GridKeys.Bold", ; + Column3.DynamicForeColor = "IIF(crsr_GridKeys.Red or PrivateCop = -1, 255, 0)", ; + Column3.Name = "ColDescription", ; + Column3.ReadOnly = .T. + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="grid" /> + + ADD OBJECT 'gridKeys.ColDescription.Header1' AS header WITH ; + Caption = "Description", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gridKeys.ColDescription.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'gridKeys.ColHotKey.Header1' AS header WITH ; + Caption = "Hot Key", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gridKeys.ColHotKey.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'gridKeys.ColSource.Header1' AS header WITH ; + Caption = "Source", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gridKeys.ColSource.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE createcursor + Lparameters lcCursorName + + Create Cursor (lcCursorName) ( ; + HotKey C (20), ; + Source C (15), ; + Descript C (200), ; + Type N (2), ; + ID I , ; + Bold L, ; + Red L, ; + PrivateCop N(4), ; + nShifts N (4), ; + Recno N (4) ; + ) + + ENDPROC + + PROCEDURE griddoubleclick + Local loForm As 'SetHotKeyForm' Of 'Thor_UI.vcx' + Local lcAction, lcAlias, lnID, lnType + + lnType = crsr_GridKeys.Type + lnID = crsr_GridKeys.Id + + Do Case + Case lnType = 1 + lcAlias = 'MenuDefinitions' + Case lnType = 2 + lcAlias = 'ToolHotKeyAssignments' + Otherwise + Return + Endcase + + If Seek (lnID, lcAlias, 'ID') + This.IgnoreNextLoadList = .T. + lcAction = 'Set' + + loForm = Newobject ('SetHotKeyForm', 'Thor_UI.vcx', '') + loForm.oThor = Thisform.oThor + loForm.ExecuteCommand (lcAlias, lcAction) + loForm.Release() + loForm = .Null. + + This.IgnoreNextLoadList = .F. + This.LoadList() + Endif + + ENDPROC + + PROCEDURE loadlist + Local lcDescription, lcHotKeyDescript, lcHotKeyName, lcThorKey, llRed, lnID, lnKey, lnPrivateCopy, loItem, loKey + Local loMacro, loMacros, loOnKeyLabels + + If This.IgnoreNextLoadList + This.IgnoreNextLoadList = .F. + Return + EndIf + + This.CreateCursor ('crsr_Keys') + + * On Key Label Definitions + loOnKeyLabels = Thisform.oThor.GetOnKeyLabelDefinitions() + lcThorKey = Thisform.oThor.GetOption ('ThorHotKey') + For Each loKey In loOnKeyLabels FoxObject + If Upper (Trim (loKey.Key)) == Upper (Trim (lcThorKey)) + lcDescription = '<' + ccTHOR_HOT_KEY + '>' + Else + lcDescription = loKey.Definition + EndIf + + If lcDescription = ccOnKeyLabelPrefix + Loop + EndIf + + Insert Into crsr_Keys ; + (HotKey, Source, Descript, Type) ; + Values ; + (loKey.Key, 'On Key Label', lcDescription, 4) + Endfor + + * Pop-up Menus + Insert Into crsr_Keys ; + (HotKey, Source, Descript, Type, Id, Bold) ; + Select HotKeyDefinitions.Descript ; + , 'Pop-up Menu' ; + , Strtran (MenuDefinitions.Prompt, '\<', '') ; + , 1 ; + , MenuDefinitions.Id ; + , .T. ; + From MenuDefinitions ; + Join HotKeyDefinitions ; + On MenuDefinitions.hotkeyid = HotKeyDefinitions.Id + + * HotKeys for Tools + Select HotKeyDefinitions.Descript As HotKeyName ; + , ToolHotKeyAssignments.PrgName ; + , ToolHotKeyAssignments.Id ; + From ToolHotKeyAssignments ; + Join HotKeyDefinitions ; + On ToolHotKeyAssignments.hotkeyid = HotKeyDefinitions.Id ; + Into Cursor crsr_HotKeys + + Scan + lcHotKeyName = HotKeyName + lnKey = Thisform.oTools.GetKey (Upper (Trim (PrgName))) + lnID = Id + If 0 # lnKey + lcHotKeyDescript = Thisform.oTools (lnKey).Prompt + llRed = .F. + lnPrivateCopy = Thisform.oTools (lnKey).PrivateCopy + Do Case + Case lnPrivateCopy = 1 + lcHotKeyDescript = Trim(lcHotKeyDescript) + ' (private)' + Case lnPrivateCopy = -1 + lcHotKeyDescript = Trim(lcHotKeyDescript) + ' (private, over-rides default)' + Endcase + Else + lcHotKeyDescript = Trim (PrgName) + ' (not found)' + llRed = .T. + lnPrivateCopy = -99 + Endif + + Insert Into crsr_Keys ; + (HotKey, Source, Descript, Type, Id, Bold, Red, PrivateCop) ; + Values ; + (lcHotKeyName, 'Thor Tool', lcHotKeyDescript, 2, lnID, .T., llRed, lnPrivateCopy) + Endscan + + * Macros + loMacros = Thisform.oThor.GetMacroDefinitions() + For Each loMacro In loMacros FoxObject + If Lower (loMacro.Name) # 'thor:' + Insert Into crsr_Keys ; + (HotKey, Source, Descript, Type) ; + Values ; + (loMacro.Definition, 'Macro', loMacro.Keystrokes, 3) + Endif + Endfor + + * Sort 'em + Select crsr_Keys + Replace All nShifts With IIf (ccSHIFT $ HotKey, 1, 0) + IIf (ccCTRL $ HotKey, 2, 0) + IIf (ccALT $ HotKey, 4, 0) + Update crsr_Keys ; + Set crsr_Keys.Recno = xHotKeys.Recno ; + From crsr_Keys ; + Join ( ; + Select Key, Recno() As Recno From HotKeys ; + ) As xHotKeys ; + On xHotKeys.Key = ; + Upper (Left (Substr (HotKey, 1 + Rat ('-', HotKey)), 10)) + + Select crsr_Keys + Replace all nShifts with Icase (nShifts = 4, 3, nShifts = 3, 4, nShifts) && just to get a nicer sort order + + Select crsr_GridKeys + Delete All + Append From Dbf ('crsr_Keys') + Goto Top + + This.gridKeys.SetFocus() + + This.SetDescriptionWidth() + + ENDPROC + + PROCEDURE Resize + This.SetDescriptionWidth() + + ENDPROC + + PROCEDURE setdescriptionwidth + With this.gridKeys + .ColDescription.Width = .Width - .ColHotKey.Width - .ColSource.Width - Sysmetric(14) - 12 + EndWith + + ENDPROC + + PROCEDURE setgridorder + Lparameters lcOrder + + If Upper(lcOrder) = 'RECNO' and Order() = 'RECNO' + Set Order to nShifts + Else + Set Order to &lcOrder) + EndIf + + Goto top + This.Refresh() + ENDPROC + + PROCEDURE cmdToClipboard.Click + Local lnRecno, lnSelect + lnSelect = Select() + + Select HotKey, ; + Source, ; + Descript ; + From crsr_GridKeys ; + Order By Recno ; + Into Cursor crsr_ExportGridKeys + + _vfp.DataToClip('crsr_ExportGridKeys', Reccount(), 3) + + Select (lnSelect) + Messagebox('Contents of grid pasted into the clipboard') + + ENDPROC + + PROCEDURE gridKeys.ColDescription.Header1.Click + This.Parent.Parent.Parent.SetGridOrder('Descript') + + ENDPROC + + PROCEDURE gridKeys.ColHotKey.Header1.Click + This.Parent.Parent.Parent.SetGridOrder('Recno') + + ENDPROC + + PROCEDURE gridKeys.ColSource.Header1.Click + This.Parent.Parent.Parent.SetGridOrder('Source') + + ENDPROC + + PROCEDURE gridKeys.Init + Local lnI + With This + + * Set the font. + For lnI = 1 To .ColumnCount + Bindevent (This.Columns (lnI).Text1, 'RightClick', This, 'RightClick') + Bindevent (This.Columns (lnI).Text1, 'DblClick', This.Parent, 'GridDoubleClick') + Endfor + + .Parent.CreateCursor ('crsr_GridKeys') + .FontName = Thisform.FontName + .FontSize = 8 + + Index On (1000 * Recno) + nShifts Tag Recno + Index On (1000 * nShifts) + Recno Tag nShifts + Index On IIf (Bold, 'A', 'B') + Source + Descript Tag Source + Index On Upper (Descript) Tag Descript + + This.Parent.SetGridOrder ('Recno') + + Endwith + + ENDPROC + + PROCEDURE gridKeys.RightClick + Local loContextMenu As 'contextmenu' Of 'Thor_menu' + Local loForm As 'SetHotKeyForm' Of 'Thor_UI.vcx' + Local lcAction, lcAlias, lnID, lnType + + lnType = crsr_GridKeys.Type + lnID = crsr_GridKeys.Id + Do Case + Case lnType = 1 + lcAlias = 'MenuDefinitions' + Case lnType = 2 + lcAlias = 'ToolHotKeyAssignments' + Otherwise + Return + Endcase + + If Seek (lnID, lcAlias, 'ID') + This.Parent.IgnoreNextLoadList = .T. + loContextMenu = Newobject ('contextmenu', 'Thor_menu', Thisform.cThorFolder + 'Thor.App') + + With loContextMenu + .AddMenuItem ('Set hot key', , , , , 'Set') + .AddMenuItem() + .AddMenuItem ('Clear hot key', , , , , 'Clear') + If .Activate() + lcAction = .Parameters + + loForm = Newobject ('SetHotKeyForm', 'Thor_UI.vcx', '') + loForm.oThor = Thisform.oThor + loForm.ExecuteCommand (lcAlias, lcAction) + loForm.Release() + loForm = .Null. + Endif + Endwith + This.Parent.IgnoreNextLoadList = .F. + This.Parent.LoadList() + Endif + + ENDPROC + +ENDDEFINE + +DEFINE CLASS menus AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="oTree" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.lblPrompt" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.txtPrompt" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.lblOrder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.cmdAddTopLevel" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.cmdAddPopup" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.lblStatusBarText" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.edtStatusBarText" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.oHotKeyControls" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.cmdMoveUp" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.cmdMoveDown" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.cmdCopyMenu" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.cmdAddCopiedMenu" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.cmdRemove" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage1.Basecheckbox1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.Selecttool1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.lblOrder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.lblStatusBarText" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.edtStatusBarText" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.cmdEditTool" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.oToolInfo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.cmdMoveUp" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.cmdMoveDown" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.oFilter" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.cmdRemove" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.oHotKeyControls" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.Baseeditbox1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfProperties.Basepage2.Baselabel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdAddMenu" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdAddTool" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdAddSubMenu" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="oImageList" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdAddSeparator" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: addmenu && Adds a menu + *m: addsubmenu && Adds a submenu to the selected menu + *m: addtool && Adds a tool to the selected item + *m: createtool && Creates a template PRG for a tool + *m: getitemkey && Gets the item key from the specified node key + *m: loadchildnodes && Loads the submenus of the specified menu + *m: loadnode && Loads a node in the TreeView + *m: loadtree && Loads the TreeView control with defined menus + *m: moveitem && Moves the selected item + *m: removemenuoritem && Removes the selected menu or item + *m: selectitem && Called when the user selects an item in the TreeView + *p: ctoolfilter && A filter for the tools list + *p: ncopymenuid && The ID of a copied menu + *p: olasttoolselected + * + + Anchor = 15 + ctoolfilter = && A filter for the tools list + Height = 259 + Name = "menus" + ncopymenuid = 0 && The ID of a copied menu + olasttoolselected = .NULL. + Width = 622 + _memberdata = + + + + ADD OBJECT 'cmdAddMenu' AS basecommandbutton WITH ; + Anchor = 4, ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'cmdAddSeparator' AS basecommandbutton WITH ; + Anchor = 4, ; + AutoSize = .F., ; + Caption = "Add S\ + + ADD OBJECT 'cmdAddSubMenu' AS basecommandbutton WITH ; + Anchor = 4, ; + AutoSize = .F., ; + Caption = "Add SubMenu", ; + Height = 24, ; + Left = 82, ; + Name = "cmdAddSubMenu", ; + TabIndex = 5, ; + Top = 235, ; + Width = 97 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdAddTool' AS basecommandbutton WITH ; + Anchor = 4, ; + AutoSize = .F., ; + Caption = "A\
+ + ADD OBJECT 'oImageList' AS olecontrol WITH ; + Height = 26, ; + Left = 150, ; + Name = "oImageList", ; + Top = 0, ; + Width = 36 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\syswow64\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAnIKtITM0BAwAAAEABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXAAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAAQAAAAAAAAABAAAAAIAAAD+/////v////7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////8jfyQskYXREbFqAMDwKDYoIUM0EggAAADtAwAA7QMAAIB+4eYAAAYAIAAAAAAAAADAwMAA//9MAAHvzasAAAUAXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAYAUAD/////BQAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==" /> + + ADD OBJECT 'oTree' AS basetree WITH ; + Anchor = 15, ; + Height = 230, ; + Left = 0, ; + Name = "oTree", ; + TabIndex = 1, ; + Top = 0, ; + Width = 185 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="olecontrol" OLEObject="c:\windows\syswow64\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7///8EAAAA/v///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAALAa5apITM0BAwAAAIACAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAagAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAEQBAAAAAAAACAAAAAIAAAD+////BAAAAAUAAAAGAAAABwAAAAkAAAD+/////v////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////+2kEHHiYXREbFqAMDwKDYoIUM0EggAAAAfEwAAxRcAALE8wWoBAAYAIgAAAD0AAAAJAQAADAAAADEvwAAB782rXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAACADgAAAEhpZGVTZWxlY3Rpb24ABQAAAEwAAAAADAAAAEluZGVudGF0aW9uABEAAABODQAAAAcAAAAAAAAAAAAkQAoAAABMYWJlbEVkaXQACQAAAEkKAAAAAQAAAAoAAABMaW5lU3R5bGUACQAAAEkKAAAAAQAAAA0AAABNb3VzZVBvaW50ZXIACQAAAEkKAAAAAAAAAA4AAABQYXRoU2VwYXJhdG9yAAoAAABIAAAAAAEAAABcDAAAAE9MRURyYWdNb2RlAAkAAABJCgAAAAAAAAAMAAAAT0xFRHJvcE1vZGUACQAAAEkKAAAAAAAAAAsAAABBcHBlYXJhbmNlAAkAAABJCgAAAAAAAAAMAAAAQm9yZGVyU3R5bGUACQAAAEkKAAAAAQAAAAwAAABIb3RUcmFja2luZwAFAAAATAAABQAAMcAAAwAAAAAAAAAFAACAZOkYAAEAAABcAB/e7L0BAAUAqOkYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" /> + + ADD OBJECT 'pgfProperties' AS basepageframe WITH ; + Anchor = 13, ; + BorderWidth = 0, ; + ErasePage = .T., ; + Height = 232, ; + Left = 190, ; + Name = "pgfProperties", ; + PageCount = 2, ; + TabIndex = 3, ; + Tabs = .F., ; + Top = 0, ; + Width = 430, ; + Basepage1.Caption = "Basepage1", ; + Basepage1.Name = "Basepage1", ; + Basepage2.Caption = "Basepage2", ; + Basepage2.Name = "Basepage2" + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="pageframe" /> + + ADD OBJECT 'pgfProperties.Basepage1.Basecheckbox1' AS basecheckbox WITH ; + Alignment = 1, ; + Caption = "Show in Launcher", ; + Left = 5, ; + Name = "Basecheckbox1", ; + Top = 73, ; + Visible = .T. + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'pgfProperties.Basepage1.cmdAddCopiedMenu' AS basecommandbutton WITH ; + AutoSize = .F., ; + Caption = "Add Copied Menu", ; + Height = 24, ; + Left = 236, ; + Name = "cmdAddCopiedMenu", ; + TabIndex = 9, ; + Top = 187, ; + Width = 120 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'pgfProperties.Basepage1.cmdAddPopup' AS basecommandbutton WITH ; + AutoSize = .F., ; + Caption = "Add as Pop\ + + ADD OBJECT 'pgfProperties.Basepage1.cmdAddTopLevel' AS basecommandbutton WITH ; + AutoSize = .F., ; + Caption = "Add as Top Le\ + + ADD OBJECT 'pgfProperties.Basepage1.cmdCopyMenu' AS basecommandbutton WITH ; + AutoSize = .F., ; + Caption = "Copy Menu", ; + Height = 24, ; + Left = 236, ; + Name = "cmdCopyMenu", ; + TabIndex = 9, ; + Top = 162, ; + Width = 120 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'pgfProperties.Basepage1.cmdMoveDown' AS basecommandbutton WITH ; + Caption = "", ; + Height = 22, ; + Left = 288, ; + Name = "cmdMoveDown", ; + Picture = down.bmp, ; + TabIndex = 8, ; + Top = 109, ; + Width = 22 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'pgfProperties.Basepage1.cmdMoveUp' AS basecommandbutton WITH ; + Caption = "", ; + Height = 22, ; + Left = 288, ; + Name = "cmdMoveUp", ; + Picture = up.bmp, ; + TabIndex = 7, ; + Top = 89, ; + Width = 22 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'pgfProperties.Basepage1.cmdRemove' AS basecommandbutton WITH ; + Anchor = 0, ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'pgfProperties.Basepage1.edtStatusBarText' AS baseeditbox WITH ; + Height = 40, ; + IntegralHeight = .F., ; + Left = 70, ; + Name = "edtStatusBarText", ; + TabIndex = 4, ; + Top = 25, ; + Width = 355 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="editbox" /> + + ADD OBJECT 'pgfProperties.Basepage1.lblOrder' AS baselabel WITH ; + Caption = "Order", ; + Left = 248, ; + Name = "lblOrder", ; + TabIndex = 6, ; + Top = 102 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'pgfProperties.Basepage1.lblPrompt' AS baselabel WITH ; + Caption = "\ + + ADD OBJECT 'pgfProperties.Basepage1.lblStatusBarText' AS baselabel WITH ; + Caption = "\ + + ADD OBJECT 'pgfProperties.Basepage1.oHotKeyControls' AS hotkeycontrols WITH ; + calias = MenuDefinitions, ; + Left = 5, ; + Name = "oHotKeyControls", ; + TabIndex = 5, ; + Top = 98, ; + cmdClear.Name = "cmdClear", ; + cmdGetHotKey.Name = "cmdGetHotKey", ; + lblHotKey.Name = "lblHotKey", ; + txtHotKey.Name = "txtHotKey" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'pgfProperties.Basepage1.txtPrompt' AS basetextbox WITH ; + Height = 22, ; + Left = 70, ; + Name = "txtPrompt", ; + TabIndex = 2, ; + Top = 0, ; + Width = 355 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="textbox" /> + + ADD OBJECT 'pgfProperties.Basepage2.Baseeditbox1' AS baseeditbox WITH ; + Height = 40, ; + IntegralHeight = .F., ; + Left = 70, ; + Name = "Baseeditbox1", ; + TabIndex = 5, ; + Top = 68, ; + Width = 355, ; + ZOrderSet = 13 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="editbox" /> + + ADD OBJECT 'pgfProperties.Basepage2.Baselabel1' AS baselabel WITH ; + Caption = "Status bar", ; + Left = 5, ; + Name = "Baselabel1", ; + TabIndex = 4, ; + Top = 71, ; + ZOrderSet = 12 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'pgfProperties.Basepage2.cmdEditTool' AS edittoolbutton WITH ; + Left = 344, ; + Name = "cmdEditTool", ; + TabIndex = 10, ; + Top = 114, ; + ZOrderSet = 5 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'pgfProperties.Basepage2.cmdMoveDown' AS basecommandbutton WITH ; + Caption = "", ; + Height = 22, ; + Left = 70, ; + Name = "cmdMoveDown", ; + Picture = down.bmp, ; + TabIndex = 8, ; + Top = 134, ; + Width = 22, ; + ZOrderSet = 8 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'pgfProperties.Basepage2.cmdMoveUp' AS basecommandbutton WITH ; + Caption = "", ; + Height = 22, ; + Left = 70, ; + Name = "cmdMoveUp", ; + Picture = up.bmp, ; + TabIndex = 7, ; + Top = 113, ; + Width = 22, ; + ZOrderSet = 7 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'pgfProperties.Basepage2.cmdRemove' AS basecommandbutton WITH ; + Anchor = 0, ; + Caption = "\ + + ADD OBJECT 'pgfProperties.Basepage2.edtStatusBarText' AS baseeditbox WITH ; + DisabledForeColor = 0,0,0, ; + Enabled = .F., ; + Height = 40, ; + IntegralHeight = .F., ; + Left = 70, ; + Name = "edtStatusBarText", ; + TabIndex = 5, ; + Top = 26, ; + Width = 355, ; + ZOrderSet = 4 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="editbox" /> + + ADD OBJECT 'pgfProperties.Basepage2.lblOrder' AS baselabel WITH ; + Caption = "Order", ; + Left = 5, ; + Name = "lblOrder", ; + TabIndex = 6, ; + Top = 123, ; + ZOrderSet = 2 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'pgfProperties.Basepage2.lblStatusBarText' AS baselabel WITH ; + Caption = "Summary", ; + Left = 5, ; + Name = "lblStatusBarText", ; + TabIndex = 4, ; + Top = 29, ; + ZOrderSet = 3 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'pgfProperties.Basepage2.oFilter' AS filtercontrols WITH ; + ctarget = This.Parent.Parent.Parent.Parent, ; + Left = 200, ; + Name = "oFilter", ; + TabIndex = 9, ; + Top = -42, ; + ZOrderSet = 9, ; + lblFilter.Name = "lblFilter", ; + txtFilter.Name = "txtFilter" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'pgfProperties.Basepage2.oHotKeyControls' AS hotkeycontrols WITH ; + calias = ToolHotKeyAssignments, ; + Left = 128, ; + Name = "oHotKeyControls", ; + TabIndex = 5, ; + Top = 138, ; + ZOrderSet = 11, ; + cmdClear.Name = "cmdClear", ; + cmdGetHotKey.Name = "cmdGetHotKey", ; + lblHotKey.Name = "lblHotKey", ; + txtHotKey.Name = "txtHotKey" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'pgfProperties.Basepage2.oToolInfo' AS toolinfo WITH ; + calias = MenuTools, ; + Height = 57, ; + Left = 1, ; + Name = "oToolInfo", ; + TabIndex = 11, ; + Top = 170, ; + Width = 421, ; + ZOrderSet = 6, ; + edtToolInfo.BackStyle = 0, ; + edtToolInfo.Height = 64, ; + edtToolInfo.Left = 1, ; + edtToolInfo.Name = "edtToolInfo", ; + edtToolInfo.Top = -2, ; + edtToolInfo.Width = 418, ; + lblLink.Height = 18, ; + lblLink.Left = 1, ; + lblLink.Name = "lblLink", ; + lblLink.Top = 38, ; + lblLink.Width = 55, ; + lblVideo.Name = "lblVideo" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'pgfProperties.Basepage2.Selecttool1' AS selecttoolformenus WITH ; + BackStyle = 1, ; + Height = 24, ; + Left = 1, ; + Name = "Selecttool1", ; + nspaceabovetreeview = 30, ; + Top = 0, ; + Width = 424, ; + ZOrderSet = 0, ; + Baselabel1.Name = "Baselabel1", ; + cboCombo.Left = 69, ; + cboCombo.Name = "cboCombo", ; + cboCombo.Top = 0, ; + cboCombo.Width = 355, ; + cboCombo.ZOrderSet = 0, ; + cmdApply.Left = 325, ; + cmdApply.Name = "cmdApply", ; + cmdClear.Left = 380, ; + cmdClear.Name = "cmdClear", ; + lblPrompt1.Left = 3, ; + lblPrompt1.Name = "lblPrompt1", ; + oImageList.Height = 100, ; + oImageList.Left = 120, ; + oImageList.Name = "oImageList", ; + oImageList.Top = 40, ; + oImageList.Width = 100, ; + oImageList.ZOrderSet = 3, ; + oTree.Height = 174, ; + oTree.Left = 5, ; + oTree.Name = "oTree", ; + oTree.Top = 29, ; + oTree.Width = 166, ; + shpTreeView.Name = "shpTreeView", ; + shpTreeView.ZOrderSet = 2, ; + txtcNewFilter.Name = "txtcNewFilter", ; + txtcNewFilter.Width = 246 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + PROCEDURE addmenu && Adds a menu + *============================================================================== + * Method: AddMenu + * Purpose: Adds a menu + * Author: Doug Hennig + * Last revision: 03/22/2011 + * Parameters: none + * Returns: none + * Environment in: Thisform.oThor is a reference to a Thor_Engine object + * see Thor_Engine.AddMenu for other requirements + * Environment out: a menu was added (see Thor_Engine.AddMenu to changes) + * the new menu is added to the TreeView, selected, and + * focus set to the prompt text box + *============================================================================== + + local loNode, ; + llPopup, ; + lcPrompt, ; + lnID + + * See if we're in the Popup Menus section or the VFP System Menu section to + * decide what type of menu to create. + + loNode = This.oTree.SelectedItem + do while vartype(loNode.Parent) = 'O' + loNode = loNode.Parent + enddo while vartype(loNode.Parent) = 'O' + llPopup = loNode.Key == ccKEY_ROOT_POPUP_MENU + + * Add the menu, load it into the TreeView, select it, and set focus to the + * prompt textbox. + + lcPrompt = 'New Menu' + lnID = Thisform.oThor.AddMenu(lcPrompt, not llPopup, llPopup) + loNode = This.LoadNode(loNode.Key, lcPrompt, ccIMAGE_MENU, lnID) + This.SelectItem(loNode) + Thisform.SetFocusToFirstObject(This.pgfProperties.Pages[1]) + + ENDPROC + + PROCEDURE addsubmenu && Adds a submenu to the selected menu + *============================================================================== + * Method: AddSubMenu + * Purpose: Adds a submenu to the selected menu + * Author: Doug Hennig + * Last revision: 03/22/2011 + * Parameters: none + * Returns: none + * Environment in: Thisform.oThor is a reference to a Thor_Engine object + * see Thor_Engine.AddSubMenu for other requirements + * Environment out: a menu was added (see Thor_Engine.AddSubMenu for changes) + * the new menu is added to the TreeView, selected, and + * focus set to the prompt text box + *============================================================================== + + local loNode, ; + lcKey, ; + lnMenuID, ; + lcPrompt, ; + lnID + with This + + * Get the currently selected node. If it's an item, get the parent menu. + + loNode = .oTree.SelectedItem + lcKey = .GetItemKey(loNode) + if left(lcKey, 1) = ccKEY_TOOL + loNode = loNode.Parent + endif left(lcKey, 1) = ccKEY_TOOL + lcKey = .GetItemKey(loNode) + lnMenuID = val(substr(lcKey, 2)) + + * Add a record for the new menu. + + lcPrompt = 'New Menu' + lnID = Thisform.oThor.AddSubMenu(lnMenuID, , lcPrompt) + + * Get the key for the new item, then reload the TreeView in case the menu this + * item belongs to appears in more than one place. + + lcKey = loNode.Key + ccKEY_SEPARATOR + ccKEY_MENU + transform(lnID) + .LoadTree(.T.) + + * Select the newly added node and set focus to the first control in the Items + * page. + + .SelectItem(lcKey) + Thisform.SetFocusToFirstObject(.pgfProperties.Pages[1]) + endwith + + ENDPROC + + PROCEDURE addtool && Adds a tool to the selected item + *============================================================================== + * Method: AddTool + * Purpose: Adds a tool to the selected menu + * Author: Doug Hennig + * Last revision: 03/23/2011 + * Parameters: tlSeparator - .T. if this is a separator + * Returns: none + * Environment in: Thisform.oThor is a reference to a Thor_Engine object + * see Thor_Engine.AddItemToMenu for other requirements + * Environment out: an item was added to the menu (see + * Thor_Engine.AddItemToMenu for other changes) + * the new menu is added to the TreeView, selected, and + * focus set to the prompt text box + *============================================================================== + + lparameters tlSeparator + local loNode, ; + lcKey, ; + lnMenuID, ; + loTool, ; + lcPRGName, ; + lcPrompt, ; + lcStatusBarText, ; + lnID + with This + + * Get the currently selected node. If it's another item, get the parent menu. + + loNode = .oTree.SelectedItem + lcKey = .GetItemKey(loNode) + if left(lcKey, 1) = ccKEY_TOOL + loNode = loNode.Parent + endif left(lcKey, 1) = ccKEY_TOOL + lcKey = .GetItemKey(loNode) + lnMenuID = val(substr(lcKey, 2)) + + * If we're adding a tool, use the first one as a default. + + if not tlSeparator + loTool = This.oLastToolSelected + If Type('loTool') # 'O' + loTool = Thisform.oTools.Item(1) + Thisform.oTools.Keysort = 2 + For each loToolX in Thisform.oTools + If loToolX.Source # 'Thor' + loTool = loToolX + Exit + Endif loToolX.Source # 'Thor' + Endfor + EndIf + + *!* * Removed 2/28/2012 + *!* lcPRGName = loTool.PRGName + *!* lcPrompt = loTool.Prompt + *!* lcStatusBarText = evl(loTool.StatusBarText, loTool.Description) + lcPRGName = '' + lcPrompt = '' + lcStatusBarText = '' + endif not tlSeparator + + * Add the item, get the key for it, then reload the TreeView in case the menu + * this item belongs to appears in more than one place. + + lnID = Thisform.oThor.AddItemToMenu(lnMenuID, lcPRGName, lcPrompt, ; + tlSeparator, , lcStatusBarText) + lcKey = loNode.Key + ccKEY_SEPARATOR + ccKEY_TOOL + transform(lnID) + .LoadTree(.T.) + + * Select the newly added node and set focus to the first control in the Items + * page. + + .SelectItem(lcKey) + Thisform.SetFocusToFirstObject(.pgfProperties.Pages[2]) + ThisForm.oSelectTool.CloseControl() + ThisForm.oSelectTool.OpenControl() + endwith + + ENDPROC + + PROCEDURE createtool && Creates a template PRG for a tool + *============================================================================== + * Method: CreateTool + * Purpose: Creates a template PRG for a tool + * Author: Doug Hennig + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 04/18/2011 / JRN + * Parameters: none + * Returns: none + * Environment in: _System.vcx exists in the VFP FFC folder + * Environment out: a PRG specified by the user is created with template code. + *============================================================================== + + Local lcCD, lcCode, lcFile, loFile, loPEME_Tools, loThorInfo + + **************************************************************** + lcFolder = Thisform.oTools.Tag + Do Form CreateTool with lcFolder to lcFile + If Empty(lcFile) + Return + EndIf + + **************************************************************** + + *!* lcCD = Sys(5) + Curdir() + *!* loFile = Newobject ('_ComDlg', Home() + 'FFC\_System.vcx') + *!* loFile.AddFilter ('Program file (*.prg)', '*.prg') + *!* loFile.lSaveDialog = .T. + *!* loFile.cInitialDirectory = Thisform.oTools.Tag + *!* loFile.ShowDialog() + *!* Cd (lcCD) + *!* lcFile = Addbs (loFile.cFilePath) + loFile.cFileTitle + + Do Case + Case Empty (lcFile) + Case Upper (JustStem(lcFile)) # Upper(ccTOOLNAMEPREFIX) + Messagebox (ccTOOL_PREFIX_ERROR, MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + Case File (lcFile) + Messagebox (Strtran (ccALREADY_EXISTS, '%1', lcFile), ; + MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + Otherwise + *** JRN 2011-04-18 : Get sample code for new PRG from ThorInfo + loThorInfo = Newobject ('ThorInfo', 'Thor_Utils') + lcCode = loThorInfo.GetSampleToolCode() + Strtofile (lcCode, lcFile) + Modify Command (lcFile) Nowait + *** JRN 2011-05-05 : Move / resize window + loPEME_Tools = Execscript (_Screen.cThorDispatcher, 'class= tools from pemeditor') + If 'O' = Vartype (loPEME_Tools) + loPEME_Tools.AddMRUFile (lcFile) + _oPEMEditor.oUtils.oIDEx.MoveWindow() + Endif + + Endcase + + ENDPROC + + PROCEDURE getitemkey && Gets the item key from the specified node key + *============================================================================== + * Method: GetItemKey + * Purpose: Gets the item key from the specified node key + * Author: Doug Hennig + * Last revision: 03/19/2011 + * Parameters: toNode - the node to get the item key from + * Returns: the item key + * Environment in: none + * Environment out: none + * Note: Keys are stored as a path. For example, for the Display UI + * item (tool ID 4) in the Thor submenu (menu ID 8) of the + * Tools menu (menu ID 6), the key is VFP\M6\M8\T4. This + * method returns T4 in that case + *============================================================================== + + lparameters toNode + + If 'O' # Vartype(toNode) + Return '' + EndIf + + lcKey = toNode.Key + lnPos = rat(ccKEY_SEPARATOR, lcKey) + if lnPos > 0 + lcKey = substr(lcKey, lnPos + 1) + endif lnPos > 0 + return lcKey + + ENDPROC + + PROCEDURE Init + * Load the ImageList and associate it with the TreeView. + + With This.oImageList + .ListImages.Add(1, ccIMAGE_MENU, LoadPicture('Menus.ico')) + .ListImages.Add(2, ccIMAGE_TOOL, LoadPicture('Programs.ico')) + .ListImages.Add(3, ccIMAGE_POPUP, LoadPicture('Popup.ico')) + Endwith + This.oTree.Object.ImageList = This.oImageList + DoDefault() + + ENDPROC + + PROCEDURE loadchildnodes && Loads the submenus of the specified menu + *============================================================================== + * Method: LoadChildNodes + * Purpose: Loads the submenus of the specified menu + * Author: Doug Hennig + * Last revision: 03/24/2011 + * Parameters: tnID - the ID for the menu item to load submenus for + * Returns: none + * Environment in: MenuTools is open and is ordered by SortOrder + * Environment out: nodes for the submenus and tools have been loaded into the + * TreeView + *============================================================================== + + lparameters tnID, ; + tcParentKey + local lnSelect, ; + loNode, ; + lnRecno, ; + lcPrompt + lnSelect = select() + select MenuTools + scan for MenuID = tnID + do case + case SubMenuID = 0 + + * This is a tool or separator, so add it under the menu. + + if Separator + lcPrompt = ccSEPARATOR_PROMPT + else + If not Empty(PRGName) + lcPrompt = trim(Prompt) + Else + lcPrompt = ccNoToolSelected + EndIf + = seek(upper(PRGName), 'ToolHotKeyAssignments', 'PRGName') + if seek(ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + lcPrompt = lcPrompt + ' (' + ; + trim(HotKeyDefinitions.Descript) + ')' + EndIf + endif Separator + This.LoadNode(tcParentKey, lcPrompt, ccIMAGE_TOOL, ID) + + * If this is a submenu, find the menu's record, add a node under the menu we're + * we're working on, and process all child nodes. + + case seek(MenuTools.SubMenuID, 'MenuDefinitions', 'ID') + = seek(MenuTools.SubMenuID, 'MenuDefinitions', 'ID') + lcPrompt = trim(MenuDefinitions.Prompt) + if seek(MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + lcPrompt = lcPrompt + ' (' + ; + trim(HotKeyDefinitions.Descript) + ')' + endif seek(MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + loNode = This.LoadNode(tcParentKey, lcPrompt, ; + ccIMAGE_MENU, SubMenuID) + lnRecno = recno() + This.LoadChildNodes(SubMenuID, loNode.Key) + go lnRecno + endcase + endscan for MenuID = tnID + select (lnSelect) + return + + ENDPROC + + PROCEDURE loadnode && Loads a node in the TreeView + *============================================================================== + * Method: LoadNode + * Purpose: Loads a node in the TreeView + * Author: Doug Hennig + * Last revision: 03/19/2011 + * Parameters: tcParentKey - the key of the parent node to add this under + * tcPrompt - the text for the node + * tcIcon - the icon for the node + * tnID - the ID of the record the node represents + * Returns: a reference to the node + * Environment in: none + * Environment out: a node was added to the TreeView + *============================================================================== + + lparameters tcParentKey, ; + tcPrompt, ; + tcIcon, ; + tnID + local lcKey, ; + loNode + lcKey = tcParentKey + ccKEY_SEPARATOR + left(tcIcon, 1) + transform(tnID) + loNode = This.oTree.Nodes.Add(tcParentKey, cnCHILD_NODE, lcKey, tcPrompt, ; + tcIcon) + return loNode + + ENDPROC + + PROCEDURE loadtree && Loads the TreeView control with defined menus + *============================================================================== + * Method: LoadTree + * Purpose: Loads the TreeView control with menus and the tools in them + * Author: Doug Hennig + * Last revision: 03/20/2011 + * Parameters: none + * Returns: none + * Environment in: MenuDefinitions and MenuTools are open + * Environment out: MenuDefinitions and MenuTools are both ordered on SortOrder + * the TreeView is loaded with menu and tool nodes + *============================================================================== + + lparameters tlReload + local loTree, ; + laNodes[1], ; + lnI, ; + loNode, ; + lcSelectedNode, ; + lnRecno1, ; + lnRecno2, ; + lnRecno, ; + lcPrompt, ; + lcKey, ; + lnPos + with This + loTree = .oTree + + * If we're reloading the TreeView, preserve the expanded status of nodes and + * the selected node, then clear the TreeView. + + if tlReload + loTree.SaveExpandedNodes() + lnRecno1 = recno('MenuDefinitions') + lnRecno2 = recno('MenuTools') + endif tlReload + + * Load the menu categories as root nodes. + + loNode = loTree.Nodes.Add(, 0, ccKEY_ROOT_SYSTEM_MENU, ccVFP_SYSTEM_MENU, ; + ccIMAGE_MENU) + loNode.Expanded = .T. + loNode.Bold = .T. + + loNode = loTree.Nodes.Add(, 0, ccKEY_ROOT_POPUP_MENU, ccPOPUP_MENUS, ; + ccIMAGE_POPUP) + loNode.Expanded = .T. + loNode.Sorted = .T. + loNode.Bold = .T. + + * Go through the defined menus and add them and their tools to the TreeView. + + set order to SortOrder in MenuTools + * First, correct existing SortOrder in MenuDefinitions + * (there may be holes, or duplicates) + select MenuDefinitions + set order to + replace all SortOrder with SortOrder + 1000 for TopLevel + set order to SortOrder + lnSortOrder = 0 + Scan for TopLevel + lnSortOrder = lnSortOrder + 1 + Replace SortOrder with lnSortOrder + EndScan + + scan + + * Add internal and user-defined top level menus under the VFP System Menu node, + * then process all submenus and tools. + + if TopLevel + lcPrompt = trim(Prompt) + if seek(MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + lcPrompt = lcPrompt + ' (' + ; + trim(HotKeyDefinitions.Descript) + ')' + endif seek(MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + loNode = .LoadNode(ccKEY_ROOT_SYSTEM_MENU, lcPrompt, ; + ccIMAGE_MENU, ID) + + If not Trim(PopupName) == 'Thor_Internal' and not Trim(PopupName) == ccRunAllTools + lnRecno = recno() + .LoadChildNodes(ID, loNode.Key) + go lnRecno + EndIf + endif TopLevel + + * If this is a popup menu (it could be both a top level and popup menu), add a + * node under Popup Menus and process all submenus and tools. + + if Popup and not Internal + lcPrompt = trim(Prompt) + if seek(MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + lcPrompt = lcPrompt + ' (' + ; + trim(HotKeyDefinitions.Descript) + ')' + endif seek(MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + loNode = .LoadNode(ccKEY_ROOT_POPUP_MENU, lcPrompt, ; + ccIMAGE_MENU, ID) + lnRecno = recno() + .LoadChildNodes(ID, loNode.Key) + go lnRecno + endif Popup ... + endscan for TopLevel + + * If we reloaded the TreeView, reexpanded formerly expanded nodes, reselect the + * former node, and restore the saved record pointers. Otherwise, select the + * first node. + + if tlReload + loNode = loTree.RestoreExpandedNodes() + If vartype(loNode) = 'O' + .Selectitem(loNode) + EndIf + if between(lnRecno1, 1, reccount('MenuDefinitions')) + go lnRecno1 in MenuDefinitions + endif between(lnRecno1 ... + if between(lnRecno2, 1, reccount('MenuTools')) + go lnRecno2 in MenuTools + endif between(lnRecno2... + else + .SelectItem(loTree.Nodes(1)) + endif tlReload + endwith + + ENDPROC + + PROCEDURE moveitem && Moves the selected item + *============================================================================== + * Method: MoveItem + * Purpose: Moves the selected item + * Author: Doug Hennig + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 03/24/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + lparameters tnAmount + with This + + * Get the currently selected node and its parent. + + loNode = .oTree.SelectedItem + lcKey = .GetItemKey(loNode) + loParent = loNode.Parent + lnSelect = select() + + * For a top-level menu, swap this item and the one above or below it. + + if loParent.Key == ccKEY_ROOT_SYSTEM_MENU + select MenuDefinitions + lnSortOrder = SortOrder + lnRecno = recno() + locate for TopLevel and SortOrder = lnSortOrder + tnAmount + replace SortOrder with SortOrder - tnAmount + go lnRecno + replace SortOrder with SortOrder + tnAmount + + * For a submenu or tool, swap this item and the one above or below it + * in the same menu. + + else + lcKey = .GetItemKey(loParent) + lnMenuID = val(substr(lcKey, 2)) + + * Swap this item and the one above or below it. + + select MenuTools + lnSortOrder = SortOrder + lnRecno = recno() + locate for MenuID = lnMenuID and SortOrder = lnSortOrder + tnAmount + replace SortOrder with SortOrder - tnAmount + go lnRecno + replace SortOrder with SortOrder + tnAmount + endif loParent.Key == ccKEY_ROOT_SYSTEM_MENU + select (lnSelect) + + * Reload the TreeView. + + .LoadTree(.T.) + endwith + + ENDPROC + + PROCEDURE removemenuoritem && Removes the selected menu or item + *============================================================================== + * Method: RemoveMenuOrItem + * Purpose: Removes the selected menu or item + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: none + * Returns: none + * Environment in: Thisform.oThor is a reference to a Thor_Engine object + * Environment out: the menu or item was removed and the TreeView node removed + * This.nCopyMenuID is 0 if the menu removed was the copied + * one + *============================================================================== + + local loTree, ; + loNode, ; + lcKey, ; + lcItemKey, ; + lnID, ; + llItem, ; + llRemoveTopLevel, ; + llRemovePopup, ; + llRemoveSubMenu, ; + lcMessage + with This + loTree = .oTree + loNode = loTree.SelectedItem + lcKey = loNode.Key + lcItemKey = .GetItemKey(loNode) + lnID = val(substr(lcItemKey, 2)) + llItem = left(lcItemKey, 1) = ccKEY_TOOL + + * If this is a menu, see where it's being used and where we're removing it + * from. + + do case + case llItem + case loNode.Parent.Key == ccKEY_ROOT_SYSTEM_MENU + llRemoveTopLevel = .T. + case loNode.Parent.Key == ccKEY_ROOT_POPUP_MENU + llRemovePopup = .T. + otherwise + llRemoveSubMenu = .T. + endcase + + * See if we're supposed to remove the item. If so, remove the item or menu. + + lcMessage = iif(llItem, ccREMOVE_ITEM, ccREMOVE_MENU) + llRemove = messagebox(lcMessage, MB_YESNO + MB_ICONQUESTION, ; + ccTHOR_CAPTION) = IDYES + do case + case not llRemove + case llItem + Thisform.oThor.RemoveItemFromMenu(lnID) + otherwise + Thisform.oThor.RemoveMenu(lnID, llRemoveTopLevel, llRemovePopup, ; + llRemoveSubMenu) + endcase + + * If we removed the item, remove the node and update the form for the new + * selected item. + + if llRemove + loTree.Nodes.Remove(lcKey) + .SelectItem(loTree.SelectedItem) + endif llRemove + + * If we removed the copied menu, zero nCopyMenuID. + + if lnID = .nCopyMenuID + .nCopyMenuID = 0 + .Refresh() + endif lnID = .nCopyMenuID + endwith + + ENDPROC + + PROCEDURE selectitem && Called when the user selects an item in the TreeView + *============================================================================== + * Method: SelectItem + * Purpose: Called when the user selects an item in the TreeView + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: tuNode - the node selected or the key for the node + * Returns: none + * Environment in: none + * Environment out: the specified node is selected in the TreeView + * the appropriate page in pgfProperties is selected + * the controls are refreshed + * MenuDefinitions, MenuTools, and HotKeyDefinitions may have + * been positioned to the appropriate records + *============================================================================== + + lparameters tuNode + local loNode, ; + lcKey, ; + lcType, ; + lnID + with This + + * If a key was passed instead of a node, get it. + + do case + case vartype(tuNode) = 'O' + loNode = tuNode + case type('.oTree.Nodes.Item(tuNode)') = 'O' + loNode = .oTree.Nodes.Item(tuNode) + otherwise + loNode = .NULL. + endcase + + * If we have a node, select it and handle the type of node it is. + + if vartype(loNode) = 'O' + .oTree.SelectedItem = loNode + loNode.EnsureVisible() + lcKey = .GetItemKey(loNode) + lcType = substr(lcKey, 1) + lnID = val(substr(lcKey, 2)) + do case + case lcKey = ccKEY_ROOT_SYSTEM_MENU or ; + lcKey = ccKEY_ROOT_POPUP_MENU + .pgfProperties.Visible = .F. + case lcType = ccKEY_MENU + = seek(lnID, 'MenuDefinitions', 'ID') + = seek(lnID, 'MenuTools', 'SubMenuID') + = seek(MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + .pgfProperties.Visible = .T. + .pgfProperties.ActivePage = 1 + otherwise + = seek(lnID, 'MenuTools', 'ID') + = seek(upper(MenuTools.PRGName), 'ToolHotKeyAssignments', 'PRGName') + = seek(ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + .pgfProperties.Visible = .T. + .pgfProperties.ActivePage = 2 + If Empty(MenuTools.PrgName) + .pgfProperties.BasePage2.Selecttool1.OpenControl() + EndIf + endcase + .Refresh() + endif vartype(loNode) = 'O' + endwith + + ENDPROC + + PROCEDURE UIEnable + lparameters tlEnable + if tlEnable and This.oTree.Nodes.Count = 0 + This.LoadTree() + endif tlEnable ... + + ENDPROC + + PROCEDURE cmdAddMenu.Click + This.Parent.AddMenu() + + ENDPROC + + PROCEDURE cmdAddMenu.Init + This.Caption = ccADD_MENU + dodefault() + + ENDPROC + + PROCEDURE cmdAddMenu.Refresh + * See if we're in the Popup Menus section or the VFP System Menu section to + * decide what ToolTipText to use. + + local loNode, ; + llPopup + loNode = This.Parent.oTree.SelectedItem + do while vartype(loNode.Parent) = 'O' + loNode = loNode.Parent + enddo while vartype(loNode.Parent) = 'O' + llPopup = loNode.Key == ccKEY_ROOT_POPUP_MENU + if llPopup + This.ToolTipText = ccTT_ADD_MENU_POPUP + else + This.ToolTipText = ccTT_ADD_MENU_VFP + endif llPopup + + ENDPROC + + PROCEDURE cmdAddSeparator.Click + This.Parent.AddTool(.T.) + + ENDPROC + + PROCEDURE cmdAddSeparator.Init + This.Caption = ccADD_SEPARATOR + dodefault() + + ENDPROC + + PROCEDURE cmdAddSeparator.Refresh + * This isn't available for the root nodes. + + local lcKey + with This.Parent + lcKey = .GetItemKey(.oTree.SelectedItem) + This.Enabled = Thisform.NotThorInternalMenu() and not inlist(lcKey, ccKEY_ROOT_SYSTEM_MENU, ; + ccKEY_ROOT_POPUP_MENU) + + * Get the currently selected node. If it's another item, get the parent menu. + * We use that to decide what tooltip to use. + + loNode = .oTree.SelectedItem + lcKey = .GetItemKey(loNode) + if left(lcKey, 1) = ccKEY_TOOL + loNode = loNode.Parent + endif left(lcKey, 1) = ccKEY_TOOL + This.ToolTipText = strtran(ccTT_ADD_SEPARATOR, '%1', loNode.Text) + endwith + + ENDPROC + + PROCEDURE cmdAddSubMenu.Click + This.Parent.AddSubMenu() + + ENDPROC + + PROCEDURE cmdAddSubMenu.Init + This.Caption = ccADD_SUBMENU + dodefault() + + ENDPROC + + PROCEDURE cmdAddSubMenu.Refresh + * This isn't available for the root nodes. + + local lcKey, ; + loNode + with This.Parent + lcKey = .GetItemKey(.oTree.SelectedItem) + This.Enabled = Thisform.NotThorInternalMenu() and not inlist(lcKey, ccKEY_ROOT_SYSTEM_MENU, ; + ccKEY_ROOT_POPUP_MENU) + + * Get the currently selected node. If it's another item, get the parent menu. + * We use that to decide what tooltip to use. + + loNode = .oTree.SelectedItem + lcKey = .GetItemKey(loNode) + if left(lcKey, 1) = ccKEY_TOOL + loNode = loNode.Parent + endif left(lcKey, 1) = ccKEY_TOOL + This.ToolTipText = strtran(ccTT_ADD_SUBMENU, '%1', loNode.Text) + endwith + + ENDPROC + + PROCEDURE cmdAddTool.Click + This.Parent.AddTool() + + ENDPROC + + PROCEDURE cmdAddTool.Init + This.Caption = ccADD_TOOL + dodefault() + + ENDPROC + + PROCEDURE cmdAddTool.Refresh + * This isn't available for the root nodes. + + local lcKey, ; + loNode + with This.Parent + lcKey = .GetItemKey(.oTree.SelectedItem) + This.Enabled = Thisform.NotThorInternalMenu() and not inlist(lcKey, ccKEY_ROOT_SYSTEM_MENU, ccKEY_ROOT_POPUP_MENU) + + * Get the currently selected node. If it's another item, get the parent menu. + * We use that to decide what tooltip to use. + + loNode = .oTree.SelectedItem + lcKey = .GetItemKey(loNode) + if left(lcKey, 1) = ccKEY_TOOL + loNode = loNode.Parent + endif left(lcKey, 1) = ccKEY_TOOL + This.ToolTipText = strtran(ccTT_ADD_TOOL, '%1', loNode.Text) + endwith + + ENDPROC + + PROCEDURE oTree.DblClick + * If the selected item is a tool, edit it on a double-click. + + local lcKey, ; + lcType + lcKey = This.Parent.GetItemKey(This.SelectedItem) + lcType = substr(lcKey, 1) + if lcType = ccKEY_TOOL + Thisform.EditTool(trim(MenuTools.PRGName)) + endif lcType = ccKEY_TOOL + + ENDPROC + + PROCEDURE oTree.Init + This.Font.Size = 10 + + ENDPROC + + PROCEDURE oTree.NodeClick + lparameters toNode + This.Parent.SelectItem(toNode) + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.Basecheckbox1.Refresh + This.Enabled = MenuDefinitions.Popup and not MenuDefinitions.Internal + This.Value = MenuDefinitions.Launcher + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.Basecheckbox1.Valid + Replace Launcher With This.Value In MenuDefinitions + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdAddCopiedMenu.Click + with This.Parent.Parent.Parent + Thisform.oThor.AddSubMenu(MenuDefinitions.ID, .nCopyMenuID) + .LoadTree(.T.) + .oTree.SelectedItem.Expanded = .T. + endwith + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdAddCopiedMenu.Init + This.Caption = ccADD_COPIED_MENU + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdAddCopiedMenu.Refresh + local lnID + lnID = This.Parent.Parent.Parent.nCopyMenuID + This.Enabled = lnID <> 0 and MenuDefinitions.ID <> lnID + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdAddPopup.Click + replace MenuDefinitions.Popup with .T. + This.Parent.Parent.Parent.LoadTree(.T.) + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdAddPopup.Init + This.Caption = ccADD_AS_POPUP + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdAddPopup.Refresh + This.Enabled = Thisform.NotThorInternalMenu() and not MenuDefinitions.Internal and not MenuDefinitions.Popup + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdAddTopLevel.Click + local lnSelect, ; + lnRecno + lnSelect = select() + select MenuDefinitions + lnRecno = recno() + calculate max(SortOrder) to lnMax for TopLevel + if between(lnRecno, 1, reccount()) + go lnRecno + endif between(lnRecno, 1, reccount()) + replace MenuDefinitions.TopLevel with .T., SortOrder with lnMax + 1 + This.Parent.Parent.Parent.LoadTree(.T.) + select (lnSelect) + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdAddTopLevel.Init + This.Caption = ccADD_AS_TOP_LEVEL + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdAddTopLevel.Refresh + This.Enabled = not MenuDefinitions.Internal and not MenuDefinitions.TopLevel + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdCopyMenu.Click + This.Parent.Parent.Parent.nCopyMenuID = MenuDefinitions.ID + This.Parent.Refresh() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdCopyMenu.Init + This.Caption = ccCOPY_MENU + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdCopyMenu.Refresh + This.Enabled = Thisform.NotThorInternalMenu() and not MenuDefinitions.Internal + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdMoveDown.Click + This.Parent.Parent.Parent.MoveItem(1) + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdMoveDown.Init + * At runtime, move the controls so they overlap with hotkey controls, since + * they're mutually exclusive. + + This.Left = This.Parent.txtPrompt.Left + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdMoveDown.Refresh + * This isn't allowed for popup menus or internal menus, or if we're already at + * the last one. + + local loNode, ; + loParent, ; + laOrder[1], ; + lcKey, ; + lnMenuID + with This.Parent.Parent.Parent + loNode = .oTree.SelectedItem + This.Visible = not MenuDefinitions.Internal and ; + vartype(loNode.Parent) = 'O' and ; + not loNode.Parent.Key == ccKEY_ROOT_POPUP_MENU + if This.Visible + loParent = loNode.Parent + if loParent.Key == ccKEY_ROOT_SYSTEM_MENU + select max(SortOrder) from MenuDefinitions where TopLevel ; + into array laOrder + else + lcKey = .GetItemKey(loNode.Parent) + lnMenuID = val(substr(lcKey, 2)) + select max(SortOrder) from MenuTools where MenuID = lnMenuID ; + into array laOrder + endif loParent.Key == ccKEY_ROOT_SYSTEM_MENU + This.Enabled = MenuTools.SortOrder < Nvl(Evl(laOrder[1],0), 0) + endif This.Visible + endwith + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdMoveUp.Click + This.Parent.Parent.Parent.MoveItem(-1) + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdMoveUp.Init + * At runtime, move the controls so they overlap with hotkey controls, since + * they're mutually exclusive. + + This.Left = This.Parent.txtPrompt.Left + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdMoveUp.Refresh + * This isn't allowed for popup menus or internal menus, or if we're already at + * 1. + + local loNode, ; + loParent, ; + lnOrder + with This.Parent.Parent.Parent + loNode = .oTree.SelectedItem + This.Visible = not MenuDefinitions.Internal and ; + vartype(loNode.Parent) = 'O' and ; + not loNode.Parent.Key == ccKEY_ROOT_POPUP_MENU + if This.Visible + loParent = loNode.Parent + if loParent.Key == ccKEY_ROOT_SYSTEM_MENU + lnOrder = MenuDefinitions.SortOrder + else + lnOrder = MenuTools.SortOrder + endif loParent.Key == ccKEY_ROOT_SYSTEM_MENU + This.Enabled = lnOrder > 1 + endif This.Visible + endwith + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdRemove.Click + Local loParent + loParent = This.Parent.Parent.Parent + loParent.RemoveMenuOrItem() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdRemove.Init + This.Caption = ccREMOVEMENU + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.cmdRemove.Refresh + * We can only remove user-defined menus or items. + + local lcKey, ; + lcType, ; + loParent + loParent = This.Parent.Parent.Parent + lcKey = loParent.GetItemKey(loParent.oTree.SelectedItem) + lcType = left(lcKey, 1) + This.Enabled = Thisform.NotThorInternalMenu() and (lcType = ccKEY_MENU and not MenuDefinitions.Internal) or ; + lcType = ccKEY_TOOL + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.edtStatusBarText.KeyPress + Lparameters tnKeyCode, tnShiftAltCtrl + + Do Case + Case tnKeyCode = 13 + Nodefault + Endcase + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.edtStatusBarText.Refresh + This.Value = MenuDefinitions.StatusBar + This.Enabled = not MenuDefinitions.Internal + This.Height = 40 + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.edtStatusBarText.Valid + replace StatusBar with trim(This.Value) in MenuDefinitions + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.lblOrder.Init + * At runtime, move the controls so they overlap with hotkey controls, since + * they're mutually exclusive. + + This.Left = This.Parent.lblPrompt.Left + This.Caption = ccORDER + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.lblOrder.Refresh + * SortOrder isn't allowed for popup menus or internal menus. + + local loNode + loNode = This.Parent.Parent.Parent.oTree.SelectedItem + This.Visible = not MenuDefinitions.Internal and ; + vartype(loNode.Parent) = 'O' and ; + not loNode.Parent.Key == ccKEY_ROOT_POPUP_MENU + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.lblPrompt.Init + This.Caption = ccPROMPT + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.lblPrompt.Refresh + This.Enabled = not MenuDefinitions.Internal + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.lblStatusBarText.Init + This.Caption = ccSTATUS_BAR + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.lblStatusBarText.Refresh + This.Enabled = not MenuDefinitions.Internal + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.oHotKeyControls.cmdClear.Refresh + This.enabled = Seek (MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.oHotKeyControls.onclearhotkey + * Update the text of the selected node in the TreeView. + + This.Parent.Parent.Parent.oTree.SelectedItem.Text = trim(MenuDefinitions.Prompt) + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.oHotKeyControls.onkeypressed + * Update the text of the selected node in the TreeView. + + This.Parent.Parent.Parent.oTree.SelectedItem.Text = trim(MenuDefinitions.Prompt) + ; + ' (' + trim(HotKeyDefinitions.Descript) + ')' + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.oHotKeyControls.Refresh + * Hotkeys are only allowed for popup menus and only if we're currently on the + * popup node. + + Local loTree + loTree = This.Parent.Parent.Parent.oTree + This.Visible = MenuDefinitions.Popup And ; + vartype (loTree.SelectedItem.Parent) = 'O' And ; + loTree.SelectedItem.Parent.Key == ccKEY_ROOT_POPUP_MENU + DoDefault() + + If Seek (MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + This.txtHotKey.Value = Trim (HotKeyDefinitions.Descript) + Else + This.txtHotKey.Value = '' + Endif Seek (MenuDefinitions.HotKeyID, 'HotKeyDefinitions', 'ID') + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.txtPrompt.Refresh + This.Value = Trim (MenuDefinitions.Prompt) + This.Enabled = Not MenuDefinitions.Internal + + ENDPROC + + PROCEDURE pgfProperties.Basepage1.txtPrompt.Valid + * If the user changes the value, we need to reload the TreeView in case it + * appears in multiple places. + + local lcValue + lcValue = trim(This.Value) + do case + case empty(lcValue) + messagebox(ccBLANK_PROMPT, MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + This.Value = This.cOnEntryValue + return 0 + case not lcValue == trim(This.cOnEntryValue) + replace Prompt with lcValue in MenuDefinitions + replace Prompt with lcValue in MenuTools ; + for SubMenuID = MenuDefinitions.ID + This.Parent.Parent.Parent.LoadTree(.T.) + endcase + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.Baseeditbox1.KeyPress + Lparameters tnKeyCode, tnShiftAltCtrl + + Do Case + Case tnKeyCode = 13 + Nodefault + Endcase + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.Baseeditbox1.Refresh + Local lcPRGName + lcPRGName = Trim (Evaluate ('MenuTools.PRGName')) + If Thisform.oTools.GetKey (Upper (lcPRGName)) # 0 + This.Value = MenuTools.StatusBar + This.Enabled = Not MenuTools.Separator + Else + This.Value = '' + This.Enabled = .F. + Endif + + This.Height = 40 + ENDPROC + + PROCEDURE pgfProperties.Basepage2.Baseeditbox1.Valid + replace StatusBar with trim(This.Value) in MenuTools + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.cmdEditTool.Refresh + Local lcPRGName, lnKey, loTool + + lcPRGName = Trim (MenuTools.PRGName) + lnKey = Thisform.oTools.GetKey (Upper (Alltrim (lcPRGName))) + + If lnKey > 0 + loTool = Thisform.oTools (lnKey) + This.cPRGName = loTool.FullFileName + This.Enabled = .T. + Else + This.Enabled = .F. + Endif + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.cmdMoveDown.Click + This.Parent.Parent.Parent.MoveItem(1) + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.cmdMoveDown.Refresh + * This isn't allowed if we're already at the last one. + + local loParent, ; + lcKey, ; + lnMenuID, ; + laOrder[1] + with This.Parent.Parent.Parent + loParent = .oTree.SelectedItem.Parent + lcKey = .GetItemKey(loParent) + lnMenuID = val(substr(lcKey, 2)) + select max(SortOrder) from MenuTools where MenuID = lnMenuID into array laOrder + This.Enabled = MenuTools.SortOrder < Nvl(Evl(laOrder[1],0), 0) + endwith + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.cmdMoveUp.Click + This.Parent.Parent.Parent.MoveItem(-1) + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.cmdMoveUp.Refresh + * This isn't allowed if we're already at 1. + + This.Enabled = MenuTools.SortOrder > 1 + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.cmdRemove.Click + Local loParent + loParent = This.Parent.Parent.Parent + loParent.RemoveMenuOrItem() + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.cmdRemove.Init + This.Caption = ccREMOVETool + dodefault() + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.cmdRemove.Refresh + * We can only remove user-defined menus or items. + + local lcKey, ; + lcType, ; + loParent + loParent = This.Parent.Parent.Parent + lcKey = loParent.GetItemKey(loParent.oTree.SelectedItem) + lcType = left(lcKey, 1) + This.Enabled = (lcType = ccKEY_MENU and not MenuDefinitions.Internal) or ; + lcType = ccKEY_TOOL + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.edtStatusBarText.KeyPress + Lparameters tnKeyCode, tnShiftAltCtrl + + Do Case + Case tnKeyCode = 13 + Nodefault + Endcase + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.edtStatusBarText.Refresh + Local lcPRGName, loTool + lcPRGName = Trim (Evaluate ('MenuTools.PRGName')) + If Not Empty (lcPRGName) and 0 # Thisform.oTools.GetKey (Upper (lcPRGName)) + loTool = Thisform.oTools.Item (Upper (lcPRGName)) + This.Value = loTool.Summary + Else + This.Value = '' + Endif + + *This.Enabled = not MenuTools.Separator + This.Height = 40 + ENDPROC + + PROCEDURE pgfProperties.Basepage2.edtStatusBarText.Valid + replace StatusBar with trim(This.Value) in MenuTools + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.oHotKeyControls.cmdClear.Refresh + This.enabled = Seek (ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.oHotKeyControls.onclearhotkey + * Update the text of the selected node in the TreeView. + + This.Parent.Parent.Parent.oTree.SelectedItem.Text = trim(MenuTools.Prompt) + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.oHotKeyControls.onkeypressed + * Update the text of the selected node in the TreeView. + + This.Parent.Parent.Parent.oTree.SelectedItem.Text = trim(MenuTools.Prompt) + ; + ' (' + trim(HotKeyDefinitions.Descript) + ')' + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.oHotKeyControls.onpreupdate + * Add a record to ToolHotKeyAssignments if necessary. + + local lcPRGName + lcPRGName = Trim(MenuTools.PrgName) + Thisform.oThor.AddToolHotKey(lcPRGName) + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.oHotKeyControls.Refresh + * Hotkeys are only allowed for popup menus and only if we're currently on the + * popup node. + + Local lcPRGName + DoDefault() + + lcPRGName = Trim (Evaluate ('MenuTools.PRGName')) + If Thisform.oTools.GetKey (Upper (lcPRGName)) # 0 + This.Visible = .T. + If Seek (ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + This.txtHotKey.Value = Trim (HotKeyDefinitions.Descript) + Else + This.txtHotKey.Value = '' + Endif Seek (ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + Else + This.Visible = .F. + Endif + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.Selecttool1.cboCombo.Refresh + Local lcPRGName + If Not Empty (MenuTools.PRGName) + lcPRGName = Trim (Evaluate ('MenuTools.PRGName')) + This.Enabled = Thisform.oTools.GetKey (Upper (lcPRGName)) # 0 And Not MenuTools.Separator + Else + This.Enabled = .F. + Endif + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.Selecttool1.Init + DoDefault() + Thisform.oSelectTool = This + + ENDPROC + + PROCEDURE pgfProperties.Basepage2.Selecttool1.Refresh + Local lcKey + DoDefault() + + If Empty (MenuTools.PRGName) + This.cboCombo.DisplayValue = ccSelectFromTreeView + Try + lcKey = This.otree.SelectedItem.Key + Catch + lcKey = '' + EndTry + If '\' $ lcKey + This.otree.SelectedItem = This.otree.nodes (Left (lcKey, Rat ('\', lcKey) - 1)) + Endif + Endif + ENDPROC + +ENDDEFINE + +DEFINE CLASS presskeyprompt AS form + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="lblPress" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblEsc" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Baselabel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Baselabel2" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *p: oform && A reference to the calling form + *p: _memberdata && XML Metadata for customizable properties + * + + BorderStyle = 2 + Caption = "Form" + DoCreate = .T. + Height = 124 + Left = 0 + Name = "presskeyprompt" + oform = .NULL. && A reference to the calling form + TitleBar = 0 + Top = 0 + Width = 200 + _memberdata = + + && XML Metadata for customizable properties + + ADD OBJECT 'Baselabel1' AS baselabel WITH ; + Caption = "Or press [Esc] to cancel", ; + Height = 15, ; + Left = 18, ; + Name = "Baselabel1", ; + TabIndex = 1, ; + Top = -24, ; + Width = 116 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'Baselabel2' AS baselabel WITH ; + AutoSize = .F., ; + Caption = "You may use any number of [Shift], [Ctrl] and [Alt]", ; + Height = 52, ; + Left = 18, ; + Name = "Baselabel2", ; + Top = 64, ; + Width = 156, ; + WordWrap = .T. + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'lblEsc' AS baselabel WITH ; + Caption = "Or press [Esc] to cancel", ; + Height = 18, ; + Left = 18, ; + Name = "lblEsc", ; + TabIndex = 1, ; + Top = 40, ; + Width = 139 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'lblPress' AS baselabel WITH ; + Caption = "Press the desired hotkey ...", ; + Height = 18, ; + Left = 18, ; + Name = "lblPress", ; + TabIndex = 1, ; + Top = 16, ; + Width = 158 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + PROCEDURE Init + * Center the form in the current screen. + + lparameters tnFontSize + + with This + + .SetAll('FontSize', tnFontSize) + .lblPress.Left = (This.Width - .lblPress.Width) / 2 + .lblEsc.Left = (This.Width - .lblEsc.Width) / 2 + + lnRow = Mrow('',3) + lnCol = Mcol('',3) + + .Top = lnRow - Min(This.Height, 60) / 2 + .Left = lnCol - This.Width / 2 + + endwith + + ENDPROC + + PROCEDURE Baselabel1.Init + This.Caption = ccCANCEL_HOTKEY + dodefault() + + ENDPROC + + PROCEDURE lblEsc.Init + This.Caption = ccCANCEL_HOTKEY + dodefault() + + ENDPROC + + PROCEDURE lblPress.Init + This.Caption = ccPRESS_HOTKEY + dodefault() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS presskeypromptokl AS presskeyprompt OF "thor_ui.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + DoCreate = .T. + Height = 124 + Left = 0 + Name = "presskeypromptokl" + Top = 0 + Width = 200 + Baselabel1.Name = "Baselabel1" + Baselabel2.Caption = "For this tool, you may use only one of [Shift], [Ctrl] or [Alt]" + Baselabel2.ForeColor = 255,0,0 + Baselabel2.Name = "Baselabel2" + lblEsc.Name = "lblEsc" + lblEsc.Top = 40 + lblPress.Name = "lblPress" + lblPress.Top = 16 + +ENDDEFINE + +DEFINE CLASS selecttool AS sfcombotree OF "thor_sfcombotree.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Baselabel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblPrompt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdApply" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdClear" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtcNewFilter" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: addpemeditortools + *m: applyfilter + *p: cfilter + *p: cnewfilter + * + + cfilter = + cnewfilter = + Height = 54 + lcloseonclick = .T. + Name = "selecttool" + Width = 250 + _memberdata = + + + + + cboCombo.Anchor = 11 + cboCombo.Height = 24 + cboCombo.Left = 69 + cboCombo.Name = "cboCombo" + cboCombo.Style = 0 + cboCombo.Top = 0 + cboCombo.Width = 176 + cboCombo.ZOrderSet = 0 + oImageList.Height = 100 + oImageList.Left = 120 + oImageList.Name = "oImageList" + oImageList.Top = 84 + oImageList.Width = 100 + oImageList.ZOrderSet = 5 + oTree.Height = 174 + oTree.Left = 5 + oTree.Name = "oTree" + oTree.Top = 73 + oTree.Width = 166 + oTree.ZOrderSet = 3 + shpTreeView.Left = 0 + shpTreeView.Name = "shpTreeView" + shpTreeView.Top = 69 + shpTreeView.ZOrderSet = 4 + + ADD OBJECT 'Baselabel1' AS baselabel WITH ; + Caption = "Filter", ; + Left = 6, ; + Name = "Baselabel1", ; + TabIndex = 2, ; + Top = 32, ; + ZOrderSet = 1 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'cmdApply' AS basecommandbutton WITH ; + Anchor = 8, ; + AutoSize = .T., ; + Caption = "Apply", ; + FontSize = 9, ; + Height = 25, ; + Left = 146, ; + Name = "cmdApply", ; + Top = 27, ; + Width = 48, ; + ZOrderSet = 6 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdClear' AS basecommandbutton WITH ; + Anchor = 8, ; + AutoSize = .T., ; + Caption = "Clear", ; + FontSize = 9, ; + Height = 25, ; + Left = 201, ; + Name = "cmdClear", ; + Top = 27, ; + Width = 44, ; + ZOrderSet = 7 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'lblPrompt1' AS baselabel WITH ; + Caption = "Prompt", ; + Left = 6, ; + Name = "lblPrompt1", ; + TabIndex = 2, ; + Top = 3, ; + ZOrderSet = 2 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'txtcNewFilter' AS basetextbox WITH ; + Anchor = 11, ; + ControlSource = "This.Parent.cNewFilter", ; + Height = 24, ; + Left = 69, ; + Name = "txtcNewFilter", ; + Top = 28, ; + Width = 70, ; + ZOrderSet = 8 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="textbox" /> + + PROCEDURE addpemeditortools + Lparameters lcParentKey, lnMenuID, raTools + + Local laMenuTools[1], lcFilter, lcHotKey, lcKey, lcKeystroke, lcMenuStatusBar, lcPRGName, lcPrompt + Local lcStatusBar, llSeparator, lnI, lnID, lnIndex, lnSubMenuID, loNode + + lcFilter = Upper (This.cFilter) + + Select MenuTools.Prompt ; + , Separator ; + , SubMenuID ; + , PRGName ; + , MenuTools.Id ; + From MenuTools ; + Left Join MenuDefinitions ; + On SubMenuID = MenuDefinitions.Id ; + Where MenuID = lnMenuID ; + Order By MenuTools.sortorder ; + Into Array laMenuTools + + For lnI = 1 To _Tally + lcPrompt = Alltrim (laMenuTools (lnI, 1)) + llSeparator = laMenuTools (lnI, 2) + lnSubMenuID = laMenuTools (lnI, 3) + lcPRGName = Alltrim (laMenuTools (lnI, 4)) + lnID = laMenuTools (lnI, 5) + + Do Case + Case llSeparator + * loNode = This.oTree.Nodes.Add (lcParentKey, 4, lcParentKey + '\' + Str (lnID), Replicate('-', 30)) + Case lnSubMenuID # 0 + lcKey = lcParentKey + '\' + Chrtran (lcPrompt, '/\', '__') + loNode = This.oTree.Nodes.Add (lcParentKey, 4, lcKey, lcPrompt, ccIMAGE_MENU) + This.AddPEMEditorTools (lcKey, lnSubMenuID, @raTools) + loNode.Expanded = Not Empty (lcFilter) + Otherwise + If Empty (lcFilter) Or 0 # Ascan (raTools, lcPRGName, 6, -1, -1, 15) + lcKey = lcParentKey + '\' + Str (lnID) + = Seek (Upper (lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + lcHotKey = Thisform.GetHotKeyDescription (ToolHotKeyAssignments.HotKeyID) + loNode = This.oTree.Nodes.Add (lcParentKey, 4, lcKey, ; + lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_TOOL) + lnIndex = Thisform.oTools.GetKey (Upper (lcPRGName)) + If lnIndex > 0 + loNode.Tag = Thisform.oTools (lnIndex) + Endif + Endif + Endcase + Endfor + + If This.oTree.Nodes (lcParentKey).Children = 0 + This.oTree.Nodes.Remove (lcParentKey) + Endif + + ENDPROC + + PROCEDURE applyfilter + Thisform.lRefreshSelectToolTreeView = .T. + With This + .cFilter = .cNewfilter + .Refresh() + Endwith + + ENDPROC + + PROCEDURE loadtree + Local laPrev[1], laThis[1], laTools[1], lcCategory, lcFilter, lcHotKey, lcKey, lcPRGName + Local lcParentKey, lcPrev, lcPreviousCategory, lcPrompt, lcSortKey, lcSource, lcSubCategory, lcThis + Local lnI, lnJ, lnK, lnMax1, lnMax2, lnSort, lnStart, lnToolCount, loNode, loTool, loTools + + loTools = Thisform.oTools + lnToolCount = 0 + + This.oTree.Object.ImageList = Thisform.oImageList + lcFilter = Upper (This.cFilter) + + Do While lnToolCount = 0 + For lnI = 1 To loTools.Count + loTool = loTools.Item (lnI) + lcSource = Evl (Trim (loTool.Source), '(No Source)') + lcCategory = Evl (Trim (loTool.Category), lcSource) + lcSubCategory = Trim (loTool.SubCategory) + lnSort = Evl(loTool.Sort, 9999) + lcSortKey = loTool.InternalSort + lcPRGName = loTool.PRGName + + If (Empty (lcFilter)) ; + Or lcFilter $ Upper (lcSortKey + lcSource + loTool.Summary + loTool.Description) + lnToolCount = lnToolCount + 1 + Dimension laTools (lnToolCount, 6) + laTools (lnToolCount, 1) = lnI + laTools (lnToolCount, 2) = lcSource + laTools (lnToolCount, 3) = lcCategory + laTools (lnToolCount, 4) = lcSubCategory + laTools (lnToolCount, 5) = lcSortKey + laTools (lnToolCount, 6) = lcPRGName + Endif + Endfor + If lnToolCount = 0 + Messagebox ([No matches to '] + lcFilter + [' found. Showing all tools.], 16) + lcFilter = '' + Endif + Enddo && while lnToolCount = 0 + + Asort (laTools, 5) + lcPreviousCategory = '' + + For lnI = 1 To lnToolCount + + loTool = loTools.Item (laTools (lnI, 1)) + lcSource = laTools (lnI, 2) + lcCategory = laTools (lnI, 3) + + *!* * Removed 2/3/2012 + *!* If lcSource == 'Thor' + *!* Loop + *!* Endif + + If Not lcCategory == lcPreviousCategory + lnMax1 = Alines (laPrev, lcPreviousCategory, 5, '|') + lnMax2 = Alines (laThis, lcCategory, 5, '|') + If lnI = 1 + lnJ = 1 + Else + lnStart = 1 + Min (lnMax1, lnMax2) + lcKey = '' + For lnJ = 1 To Min (lnMax1, lnMax2) + lcPrev = laPrev[lnJ] + lcThis = laThis[lnJ] + If Not Upper (lcPrev) == Upper (lcThis) + lnStart = lnJ + Exit + Endif + lcKey = Upper (lcKey + Iif (lnJ > 1, '\', '') + lcThis) + Endfor + Endif + For lnK = lnJ To lnMax2 + If lnK = 1 + lcKey = Upper (laThis[1]) + loNode = This.oTree.Nodes.Add (, 1, lcKey, laThis[1], ccIMAGE_MENU) + loNode.Expanded = Not Empty (lcFilter) + loNode.Bold = .T. + Else + lcParentKey = Upper (lcKey) + lcKey = Upper (lcParentKey + '\' + Chrtran (laThis[lnK], '.,;\/', '-----')) + loNode = This.oTree.Nodes.Add (lcParentKey, 4, lcKey, laThis[lnK], ccIMAGE_MENU) + loNode.Expanded = Not Empty (lcFilter) + Endif + Endfor + Endif + + lcPrompt = loTool.Prompt + lcPRGName = loTool.PRGName + = Seek (Upper (lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + lcHotKey = Thisform.GetHotKeyDescription (ToolHotKeyAssignments.HotKeyID) + loNode = This.oTree.Nodes.Add (lcKey, 4, lcKey + '\' + lcPRGName ; + , lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_TOOL) + loNode.Tag = loTool + + lcPreviousCategory = lcCategory + + Endfor && lnI = 1 To lnToolCount + + + + ENDPROC + + PROCEDURE opencontrol + This.cNewFilter = This.cFilter + DoDefault() + + ENDPROC + + PROCEDURE Refresh + Local lcAlias, lcKey, lcPRGName, lcPrompt, loNode, loTool + + lcAlias = 'MenuTools' + lcPRGName = Trim (Evaluate (lcAlias + '.PRGName')) + lcPrompt = Trim (Evaluate (lcAlias + '.Prompt')) + + With This.oTree + Do Case + Case .Nodes.Count = 0 + This.LoadTree() + Case Thisform.lRefreshSelectToolTreeView + This.oTree.SaveExpandedNodes() + This.LoadTree() + If Empty(This.cFilter) + This.oTree.RestoreExpandedNodes() + EndIf + Thisform.lRefreshSelectToolTreeView = .F. + Endcase + + For Each loNode In .Nodes + If 'O' = Type ('loNode.Tag') ; + And Upper (lcPRGName) == Upper (loNode.Tag.PRGName) + .SelectedItem = loNode + loNode.EnsureVisible() + + lcKey = loNode.Key + Do While Not Empty (Justpath (lcKey)) + lcKey = Justpath (lcKey) + .Nodes (lcKey).Expanded = .T. + Enddo While Not Empty Justpath (lcKey) + Endif Upper (lcPRGName) == Upper (loNode.Tag) + Endfor Each loNode In .oTree.Nodes + Endwith && This.oTree + + If Empty (lcPrompt) + For Each loTool In Thisform.oTools + If Upper (lcPRGName) == Upper (loTool.PRGName) + lcPrompt = loTool.Prompt && loTool.Source + ': ' + Evl (loTool.Summary, loTool.Description) + Endif + Next loTool + Endif + This.cboCombo.DisplayValue = lcPrompt + This.cboCombo.AddProperty('cOnEntryValue', lcPrompt) + + + ENDPROC + + PROCEDURE Baselabel1.Refresh + This.Enabled = not MenuTools.Separator + + ENDPROC + + PROCEDURE cboCombo.Valid + * If the user changes the value, we need to reload the TreeView in case it + * appears in multiple places. + + local lcValue + lcValue = trim(This.DisplayValue) + do case + case empty(lcValue) + messagebox(ccBLANK_PROMPT, MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + This.DisplayValue = This.cOnEntryValue + return 0 + case not lcValue == trim(This.cOnEntryValue) + replace Prompt with lcValue in MenuTools + This.Parent.Parent.Parent.Parent.LoadTree(.T.) + endcase + + ENDPROC + + PROCEDURE cmdApply.Click + This.Parent.ApplyFilter() + + ENDPROC + + PROCEDURE cmdApply.Refresh + This.Enabled = Not This.Parent.cFilter == This.Parent.cNewFilter + * This.Visible = .F. + + ENDPROC + + PROCEDURE cmdClear.Click + Thisform.lRefreshSelectToolTreeView = .T. + With This.Parent + .cFilter = '' + .cNewfilter = '' + .Refresh() + Endwith + + ENDPROC + + PROCEDURE lblPrompt1.Refresh + This.Enabled = not MenuTools.Separator + + ENDPROC + + PROCEDURE oTree.NodeClick + *** ActiveX Control Event *** + LPARAMETERS node + + If 'O' = Type('node.tag') + DoDefault(node) + EndIf + + ENDPROC + + PROCEDURE txtcNewFilter.InteractiveChange + DoDefault() + This.Parent.cNewFilter = This.Value + This.Parent.cmdApply.Refresh() + This.Parent.cmdClear.Refresh() + * This.Parent.ApplyFilter() + ENDPROC + + PROCEDURE txtcNewFilter.KeyPress + lparameters tnKeyCode, tnShiftAltCtrl + + If tnKeyCode = 13 and tnShiftAltCtrl = 0 + This.Parent.cNewFilter = This.Value + This.Parent.ApplyFilter() + NoDefault + Else + DoDefault(tnKeyCode, tnShiftAltCtrl) + EndIf + + ENDPROC + +ENDDEFINE + +DEFINE CLASS selecttoolforbrowsing AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Baselabel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtcNewFilter" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="oTree" UniqueID="" Timestamp="" /> + + * + *m: applyfilter + *m: reloadtree + *m: selectitem + *p: cfilter + *p: cnewfilter + * + + Anchor = 15 + BackColor = 255,255,255 + BackStyle = 1 + cfilter = + cnewfilter = + Height = 95 + Name = "selecttoolforbrowsing" + Width = 260 + _memberdata = + + + + + + + + + ADD OBJECT 'Baselabel1' AS baselabel WITH ; + Caption = "Filter", ; + Left = 7, ; + Name = "Baselabel1", ; + TabIndex = 2, ; + Top = 5, ; + ZOrderSet = 1 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'oTree' AS basetree WITH ; + Anchor = 15, ; + Height = 63, ; + Left = 1, ; + Name = "oTree", ; + TabIndex = 1, ; + Top = 30, ; + Width = 257 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="olecontrol" OLEObject="c:\windows\syswow64\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7///8EAAAA/v///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAPDlFQ+h880BAwAAAIACAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAagAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAEQBAAAAAAAACAAAAAIAAAD+////BAAAAAUAAAAGAAAABwAAAAkAAAD+/////v////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////+2kEHHiYXREbFqAMDwKDYoIUM0EggAAACQGgAAgwYAALE8wWoBAAYAIgAAAD0AAAAJAQAADAAAAAEAAAAB782rXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAACADgAAAEhpZGVTZWxlY3Rpb24ABQAAAEwAAAAADAAAAEluZGVudGF0aW9uABEAAABODQAAAAcAAAAAAAAAAAAkQAoAAABMYWJlbEVkaXQACQAAAEkKAAAAAQAAAAoAAABMaW5lU3R5bGUACQAAAEkKAAAAAQAAAA0AAABNb3VzZVBvaW50ZXIACQAAAEkKAAAAAAAAAA4AAABQYXRoU2VwYXJhdG9yAAoAAABIAAAAAAEAAABcDAAAAE9MRURyYWdNb2RlAAkAAABJCgAAAAAAAAAMAAAAT0xFRHJvcE1vZGUACQAAAEkKAAAAAAAAAAsAAABBcHBlYXJhbmNlAAkAAABJCgAAAAAAAAAMAAAAQm9yZGVyU3R5bGUACQAAAEkKAAAAAQAAAAwAAABIb3RUcmFja2luZwAFAAAATAAABQBIw2oKAwAAAAAAAAAFAACAYOkYAAEAAABcAB/e7L0BAAUAqOkYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" /> + + ADD OBJECT 'txtcNewFilter' AS basetextbox WITH ; + Anchor = 11, ; + ControlSource = "This.Parent.cNewFilter", ; + Height = 22, ; + Left = 45, ; + Name = "txtcNewFilter", ; + Top = 1, ; + Width = 106 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="textbox" /> + + PROCEDURE applyfilter + Thisform.lRefreshSelectToolTreeView = .T. + With This + .cFilter = .cNewfilter + .Refresh() + Endwith + + ENDPROC + + PROCEDURE Refresh + Local llVisible + This.oTree.Object.ImageList = Thisform.oImageList + + This.ReLoadTree() + + llVisible = This.oTree.Visible + This.oTree.Visible = Not llVisible + This.oTree.Visible = llVisible + + ENDPROC + + PROCEDURE reloadtree + Local lcKey, loNode + + LockWindow(.T.) + Try + loNode = This.oTree.SelectedItem() + lcKey = loNode.Key + loNode = .Null. + Catch + lcKey = '' + Endtry + + This.oTree.Font.Size = Thisform.nFontSize + Thisform.LoadTree (This.oTree, This.cFilter) + + If Not Empty (lcKey) + Try + This.oTree.Nodes (lcKey).Selected = .T. + This.oTree.Nodes (lcKey).EnsureVisible () + Catch + + Endtry + Endif + + LockWindow(.F.) + + ENDPROC + + PROCEDURE selectitem + *============================================================================== + * Method: SelectItem + * Purpose: Selects the specified item in the ListView + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: tuItem - a node or a node key + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tuItem + + Local lcPRGName, loItem + loItem = tuItem.Tag + With This.Parent + This.Parent.SelectItem (loItem) + Endwith + + ENDPROC + + PROCEDURE oTree.DblClick + * If the selected item is a tool, edit it on a double-click. + + If Not Empty (This.Parent.Parent.cPRGName) + Thisform.EditTool (This.Parent.Parent.cPRGName) + Endif + + ENDPROC + + PROCEDURE oTree.Init + This.Font.Size = 10 + + ENDPROC + + PROCEDURE oTree.NodeClick + lparameters toNode + This.Parent.SelectItem(toNode) + + ENDPROC + + PROCEDURE txtcNewFilter.InteractiveChange + DoDefault() + This.Parent.cNewFilter = This.Value + + This.Parent.cFilter = This.Value + This.Parent.ReLoadTree() + + *!* * Removed 6/21/2012 / JRN + *!* This.Parent.cmdApply.Refresh() + *!* This.Parent.cmdClear.Refresh() + + ENDPROC + + PROCEDURE txtcNewFilter.KeyPress + lparameters tnKeyCode, tnShiftAltCtrl + + If tnKeyCode = 13 and tnShiftAltCtrl = 0 + This.Parent.ApplyFilter() + NoDefault + Else + DoDefault(tnKeyCode, tnShiftAltCtrl) + EndIf + + ENDPROC + +ENDDEFINE + +DEFINE CLASS selecttoolforlauncher AS selecttoolforbrowsing OF "thor_ui.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor_ui.h" + Height = 172 + Name = "selecttoolforlauncher" + Width = 200 + Baselabel1.Left = 3 + Baselabel1.Name = "Baselabel1" + Baselabel1.Top = 7 + oTree.Height = 143 + oTree.Left = 1 + oTree.Name = "oTree" + oTree.Top = 28 + oTree.Width = 197 + txtcNewFilter.Left = 40 + txtcNewFilter.Name = "txtcNewFilter" + txtcNewFilter.Top = 3 + txtcNewFilter.Width = 129 + + PROCEDURE Baselabel1.RightClick + Thisform.ResetAllDefaults() + + ENDPROC + + PROCEDURE oTree.DblClick + * If the selected item is a tool, run it on a double-click. + + If (Not Empty (This.Parent.Parent.Parent.Parent.Parent.cPRGName)) and not Thisform.lHideRightSide + Thisform.RunTool (This.Parent.Parent.Parent.Parent.Parent.oTool.FullFileName) + Endif + + ENDPROC + + PROCEDURE oTree.KeyPress + *** ActiveX Control Event *** + Lparameters keyascii + + * If the selected item is a tool, run it on a double-click. + + If keyascii = 13 And ; + Not Empty (This.Parent.Parent.Parent.Parent.Parent.cPRGName) + Thisform.RunTool (This.Parent.Parent.Parent.Parent.Parent.oTool.FullFileName) + Endif + + ENDPROC + + PROCEDURE oTree.NodeCheck + *** ActiveX Control Event *** + LPARAMETERS node + + ENDPROC + + PROCEDURE oTree.NodeClick + *** ActiveX Control Event *** + LPARAMETERS node + + DoDefault(node) + If (Not Empty (This.Parent.Parent.Parent.Parent.Parent.cPRGName)) and Thisform.lHideRightSide + Thisform.RunTool (This.Parent.Parent.Parent.Parent.Parent.oTool.FullFileName) + Endif + + ENDPROC + +ENDDEFINE + +DEFINE CLASS selecttoolformenus AS selecttool OF "thor_ui.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + Name = "selecttoolformenus" + Baselabel1.Name = "Baselabel1" + cboCombo.Name = "cboCombo" + cmdApply.Name = "cmdApply" + cmdClear.Name = "cmdClear" + lblPrompt1.Name = "lblPrompt1" + oImageList.Height = 100 + oImageList.Left = 120 + oImageList.Name = "oImageList" + oImageList.Top = 84 + oImageList.Width = 100 + oTree.Height = 174 + oTree.Left = 5 + oTree.Name = "oTree" + oTree.Top = 73 + oTree.Width = 166 + shpTreeView.Name = "shpTreeView" + txtcNewFilter.Name = "txtcNewFilter" + + PROCEDURE itemselected + * When the user selects a tool, update the tables; we need to reload the + * TreeView in case it's used in multiple places. + + Local lcPRGName, lcPrompt, lcStatusBarText, loNode, loTool + With This + loNode = .oTree.SelectedItem() + If 'O' = Type ('loNode.Tag') + loTool = loNode.Tag + lcPRGName = loTool.PRGName + lcPrompt = loTool.Prompt + lcStatusBarText = loTool.StatusBarText + + Replace PRGName With lcPRGName ; + Prompt With lcPrompt, ; + StatusBar With lcStatusBarText ; + In MenuTools + + .Parent.Parent.Parent.LoadTree (.T.) + .Parent.Refresh() + .Parent.Parent.Parent.oLastToolSelected = loTool + Endif + Endwith + + ENDPROC + +ENDDEFINE + +DEFINE CLASS sethotkeyform AS baseform OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Hotkeycontrols1" UniqueID="" Timestamp="" /> + + * + *m: executecommand + *p: othor + * + + DataSession = 1 + DoCreate = .T. + Height = 31 + lsavesettings = .F. + Name = "sethotkeyform" + othor = .NULL. + TitleBar = 0 + Visible = .T. + Width = 180 + _memberdata = + + + + + ADD OBJECT 'Hotkeycontrols1' AS hotkeycontrols WITH ; + Left = 0, ; + Name = "Hotkeycontrols1", ; + Top = 0, ; + cmdClear.Name = "cmdClear", ; + cmdGetHotKey.Name = "cmdGetHotKey", ; + lblHotKey.Name = "lblHotKey", ; + txtHotKey.Name = "txtHotKey" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + PROCEDURE executecommand + Lparameters lcAlias, lcCommand + + This.Hotkeycontrols1.cAlias = lcAlias + + Do Case + Case Empty(lcCommand) + + Case lcCommand = 'Set' + This.Hotkeycontrols1.StartHotKey() + + Case lcCommand = 'Clear' + This.Hotkeycontrols1.ClearHotKey() + + Endcase + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS startuptools AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="gridKeys" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColPrompt.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColPrompt.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColDescription.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColDescription.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColumnCheckBox.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gridKeys.ColumnCheckBox.check1" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: createcursor + *m: griddoubleclick + *m: loadlist + *m: setdescriptionwidth + *m: setgridorder + *m: togglestartupbit + *p: ignorenextloadlist + * + + Anchor = 15 + Height = 212 + ignorenextloadlist = .F. + Name = "startuptools" + Width = 332 + _memberdata = + + + + + + + + ADD OBJECT 'gridKeys' AS basegrid WITH ; + Anchor = 15, ; + ColumnCount = 3, ; + DeleteMark = .F., ; + GridLineColor = 192,192,192, ; + Height = 200, ; + Left = 6, ; + Name = "gridKeys", ; + Panel = 1, ; + RecordMark = .F., ; + RecordSource = "crsr_StartUps", ; + Top = 6, ; + Width = 320, ; + Column1.ControlSource = "", ; + Column1.Name = "ColPrompt", ; + Column1.ReadOnly = .T., ; + Column1.Width = 200, ; + Column2.ControlSource = "", ; + Column2.Name = "ColDescription", ; + Column2.ReadOnly = .T., ; + Column2.Width = 350, ; + Column3.Alignment = 2, ; + Column3.Name = "ColumnCheckBox", ; + Column3.ReadOnly = .F., ; + Column3.Sparse = .F. + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="grid" /> + + ADD OBJECT 'gridKeys.ColDescription.Header1' AS header WITH ; + Caption = "Description", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gridKeys.ColDescription.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'gridKeys.ColPrompt.Header1' AS header WITH ; + Caption = "Tool", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gridKeys.ColPrompt.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'gridKeys.ColumnCheckBox.check1' AS checkbox WITH ; + Alignment = 0, ; + Caption = "", ; + Centered = .T., ; + Name = "check1", ; + ReadOnly = .F. + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'gridKeys.ColumnCheckBox.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Startup?", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + PROCEDURE createcursor + Lparameters lcCursorName + + If Not Used(lcCursorName) + Create Cursor (lcCursorName) ( ; + Prompt C (100), ; + Description C (200), ; + StartUpTmp L, ; + PRGName C (60), ; + InternalSort C (100), ; + CanRunAtStartUp L, ; + PrivateCop N(4), ; + MissingPRG L ; + ) + Index On InternalSort Tag Order + Else + Select (lcCursorName) + Zap + Endif + + + + + ENDPROC + + PROCEDURE griddoubleclick + ENDPROC + + PROCEDURE loadlist + Local lnI, loTool, loTools + + This.CreateCursor ('crsr_StartUps') + Set Relation To Upper(PRGName) Into StartupTools + + loTools = Thisform.oTools + + For lnI = 1 To loTools.Count + loTool = loTools.Item (lnI) + Insert Into crsr_StartUps ; + (PRGName, Prompt, Description, InternalSort, CanRunAtStartup) ; + Values ; + (Justfname(loTool.FullFileName), ; + loTool.Prompt, ; + Evl(loTool.Description, loTool.Prompt), ; + loTool.InternalSort, ; + loTool.CanRunAtStartup And ( ; + Pemstatus(loTool, 'CanRunAtStartUp', 0) ; + Or Not Upper(Evl(loTool.Category, loTool.Source)) == 'THOR')) + Endfor + + Insert Into crsr_StartUps ; + (PRGName, Prompt, Description, InternalSort, MissingPRG) ; + Select PRGName, ; + PRGName, ; + '<' + Trim(PRGName) + '> not found', ; + 'ZZZ', ; + .T. ; + From StartupTools ; + Where Startup ; + And Not Upper(PRGName) In (Select Upper(PRGName) ; + From crsr_StartUps) + + Replace All StartupTmp With StartupTools.Startup + Delete For Not (StartupTmp Or CanRunAtStartup) + Goto Top + + ENDPROC + + PROCEDURE setdescriptionwidth + ENDPROC + + PROCEDURE setgridorder + ENDPROC + + PROCEDURE togglestartupbit + If empty(StartUpTools.Id) + Insert Into StartUpTools (PrgName, StartUp) Values (crsr_StartUps.PrgName, .T.) + Else + Replace StartUp With Not StartUp In StartUpTools + Endif + + DoDefault() + + ENDPROC + + PROCEDURE gridKeys.ColDescription.Header1.Click + This.Parent.Parent.Parent.SetGridOrder('Descript') + + ENDPROC + + PROCEDURE gridKeys.ColPrompt.Header1.Click + This.Parent.Parent.Parent.SetGridOrder('Source') + + ENDPROC + + PROCEDURE gridKeys.Init + Local lnI + With This + + .SetAll('DynamicForeColor', 'IIF(MissingPRG, Rgb(255,0,0), Rgb(0,0,0))') + .SetAll('DynamicBackColor', 'IIF(CanRunAtStartUp or MissingPRG, Rgb(255,255,255), Rgb(192,192,192))') + .SetAll('DynamicFontBold', 'StartUpTmp') + BindEvent(This.ColumnCheckBox.check1, 'Valid', This.Parent, 'ToggleStartUpBit') + + .Parent.CreateCursor ('crsr_StartUps') + .FontName = Thisform.FontName + .FontSize = 8 + + Endwith + + ENDPROC + + PROCEDURE gridKeys.RightClick + Local loContextMenu As 'contextmenu' Of 'Thor_menu' + Local loForm As 'SetHotKeyForm' Of 'Thor_UI.vcx' + Local lcAction, lcAlias, lnID, lnType + + lnType = crsr_GridKeys.Type + lnID = crsr_GridKeys.Id + Do Case + Case lnType = 1 + lcAlias = 'MenuDefinitions' + Case lnType = 2 + lcAlias = 'ToolHotKeyAssignments' + Otherwise + Return + Endcase + + If Seek (lnID, lcAlias, 'ID') + This.Parent.IgnoreNextLoadList = .T. + loContextMenu = Newobject ('contextmenu', 'Thor_menu', Thisform.cThorFolder + 'Thor.App') + + With loContextMenu + .AddMenuItem ('Set hot key', , , , , 'Set') + .AddMenuItem() + .AddMenuItem ('Clear hot key', , , , , 'Clear') + If .Activate() + lcAction = .Parameters + + loForm = Newobject ('SetHotKeyForm', 'Thor_UI.vcx', '') + loForm.oThor = Thisform.oThor + loForm.ExecuteCommand (lcAlias, lcAction) + loForm.Release() + loForm = .Null. + Endif + Endwith + This.Parent.IgnoreNextLoadList = .F. + This.Parent.LoadList() + Endif + + ENDPROC + + PROCEDURE gridKeys.UIEnable + LPARAMETERS lEnable + + If lEnable + This.SetFocus() + EndIf + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thor_tree AS basetree OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="olecontrol" Timestamp="" Scale="Pixels" Uniqueid="" Nombre="thor_tree" Parent="" ObjName="thor_tree" OLEObject="C:\WINDOWS\system32\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAALB2m5UpOMwBAwAAAEABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAagAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAAQAAAAAAAAABAAAAAIAAAD+/////v////7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////+2kEHHiYXREbFqAMDwKDYoIUM0EggAAABWCgAAVgoAALE8wWoBAAYAIgAAANwAXADoAwAASAByAEmX4wUB782rXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEyAC0AQwA2ADgANgAtADQAYwBkAGEALQA4ADYAOABGAC0AQQABAACARQBEAEUAMQA4ADYAMQA1ADQAfQAgAEMAOgBcAFAAcgBvAGcAcgBhAG0AIABGAGkAbABlAHMAXABDAG8AAAAFABiZ4wUGAGIAAAAAAAUAAIBw6xIAAQAAAFwAH97svQEABQC06xIAZQBkAFwAQQB1AGQAaQBvAFAAbABhAHkAZQByAC4AZABsAGwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==" /> + + cselectednode = + Height = 100 + Name = "thor_tree" + Width = 100 + _memberdata = + + + + + + + PROCEDURE restoreexpandednodes + Local lcKey, lnI, lnPos, loNode + With This + For lnI = 1 To .Nodes.Count + loNode = .Nodes.Item[lnI] + lcKey = loNode.Key + lnPos = Ascan (.aNodes, lcKey, -1, -1, 1, 15) + If lnPos > 0 + If .aNodes[lnPos, 2] + loNode.Expanded = .T. + Endif laNodes[lnPos, 2] + If lcKey == .cSelectedNode + .SelectItem (loNode) + Endif lcKey == .cSelectedNode + Endif lnPos > 0 ... + Next lnI + Endwith && this + + ENDPROC + + PROCEDURE saveexpandednodes + Local lnI, loNode + Local aNodes[1] + With This + Dimension .aNodes[.Nodes.Count, 2] + For lnI = 1 To .Nodes.Count + loNode = .Nodes.Item[lnI] + .aNodes[lnI, 1] = loNode.Key + .aNodes[lnI, 2] = loNode.Expanded + Next lnI + .cSelectedNode = .SelectedItem.Key + .Nodes.Clear() + Endwith && This + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thorhotkey AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Thorhotkeysource1" UniqueID="" Timestamp="" /> + + Height = 80 + Name = "thorhotkey" + Width = 300 + + ADD OBJECT 'Thorhotkeysource1' AS thorhotkeysource WITH ; + Left = 6, ; + Name = "Thorhotkeysource1", ; + Top = 6, ; + Visible = .T., ; + cmdClear.Name = "cmdClear", ; + cmdGetHotKey.Name = "cmdGetHotKey", ; + lblHotKey.Name = "lblHotKey", ; + txtHotKey.Name = "txtHotKey" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + +ENDDEFINE + +DEFINE CLASS thorhotkeysource AS hotkeycontrols OF "thor_ui.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor_ui.h" + Name = "thorhotkeysource" + Style = 0 + cmdClear.Name = "cmdClear" + cmdGetHotKey.Name = "cmdGetHotKey" + lblHotKey.Name = "lblHotKey" + txtHotKey.Name = "txtHotKey" + + PROCEDURE clearhotkey + *============================================================================== + * Method: ClearHotKey + * Purpose: Clears the current hotkey + * Author: Doug Hennig + * Last revision: 04/12/2011 + * Parameters: none + * Returns: none + * Environment in: Thor is positioned to the desired record + * Environment out: Thor.Value is blanked + * controls are refreshed + * see This.CancelHotKey for other changes + *============================================================================== + + with This + .CancelHotKey() + This.Parent.Parent.Parent.SetOption('ThorHotKey', 'Thor', '') + .Refresh() + endwith + + ENDPROC + + PROCEDURE keypressed + *============================================================================== + * Method: KeyPressed + * Purpose: Called when the user presses a hotkey + * Author: Doug Hennig + * Last revision: 04/12/2011 + * Parameters: hWnd - the hWnd of the form + * Msg - the ID of the Windows message + * wParam - the scancode of the key pressed + * lParam - modifiers for the keypress (see WM_KEYDOWN in MSDN + * for details) + * Returns: none + * Environment in: MenuDefinitions and ToolHotKeyAssignments are open + * Thor is open and positioned to the desired record + * Environment out: if the user pressed a valid hotkey and it isn't already + * used by another record, its description is put into + * the current record in Thor + * see This.CancelHotKey for other changes + *============================================================================== + + Local loKey As 'HotKey' Of 'Thor_Utils.vcx' + Local lcAlias, lcDescrip, lcFkyValue, lcThorKey, llFound, lnHotKeyID, lnID, lnRecno, lnScanCode + Local lnSelect, lnShift, lnShifts + + loKey = Newobject ('HotKey', 'Thor_Utils.vcx') + loKey.GetKeyState() + lnScanCode = loKey.GetScanCode (This.nInKey) + loKey.nScanCode = lnScanCode + if loKey.IsValid(.T.) + lcDescrip = loKey.GetHotKeyDescription() + lnShift = loKey.GetModifiersValue() + + * Find the HotKeyDefinitions record for the hotkey. + + lnSelect = select() + select HotKeyDefinitions + lnShifts = loKey.GetShifts() + Locate For nKeyCode = lnScanCode And nShifts = lnShifts + lcFkyValue = loKey.GetKeyCode() + lnHotKeyID = ID + select (lnSelect) + + * See if the hotkey is already in use by another record. + + lnRecno1 = recno('MenuDefinitions') + lnRecno2 = recno('ToolHotKeyAssignments') + llFound = lnHotKeyID > 0 and ; + (seek(lnHotKeyID, 'MenuDefinitions', 'HotKeyID') or ; + seek(lnHotKeyID, 'ToolHotKeyAssignments', 'HotKeyID')) + if between(lnRecno1, 1, reccount('MenuDefinitions')) + go lnRecno1 in MenuDefinitions + endif between(lnRecno1, 1, reccount('MenuDefinitions')) + if between(lnRecno2, 1, reccount('ToolHotKeyAssignments')) + go lnRecno2 in ToolHotKeyAssignments + endif between(lnRecno2, 1, reccount('ToolHotKeyAssignments')) + if llFound + messagebox(ccHOTKEY_ALREADY_USED, MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + + * Call the OnPreUpdate hook method, update the HotKeyID in the desired table, + * refresh the controls, and call the OnKeyPressed hook method. + + Else + This.Parent.Parent.Parent.SetOption('ThorHotKey', 'Thor', lcDescrip) + This.Refresh() + endif llFound + else + + * Tell the user that we don't have a valid hotkey. + + messagebox(ccINVALID_HOT_KEY, MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + endif loKey.IsValid(.T.) + + ENDPROC + + PROCEDURE Refresh + * This.Visible = upper(Thor.Class) = upper(This.Class) + This.txtHotKey.Value = This.Parent.Parent.Parent.GetOption('ThorHotKey', 'Thor') + + ENDPROC + + PROCEDURE lblHotKey.Init + * + ENDPROC + +ENDDEFINE + +DEFINE CLASS thoroptions AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cntNonDefault" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="oList" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Thor_sfsplitterh1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntDefault" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntDefault.lblValue" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntDefault.edtValue" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntDefault.spnValue" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntDefault.chkValue" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: getoption + *m: loadlist && Loads the ListView with options + *m: reloadlist + *m: resizecolumn1 + *m: selectitem && Fired when the user selects an item + *m: setoption + *p: cclass + *p: ctool + *p: lcolumnsadded + * + + Anchor = 15 + BorderWidth = 1 + cclass = + ctool = + Height = 260 + lcolumnsadded = .F. + Name = "thoroptions" + Width = 616 + _memberdata = + + + + + + + + + + + + ADD OBJECT 'cntDefault' AS thoroptionscontainer WITH ; + Anchor = 15, ; + Height = 260, ; + Left = 210, ; + Name = "cntDefault", ; + Top = 0, ; + Width = 405, ; + ZOrderSet = 3 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'cntDefault.chkValue' AS basecheckbox WITH ; + Alignment = 0, ; + Caption = "Value", ; + Left = 9, ; + Name = "chkValue", ; + Top = 133 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'cntDefault.edtValue' AS baseeditbox WITH ; + Anchor = 11, ; + Height = 72, ; + Left = 9, ; + Name = "edtValue", ; + Top = 26, ; + Width = 389 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="editbox" /> + + ADD OBJECT 'cntDefault.lblValue' AS baselabel WITH ; + Anchor = 0, ; + Caption = "Value", ; + Left = 12, ; + Name = "lblValue", ; + Top = 8 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'cntDefault.spnValue' AS basespinner WITH ; + Left = 9, ; + Name = "spnValue", ; + Top = 102 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="spinner" /> + + ADD OBJECT 'cntNonDefault' AS thoroptionscontainer WITH ; + Anchor = 15, ; + Height = 260, ; + Left = 210, ; + Name = "cntNonDefault", ; + Top = 0, ; + Width = 405, ; + ZOrderSet = 0 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'oList' AS olecontrol WITH ; + Anchor = 5, ; + Height = 260, ; + Left = 0, ; + Name = "oList", ; + Top = 0, ; + Width = 200, ; + ZOrderSet = 1 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\syswow64\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKATlbLPyc0BAwAAAAACAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcgAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAANMAAAAAAAAABgAAAAIAAAD+////BAAAAAUAAAAHAAAA/v////7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9L8NG9i4XREbFqAMDwKDYoIUM0EggAAACsFAAA3xoAAE4IfesBAAYAHAAAAAAAAAAAAAAAI4ABAKwUAAAB782rXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAACADgAAAEhpZGVTZWxlY3Rpb24ABQAAAEwAAAAACgAAAExhYmVsRWRpdAAJAAAASQoAAAABAAAACgAAAExhYmVsV3JhcAAFAAAATAAAAAANAAAATW91c2VQb2ludGVyAAkAAABJCgAAAAAAAAAFAAAAVmlldwAJAAAASQoAAAADAAAACwAAAEFwcGVhcmFuY2UACQAAAEkKAAAAAAAAAA4AAABGdWxsUm93U2VsZWN0AAUAAABMAQAAAAoAAAAAAAUA6N8sCQMAAP8IAACABQAAgPi+LwkAAAAAAAAAAAAAAAAf3uy9AQAFAHC+LwkAAAAAAAAAAAAAAAAAAAAAR3JpZExpbmVzAAUAAABMAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==" /> + + ADD OBJECT 'Thor_sfsplitterh1' AS thor_sfsplitterh WITH ; + Anchor = 5, ; + cobject1name = oList, ; + cobject2name = cntDefault, cntNonDefault, ; + Height = 260, ; + Left = 200, ; + lshowgripper = .T., ; + Name = "Thor_sfsplitterh1", ; + nobject1minsize = 200, ; + nobject2minsize = 345, ; + Top = 0, ; + Visible = .T., ; + Width = 10, ; + ZOrderSet = 2, ; + gripper.GripperDot1.Name = "GripperDot1", ; + gripper.GripperDot1.ShapeDark.Name = "ShapeDark", ; + gripper.GripperDot1.ShapeLight.Name = "ShapeLight", ; + gripper.GripperDot1.ShapeMiddle.Name = "ShapeMiddle", ; + gripper.GripperDot2.Name = "GripperDot2", ; + gripper.GripperDot2.ShapeDark.Name = "ShapeDark", ; + gripper.GripperDot2.ShapeLight.Name = "ShapeLight", ; + gripper.GripperDot2.ShapeMiddle.Name = "ShapeMiddle", ; + gripper.GripperDot3.Name = "GripperDot3", ; + gripper.GripperDot3.ShapeDark.Name = "ShapeDark", ; + gripper.GripperDot3.ShapeLight.Name = "ShapeLight", ; + gripper.GripperDot3.ShapeMiddle.Name = "ShapeMiddle", ; + gripper.GripperDot4.Name = "GripperDot4", ; + gripper.GripperDot4.ShapeDark.Name = "ShapeDark", ; + gripper.GripperDot4.ShapeLight.Name = "ShapeLight", ; + gripper.GripperDot4.ShapeMiddle.Name = "ShapeMiddle", ; + gripper.GripperDot5.Name = "GripperDot5", ; + gripper.GripperDot5.ShapeDark.Name = "ShapeDark", ; + gripper.GripperDot5.ShapeLight.Name = "ShapeLight", ; + gripper.GripperDot5.ShapeMiddle.Name = "ShapeMiddle", ; + gripper.Name = "gripper" + *< END OBJECT: ClassLib="thor_sf_splitter.vcx" BaseClass="container" /> + + PROCEDURE getoption + Lparameters tcKey, tcTool + Return ThisForm.oThor.GetOption (tcKey, tcTool) + + ENDPROC + + PROCEDURE loadlist && Loads the ListView with options + *============================================================================== + * Method: LoadList + * Purpose: Loads the ListView with tools + * Author: Doug Hennig + * Last revision: 04/09/2011 + * Parameters: none + * Returns: none + * Environment in: the Thor table is open + * Environment out: the ListView has been loaded with options + *============================================================================== + + Lparameters lcTool + + Local lcCaption, lcLastTool, lnSelect, loItem + lnSelect = Select() + Select Thor + Set Order To Order + lcLastTool = '' + + With This.oList.ListItems + .Clear() + Scan For (Not Empty(Class)) ; + And (Empty(lcLastTool) Or lcLastTool # Tool) + lcCaption = Trim(Caption) + If Tool = 'Thor' + lcCaption = 'Thor: ' + Strtran(lcCaption, ':', '') + Endif + loItem = .Add(, Upper(Trim(Tool)), Trim(Tool)) + *!* * Removed 5/28/2012 / JRN + *!* loItem.SubItems(1) = Display + loItem.Tag = Recno() + lcLastTool = Tool + Endscan + Endwith + + * Select the first item. + + This.SelectItem(This.oList.ListItems.Item(1)) + Select (lnSelect) + + ENDPROC + + PROCEDURE Refresh + This.ResizeColumn1() + ENDPROC + + PROCEDURE reloadlist + Local lnItem, loItem + With This.oList + Try + For lnItem = 1 To .ListItems.Count + loItem = .ListItems[lnItem] + Goto (loItem.Tag) in Thor + *!* * Removed 5/28/2012 / JRN + *!* loItem.SubItems(1) = Display + EndFor + Catch + + EndTry + Endwith + + ENDPROC + + PROCEDURE Resize + This.ResizeColumn1() + + ENDPROC + + PROCEDURE resizecolumn1 + * Adjust the width of column 1 based on the ListView width and the width of + * column 2. + + Local llScroll, lnCol1Width, lnCol2Width, lnWidth + With This.oList + *!* * Removed 5/28/2012 / JRN + *!* lnCol1Width = .ColumnHeaders(1).Width + *!* lnCol2Width = .ColumnHeaders(2).Width + + *!* lnCol2Width = Max(110, Min (lnCol2Width, .Width - lnCol1Width - Sysmetric(5))) + *!* .ColumnHeaders(2).Width = lnCol2Width + *!* .ColumnHeaders(1).Width = .Width - lnCol2Width - Sysmetric(5) + .ColumnHeaders(1).Width = .Width - Sysmetric(5) + Endwith + + Return + + *!* * Removed 5/28/2012 / JRN + + *!* With This.oList + + *!* * See if the ListView has a vertical scrollbar. + + *!* #Define WS_HSCROLL 0x100000 + *!* #Define WS_VSCROLL 0x200000 + *!* #Define GWL_STYLE -16 + *!* Declare Integer GetWindowLong In Win32API Integer HWnd, Integer nIndex + *!* llScroll = Bitand(GetWindowLong(.HWnd, GWL_STYLE), WS_VSCROLL) <> 0 + + *!* * Set the width of the second column. + + *!* lnWidth = .Width - .ColumnHeaders.Item(2).Width - Sysmetric(4) - ; + *!* Iif(llScroll, Sysmetric(7), 0) + 6 + *!* && 6 is a fudge factor for width and depends on whether a border is + *!* && used or not + *!* .ColumnHeaders.Item(1).Width = Max(lnWidth, 100) + *!* Endwith + + ENDPROC + + PROCEDURE selectitem && Fired when the user selects an item + *============================================================================== + * Method: SelectItem + * Purpose: Selects the specified item in the ListView + * Author: Doug Hennig + * Last revision: 04/09/2011 + * Parameters: tuItem - a node or a node key + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters tuItem + Local lcClass, lcClassLibrary, lcKey, lnAnchor, lnI, lnSelect, loItem, loObject + With This + + * If a key was passed instead of an item, get it. + + Do Case + Case Vartype (tuItem) = 'O' + loItem = tuItem + Case Type ('.oList.ListItems.Item(Upper(Trim(tuItem)))') = 'O' + loItem = .oList.ListItems.Item(Upper(Trim(tuItem))) + Otherwise + loItem = .Null. + Endcase + + * If we have an item, select it and find the record in Thor. + + If Vartype (loItem) = 'O' + .oList.SelectedItem = loItem + lcKey = loItem.Key + lnSelect = Select() + Select Thor + Locate For Upper(Trim(Tool)) == Upper(Trim(lcKey)) + + * If we have a custom control defined, create it if it isn't already. + + lcClass = Trim (Class) + This.cClass = lcClass + lcClassLibrary = Trim (Library) + + Do Case + Case Empty (lcClass) + With This.cntDefault + .cKey = Key + .cTool = Tool + .cCaption = Caption + .cType = Type + Endwith + + Case Type ('This.cntNonDefault.' + lcClass) = 'U' + With This.cntNonDefault + .cKey = Key + .cTool = Tool + .cCaption = Caption + .cType = Type + For lnI = .ControlCount To 1 Step - 1 + .RemoveObject (.Controls[lnI].Name) + Endfor + Endwith + + Locate For Tool + Key = lcKey + This.cntNonDefault.Newobject (lcClass, lcClass, lcClassLibrary) + loObject = Evaluate ('This.cntNonDefault.' + lcClass) + With loObject + * cause the interior objects, if any, to adjust + .Height = .Parent.Height + .Width = .Parent.Width - 1 + + * and correct anchoring for this object itself + lnAnchor = .Anchor + .Anchor = 0 + .Height = .Parent.Height + .Width = .Parent.Width + .Visible = .T. + .Anchor = lnAnchor + Endwith + Endcase + .Refresh() + Endif Vartype (loItem) = 'O' + Endwith + + ENDPROC + + PROCEDURE setoption + Lparameters tcKey, tcTool, tuValue, tuDisplayValue + Local luResult + luResult = Thisform.oThor.SetOption (tcKey, tcTool, tuValue, tuDisplayValue) + Return luResult + + + ENDPROC + + PROCEDURE UIEnable + lparameters tlEnable + if tlEnable + if This.oList.ListItems.Count = 0 + This.LoadList() + endif This.oList.ListItems.Count = 0 + This.Resize() + endif tlEnable + + ENDPROC + + PROCEDURE cntDefault.chkValue.Init + local lnAnchor + with This + lnAnchor = .Anchor + .Anchor = 0 + .Top = .Parent.lblValue.Top + .Anchor = lnAnchor + endwith + + ENDPROC + + PROCEDURE cntDefault.chkValue.InteractiveChange + This.Parent.SetValue (This.Value) + ENDPROC + + PROCEDURE cntDefault.chkValue.Refresh + Local lcType + With This + lcType = This.Parent.cType + If lcType = 'L' + .Visible = .T. + .Value = This.Parent.GetValue() + .Caption = Trim (This.Parent.cCaption) + Else + .Visible = .F. + Endif + Endwith + + ENDPROC + + PROCEDURE cntDefault.edtValue.Refresh + Local lcType + With This + lcType = This.Parent.cType + If lcType = 'C' + .Visible = .T. + .Value = This.Parent.GetValue() + Else + .Visible = .F. + Endif + Endwith + + ENDPROC + + PROCEDURE cntDefault.edtValue.Valid + This.Parent.SetValue (This.Value) + ENDPROC + + PROCEDURE cntDefault.lblValue.Init + This.Caption = ccVALUE + dodefault() + + ENDPROC + + PROCEDURE cntDefault.lblValue.Refresh + Local lcCaption, lcType + lcType = This.Parent.cType + lcCaption = This.Parent.cCaption + + This.Visible = Inlist (lcType, 'C', 'N') + This.Caption = Trim (lcCaption) + + ENDPROC + + PROCEDURE cntDefault.Refresh + This.Visible = empty(This.Parent.cClass) + + ENDPROC + + PROCEDURE cntDefault.spnValue.Init + Local lnAnchor + With This + lnAnchor = .Anchor + .Anchor = 0 + .Top = .Parent.edtValue.Top + .Anchor = lnAnchor + Endwith + + ENDPROC + + PROCEDURE cntDefault.spnValue.Refresh + Local lcType + With This + lcType = This.Parent.cType + If lcType = 'N' + .Visible = .T. + .Value = Int (This.Parent.GetValue()) + Else + .Visible = .F. + Endif + Endwith + + ENDPROC + + PROCEDURE cntDefault.spnValue.Valid + This.Parent.SetValue (This.Value) + ENDPROC + + PROCEDURE cntNonDefault.Refresh + This.Visible = not empty(This.Parent.cClass) + ENDPROC + + PROCEDURE oList.Init + local lnCol2Width + with This + + * Set the font. + + .Object.Font.Name = Thisform.FontName + .Object.Font.Size = 8 + + * Create some columns for the ListView. + + lnCol2Width = 110 + *!* * Removed 5/28/2012 / JRN + *!* .ColumnHeaders.Add(, 'Tool', ccOPTION, .Width - lnCol2Width - ; + *!* sysmetric(5)) + *!* .ColumnHeaders.Add(, 'Value', ccVALUE, lnCol2Width) + .ColumnHeaders.Add(, 'Tool', 'Tool', .Width - sysmetric(5)) + This.Parent.lColumnsAdded = .T. + endwith + + ENDPROC + + PROCEDURE oList.ItemClick + lparameters toItem + This.Parent.SelectItem(toItem) + + ENDPROC + + PROCEDURE oList.Resize + Local lnCol1Width, lnCol2Width + + If This.Parent.lColumnsAdded + This.Parent.ResizeColumn1() + Endif && This.Parent.lColumnsAdded + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thoroptionscontainer AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: getoption + *m: getvalue + *m: setoption + *m: setvalue + *p: ccaption + *p: ckey + *p: ctool + *p: ctype + *p: odata + * + + ccaption = + ckey = + ctool = + ctype = C + Name = "thoroptionscontainer" + odata = .NULL. + _memberdata = + + + + + + + + + + + + PROCEDURE getoption + Lparameters tcKey, tcTool + Return ThisForm.oThor.GetOption (tcKey, tcTool) + + ENDPROC + + PROCEDURE getvalue + Return This.GetOption(This.cKey, This.cTool) + + ENDPROC + + PROCEDURE setoption + Lparameters tcKey, tcTool, tuValue, tuDisplayValue + Local luResult + luResult = Thisform.oThor.SetOption (tcKey, tcTool, tuValue, tuDisplayValue) + This.Parent.ReloadList() + Return luResult + + + ENDPROC + + PROCEDURE setvalue + Lparameters tuValue, tuDisplayValue + This.SetOption(This.cKey, This.cTool, tuValue, tuDisplayValue) + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thoroptionscontrols AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Baselabel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Line1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblValue" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="spnValue" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="chkValue" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Thorhotkey1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Baselabel2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Baselabel3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Basespinner1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Basecheckbox1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Basecheckbox2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Basecheckbox3" UniqueID="" Timestamp="" /> + + BackStyle = 1 + Height = 260 + Name = "thoroptionscontrols" + Width = 345 + + ADD OBJECT 'Basecheckbox1' AS basecheckbox WITH ; + Alignment = 0, ; + Caption = 'Show "Thor Tools" in FoxPro system menu', ; + Height = 18, ; + Left = 6, ; + Name = "Basecheckbox1", ; + Top = 180, ; + Width = 264 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Basecheckbox2' AS basecheckbox WITH ; + Alignment = 0, ; + Caption = "Dock Thor ToolBar with FoxPro toolbars", ; + Height = 18, ; + Left = 6, ; + Name = "Basecheckbox2", ; + Top = 202, ; + Width = 246 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Basecheckbox3' AS basecheckbox WITH ; + Alignment = 0, ; + Caption = "Use Home(7) for form settings", ; + Height = 18, ; + Left = 6, ; + Name = "Basecheckbox3", ; + Top = 224, ; + Width = 193 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Baselabel1' AS label WITH ; + Alignment = 2, ; + BackStyle = 0, ; + Caption = "Thor", ; + FontBold = .T., ; + ForeColor = 0,0,255, ; + Height = 18, ; + Left = 5, ; + Name = "Baselabel1", ; + TabIndex = 7, ; + Top = 6, ; + Width = 335 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Baselabel2' AS baselabel WITH ; + Anchor = 0, ; + Caption = "Dedicated hotkey for Thor's use", ; + Left = 36, ; + Name = "Baselabel2", ; + Top = 36 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'Baselabel3' AS baselabel WITH ; + Alignment = 1, ; + Anchor = 0, ; + Caption = "Launcher Font Size:", ; + Left = 62, ; + Name = "Baselabel3", ; + Top = 154 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'Basespinner1' AS basespinner WITH ; + Height = 24, ; + InputMask = "999", ; + Left = 186, ; + Name = "Basespinner1", ; + Top = 150, ; + Width = 79 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="spinner" /> + + ADD OBJECT 'chkValue' AS basecheckbox WITH ; + Alignment = 0, ; + Caption = "Display message when hotkeys and menus are updated", ; + Height = 18, ; + Left = 5, ; + Name = "chkValue", ; + Top = 96, ; + Width = 336 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'lblValue' AS baselabel WITH ; + Alignment = 1, ; + Anchor = 0, ; + Caption = "Configuration form Font Size:", ; + Left = 7, ; + Name = "lblValue", ; + Top = 127 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'Line1' AS line WITH ; + Anchor = 10, ; + Height = 0, ; + Left = 0, ; + Name = "Line1", ; + Top = 26, ; + Width = 380 + *< END OBJECT: BaseClass="line" /> + + ADD OBJECT 'spnValue' AS basespinner WITH ; + Height = 24, ; + InputMask = "999", ; + Left = 186, ; + Name = "spnValue", ; + Top = 123, ; + Width = 79 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="spinner" /> + + ADD OBJECT 'Thorhotkey1' AS thorhotkey WITH ; + Height = 38, ; + Left = -34, ; + Name = "Thorhotkey1", ; + Top = 53, ; + Visible = .T., ; + Width = 300, ; + Thorhotkeysource1.cmdClear.Name = "cmdClear", ; + Thorhotkeysource1.cmdGetHotKey.Name = "cmdGetHotKey", ; + Thorhotkeysource1.lblHotKey.Caption = "", ; + Thorhotkeysource1.lblHotKey.Name = "lblHotKey", ; + Thorhotkeysource1.Name = "Thorhotkeysource1", ; + Thorhotkeysource1.txtHotKey.Name = "txtHotKey" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + PROCEDURE Basecheckbox1.InteractiveChange + This.Parent.Parent.SetOption('ThorToolsSystemMenu', 'Thor', This.Value) + ENDPROC + + PROCEDURE Basecheckbox1.Refresh + This.Value = This.Parent.Parent.GetOption('ThorToolsSystemMenu', 'Thor') + ENDPROC + + PROCEDURE Basecheckbox2.InteractiveChange + This.Parent.Parent.SetOption('ThorToolsBarDock0', 'Thor', This.Value) + ENDPROC + + PROCEDURE Basecheckbox2.Refresh + This.Value = This.Parent.Parent.GetOption('ThorToolsBarDock0', 'Thor') + ENDPROC + + PROCEDURE Basecheckbox3.InteractiveChange + This.Parent.Parent.SetOption('Settings in Home(7)', 'Thor', This.Value) + ENDPROC + + PROCEDURE Basecheckbox3.Refresh + This.Value = This.Parent.Parent.GetOption('Settings in Home(7)', 'Thor') + ENDPROC + + PROCEDURE Basespinner1.InteractiveChange + This.Parent.Parent.SetOption('LauncherFontSize', 'Thor', This.Value) + ENDPROC + + PROCEDURE Basespinner1.LostFocus + This.Parent.Parent.SetOption('LauncherFontSize', 'Thor', This.Value) + ENDPROC + + PROCEDURE Basespinner1.Refresh + This.Value = This.Parent.Parent.GetOption('LauncherFontSize', 'Thor') + ENDPROC + + PROCEDURE chkValue.InteractiveChange + This.Parent.Parent.SetOption('UpdateMessage', 'Thor', This.Value) + ENDPROC + + PROCEDURE chkValue.Refresh + This.Value = This.Parent.Parent.GetOption('UpdateMessage', 'Thor') + ENDPROC + + PROCEDURE spnValue.InteractiveChange + This.Parent.Parent.SetOption('UpdateMessage', 'FontSize', This.Value) + ENDPROC + + PROCEDURE spnValue.LostFocus + This.Parent.Parent.SetOption('FontSize', 'Thor', This.Value) + ENDPROC + + PROCEDURE spnValue.Refresh + This.Value = This.Parent.Parent.GetOption('FontSize', 'Thor') + ENDPROC + +ENDDEFINE + +DEFINE CLASS toolcontrols AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="lblTool" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboTool" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: ontoolchanged && Fired when the user selects a tool + *p: calias && The table PRGName is in + * + + calias = && The table PRGName is in + Height = 23 + Name = "toolcontrols" + Width = 421 + _memberdata = + + + + + ADD OBJECT 'cboTool' AS basecombobox WITH ; + Anchor = 8, ; + BoundColumn = 3, ; + Left = 65, ; + Name = "cboTool", ; + TabIndex = 2, ; + Top = 0, ; + Width = 355 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="combobox" /> + + ADD OBJECT 'lblTool' AS baselabel WITH ; + Anchor = 8, ; + Caption = "\ + + PROCEDURE ontoolchanged && Fired when the user selects a tool + *============================================================================== + * Method: OnToolChanged + * Purpose: Fired when the user selects a tool + * Author: Doug Hennig + * Last revision: 03/21/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + * Abstract method + + ENDPROC + + PROCEDURE cboTool.InteractiveChange + * When the user selects a tool, update the table. + + local lcPRGName + with This + lcPRGName = .aItems[.ListIndex, 3] + replace PRGName with lcPRGName in (.Parent.cAlias) + .Parent.OnToolChanged() + endwith + + ENDPROC + + PROCEDURE cboTool.Refresh + *** DH 04/23/2011: added lcFilter + local lcFilter, ; + lnItems, ; + loTool, ; + lnIndex + with This + + * Fill the list from registered tools the first time it's needed or if we're + * refreshing tools. + + if empty(.aItems[1]) or Thisform.lRefreshTools + *** DH 04/23/2011: initialize lcFilter + lcFilter = upper(This.Parent.Parent.Parent.Parent.cToolFilter) + lnItems = 0 + for each loTool in Thisform.oTools + *** DH 04/23/2011: support filter + if empty(lcFilter) or ; + lcFilter $ upper(loTool.Prompt + loTool.Summary + loTool.Description) + lnItems = lnItems + 1 + dimension .aItems[lnItems, 5] + *** JRN 4/20/2011 : Use .Summary, if available + .aItems[lnItems, 1] = left(loTool.Source + ': ' + ; + Evl(loTool.Summary, loTool.Description), 200) + .aItems[lnItems, 2] = loTool.Prompt + .aItems[lnItems, 3] = loTool.PRGName + .aItems[lnItems, 4] = loTool.StatusBarText + .aItems[lnItems, 5] = loTool.Source + str(loTool.Sort) + ; + loTool.Description + endif empty(lcFilter) ... + next loTool + *** DH 04/23/2011: support filter + if lnItems = 0 + dimension .aItems[1, 5] + .aItems = '' + endif lnItems = 0 + .Enabled = lnItems > 0 + asort(.aItems, 5) + .Requery() + endif empty(.aItems[1]) ... + lnIndex = ascan(.aItems, trim(evaluate(.Parent.cAlias + '.PRGName')), ; + -1, -1, 3, 15) + .ListIndex = lnIndex + endwith + + ENDPROC + + PROCEDURE lblTool.Init + This.Caption = ccCAP_TOOL + dodefault() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS toolinfo AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="edtToolInfo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblLink" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblVideo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblOptions" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblPlugIns" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *p: calias && The table PRGName is in + *p: cprgname && The selected PRGName + * + + Anchor = 13 + calias = && The table PRGName is in + cprgname = && The selected PRGName + Height = 71 + Name = "toolinfo" + Width = 341 + + ADD OBJECT 'edtToolInfo' AS baseeditbox WITH ; + Anchor = 13, ; + BorderStyle = 0, ; + Height = 32, ; + Left = 0, ; + Margin = 0, ; + Name = "edtToolInfo", ; + ScrollBars = 0, ; + TabIndex = 4, ; + Top = 0, ; + Width = 340 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="editbox" /> + + ADD OBJECT 'lblLink' AS baselabel WITH ; + Anchor = 4, ; + Caption = "Tool Home Page", ; + FontUnderline = .T., ; + ForeColor = 0,0,255, ; + Left = 8, ; + MousePointer = 15, ; + Name = "lblLink", ; + TabIndex = 5, ; + Top = 56 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'lblOptions' AS baselabel WITH ; + Anchor = 4, ; + Caption = "Options", ; + FontUnderline = .T., ; + ForeColor = 0,0,255, ; + Left = 136, ; + MousePointer = 15, ; + Name = "lblOptions", ; + TabIndex = 5, ; + Top = 56 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'lblPlugIns' AS baselabel WITH ; + Anchor = 4, ; + Caption = "Plug-Ins", ; + FontUnderline = .T., ; + ForeColor = 0,0,255, ; + Left = 213, ; + MousePointer = 15, ; + Name = "lblPlugIns", ; + TabIndex = 5, ; + Top = 56 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'lblVideo' AS baselabel WITH ; + Anchor = 4, ; + Caption = "Video", ; + FontUnderline = .T., ; + ForeColor = 0,0,255, ; + Left = 293, ; + MousePointer = 15, ; + Name = "lblVideo", ; + TabIndex = 5, ; + Top = 56, ; + Width = 34 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + PROCEDURE edtToolInfo.Refresh + Local lcCaption, lcDescrip, lcPRGName, lcProgram, lcValue, lcVersion, lcVideoLink, llHaveTool, lnPos + Local loTool + If Empty (This.Parent.cPRGName) + lcPRGName = Trim (Evaluate (This.Parent.cAlias + '.PRGName')) + Else + lcPRGName = This.Parent.cPRGName + Endif Empty (This.Parent.cPRGName) + + This.Value = '' + This.Parent.lblLink.Tag = '' + This.Parent.lblLink.Caption = '' + This.Parent.lblVideo.Tag = '' + This.Parent.lblVideo.Caption = '' + + Do Case + Case Thisform.oTools.GetKey (Upper (lcPRGName)) = 0 + This.Value = 'Tool <' + lcPRGName + '> not found' + + Case Not Empty (lcPRGName) + loTool = Thisform.oTools.Item (Upper (lcPRGName)) + This.Value = Thisform.oThor.GetToolDescription (loTool) + + With This.Parent.lblLink + If Empty (loTool.Link) + .Caption = '' + Else + .Tag = loTool.Link + .Caption = ccTOOL_HOME_PAGE + Endif Empty (loTool.Link) + Endwith + + With This.Parent.lblOptions + If Empty (loTool.OptionTool) + .Caption = '' + Else + .Caption = 'Options' + .Tag = loTool.OptionTool + Endif Empty (loTool.Link) + Endwith + + With This.Parent.lblPlugIns + If Empty (loTool.PlugIns) + .Caption = '' + Else + .Caption = 'Plug-Ins' + .Tag = loTool.PlugIns + Endif Empty (loTool.Link) + Endwith + + lcVideoLink = loTool.VideoLink + If Not Empty (lcVideoLink) + If '|' $ lcVideoLink + lnPos = At ('|', lcVideoLink) + lcCaption = ccTOOL_VIDEO + ' (' + Substr (lcVideoLink, lnPos + 1) + ')' + lcVideoLink = Left (lcVideoLink, lnPos - 1) + Else + lcCaption = ccTOOL_VIDEO + Endif + This.Parent.lblVideo.Tag = lcVideoLink + This.Parent.lblVideo.Caption = lcCaption + Endif + + Otherwise + Endcase + + + ENDPROC + + PROCEDURE edtToolInfo.When + return .F. + + ENDPROC + + PROCEDURE lblLink.Click + if not empty(This.Tag) + loLink = newobject('_ShellExecute', home() + 'FFC\_Environ.vcx') + loLink.ShellExecute(This.Tag) + endif not empty(This.Tag) + + ENDPROC + + PROCEDURE lblOptions.Click + ExecScript(_Screen.cThorDispatcher, 'Thor_Proc_OpenOptionsPage', This.Tag) + + + + ENDPROC + + PROCEDURE lblPlugIns.Click + Local lcFileName + Execscript (_Screen.cThorDispatcher, 'PEMEditor_StartIDETools') + lcFileName = Execscript (_Screen.cThorDispatcher, 'Full Path=Thor_Tool_ThorInternalManagePlugIns.SCX') + Do Form (lcFileName) With This.Tag + + ENDPROC + + PROCEDURE lblVideo.Click + if not empty(This.Tag) + loLink = newobject('_ShellExecute', home() + 'FFC\_Environ.vcx') + loLink.ShellExecute(This.Tag) + endif not empty(This.Tag) + + ENDPROC + +ENDDEFINE + +DEFINE CLASS toolkeys AS toolkeysbase OF "thor_ui.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="SELECTTOOLFORBROWSING1" UniqueID="" Timestamp="" /> + + Name = "toolkeys" + cmdCreateTool.Name = "cmdCreateTool" + cmdOpenToolFolder.Name = "cmdOpenToolFolder" + cntToolInfo.chkStartup.Alignment = 0 + cntToolInfo.chkStartup.Name = "chkStartup" + cntToolInfo.cmdEditTool.Name = "cmdEditTool" + cntToolInfo.cmdRemoveTool.Name = "cmdRemoveTool" + cntToolInfo.Edittoolbutton1.Name = "Edittoolbutton1" + cntToolInfo.Left = 278 + cntToolInfo.Name = "cntToolInfo" + cntToolInfo.oHotKeyControls.cmdClear.Name = "cmdClear" + cntToolInfo.oHotKeyControls.cmdGetHotKey.Name = "cmdGetHotKey" + cntToolInfo.oHotKeyControls.lblHotKey.Name = "lblHotKey" + cntToolInfo.oHotKeyControls.Name = "oHotKeyControls" + cntToolInfo.oHotKeyControls.txtHotKey.Name = "txtHotKey" + cntToolInfo.oToolInfo.edtToolInfo.Name = "edtToolInfo" + cntToolInfo.oToolInfo.lblLink.Name = "lblLink" + cntToolInfo.oToolInfo.lblOptions.Name = "lblOptions" + cntToolInfo.oToolInfo.lblVideo.Name = "lblVideo" + cntToolInfo.oToolInfo.Name = "oToolInfo" + cntToolInfo.Top = 0 + cntToolInfo.Width = 351 + Thor_sfsplitterh1.gripper.GripperDot1.Name = "GripperDot1" + Thor_sfsplitterh1.gripper.GripperDot1.ShapeDark.Name = "ShapeDark" + Thor_sfsplitterh1.gripper.GripperDot1.ShapeLight.Name = "ShapeLight" + Thor_sfsplitterh1.gripper.GripperDot1.ShapeMiddle.Name = "ShapeMiddle" + Thor_sfsplitterh1.gripper.GripperDot2.Name = "GripperDot2" + Thor_sfsplitterh1.gripper.GripperDot2.ShapeDark.Name = "ShapeDark" + Thor_sfsplitterh1.gripper.GripperDot2.ShapeLight.Name = "ShapeLight" + Thor_sfsplitterh1.gripper.GripperDot2.ShapeMiddle.Name = "ShapeMiddle" + Thor_sfsplitterh1.gripper.GripperDot3.Name = "GripperDot3" + Thor_sfsplitterh1.gripper.GripperDot3.ShapeDark.Name = "ShapeDark" + Thor_sfsplitterh1.gripper.GripperDot3.ShapeLight.Name = "ShapeLight" + Thor_sfsplitterh1.gripper.GripperDot3.ShapeMiddle.Name = "ShapeMiddle" + Thor_sfsplitterh1.gripper.GripperDot4.Name = "GripperDot4" + Thor_sfsplitterh1.gripper.GripperDot4.ShapeDark.Name = "ShapeDark" + Thor_sfsplitterh1.gripper.GripperDot4.ShapeLight.Name = "ShapeLight" + Thor_sfsplitterh1.gripper.GripperDot4.ShapeMiddle.Name = "ShapeMiddle" + Thor_sfsplitterh1.gripper.GripperDot5.Name = "GripperDot5" + Thor_sfsplitterh1.gripper.GripperDot5.ShapeDark.Name = "ShapeDark" + Thor_sfsplitterh1.gripper.GripperDot5.ShapeLight.Name = "ShapeLight" + Thor_sfsplitterh1.gripper.GripperDot5.ShapeMiddle.Name = "ShapeMiddle" + Thor_sfsplitterh1.gripper.Name = "gripper" + Thor_sfsplitterh1.Height = 232 + Thor_sfsplitterh1.Left = 268 + Thor_sfsplitterh1.Name = "Thor_sfsplitterh1" + Thor_sfsplitterh1.Top = 1 + Thor_sfsplitterh1.Width = 10 + + ADD OBJECT 'SELECTTOOLFORBROWSING1' AS selecttoolforbrowsing WITH ; + Height = 231, ; + Left = 0, ; + Name = "SELECTTOOLFORBROWSING1", ; + Top = 0, ; + Width = 268, ; + Baselabel1.Left = 3, ; + Baselabel1.Name = "Baselabel1", ; + Baselabel1.Top = 5, ; + oTree.Height = 228, ; + oTree.Left = 1, ; + oTree.Name = "oTree", ; + oTree.Top = 30, ; + oTree.Width = 265, ; + txtcNewFilter.Height = 22, ; + txtcNewFilter.Left = 40, ; + txtcNewFilter.Name = "txtcNewFilter", ; + txtcNewFilter.Top = 1, ; + txtcNewFilter.Width = 118 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + +ENDDEFINE + +DEFINE CLASS toolkeysbase AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdCreateTool" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdOpenToolFolder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Thor_sfsplitterh1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.oHotKeyControls" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.cmdEditTool" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.oToolInfo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.chkStartup" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.cmdRemoveTool" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.Edittoolbutton1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.chkFavorite" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.chkToolBar" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.cmdToolBarIcon" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: contextmenufortoolbar + *m: createtool + *m: createtoolbar + *m: loadlist && Loads the ListView with tools + *m: otool_assign + *m: selectitem && Selects the specified item in the ListView + *p: cprgname + *p: ctoolfilter && A filter for tools + *p: lcnttoolinfovisible + *p: otool + * + + Anchor = 15 + cprgname = + ctoolfilter = && A filter for tools + Height = 260 + lcnttoolinfovisible = .F. + Name = "toolkeysbase" + otool = .NULL. + Width = 630 + _memberdata = + + + + + + + + + ADD OBJECT 'cmdCreateTool' AS basecommandbutton WITH ; + Anchor = 4, ; + Caption = "\ + + ADD OBJECT 'cmdOpenToolFolder' AS basecommandbutton WITH ; + Anchor = 4, ; + Caption = "\ + + ADD OBJECT 'cntToolInfo' AS basecontainer WITH ; + Anchor = 13, ; + Height = 260, ; + Left = 278, ; + Name = "cntToolInfo", ; + Top = 0, ; + Width = 351 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="container" /> + + ADD OBJECT 'cntToolInfo.chkFavorite' AS basecheckbox WITH ; + Alignment = 0, ; + Anchor = 0, ; + Caption = "Favorite?", ; + Left = 8, ; + Name = "chkFavorite", ; + Top = 32 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'cntToolInfo.chkStartup' AS basecheckbox WITH ; + Alignment = 0, ; + Anchor = 0, ; + Caption = "Run at startup?", ; + FontSize = 9, ; + Left = 207, ; + Name = "chkStartup", ; + Top = 32 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'cntToolInfo.chkToolBar' AS basecheckbox WITH ; + Alignment = 0, ; + Anchor = 0, ; + Caption = "ToolBar?", ; + FontSize = 9, ; + Left = 92, ; + Name = "chkToolBar", ; + Top = 32 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'cntToolInfo.cmdEditTool' AS edittoolbutton WITH ; + Anchor = 4, ; + Left = 130, ; + Name = "cmdEditTool", ; + TabIndex = 5, ; + Top = 234 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cntToolInfo.cmdRemoveTool' AS basecommandbutton WITH ; + Anchor = 4, ; + Caption = "Remove Tool", ; + Height = 23, ; + Left = 232, ; + Name = "cmdRemoveTool", ; + TabIndex = 9, ; + Top = 234, ; + Width = 95 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cntToolInfo.cmdToolBarIcon' AS thor_toolbar_button WITH ; + Left = 165, ; + Name = "cmdToolBarIcon", ; + ToolTipText = "Click to select the caption or icon for this tool in the Thor ToolBar. Right-Click to reset to default.", ; + Top = 28 + *< END OBJECT: ClassLib="thor_run.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cntToolInfo.Edittoolbutton1' AS edittoolbutton WITH ; + Anchor = 4, ; + Caption = "Run Tool", ; + Left = 28, ; + Name = "Edittoolbutton1", ; + TabIndex = 5, ; + Top = 234 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cntToolInfo.oHotKeyControls' AS hotkeycontrols WITH ; + Anchor = 0, ; + calias = ToolHotKeyAssignments, ; + Left = 6, ; + Name = "oHotKeyControls", ; + TabIndex = 3, ; + Top = 1, ; + cmdClear.Name = "cmdClear", ; + cmdGetHotKey.Name = "cmdGetHotKey", ; + lblHotKey.Name = "lblHotKey", ; + txtHotKey.Name = "txtHotKey" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'cntToolInfo.oToolInfo' AS toolinfo WITH ; + Anchor = 15, ; + calias = ToolHotKeyAssignments, ; + Height = 177, ; + Left = 6, ; + Name = "oToolInfo", ; + TabIndex = 4, ; + Top = 54, ; + Width = 344, ; + edtToolInfo.Anchor = 15, ; + edtToolInfo.BackStyle = 0, ; + edtToolInfo.Height = 160, ; + edtToolInfo.IntegralHeight = .F., ; + edtToolInfo.Left = 0, ; + edtToolInfo.Name = "edtToolInfo", ; + edtToolInfo.ReadOnly = .T., ; + edtToolInfo.ScrollBars = 2, ; + edtToolInfo.SelectOnEntry = .F., ; + edtToolInfo.Top = 0, ; + edtToolInfo.Width = 343, ; + lblLink.Name = "lblLink", ; + lblLink.Top = 161, ; + lblOptions.Name = "lblOptions", ; + lblOptions.Top = 161, ; + lblPlugIns.Name = "lblPlugIns", ; + lblPlugIns.Top = 161, ; + lblVideo.Name = "lblVideo", ; + lblVideo.Top = 161 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'Thor_sfsplitterh1' AS thor_sfsplitterh WITH ; + Anchor = 13, ; + cobject1name = SELECTTOOLFORBROWSING1, ; + cobject2name = cntToolInfo, ; + Height = 231, ; + Left = 268, ; + lshowgripper = .T., ; + Name = "Thor_sfsplitterh1", ; + nobject1minsize = 150, ; + nobject2minsize = 150, ; + Top = 1, ; + Visible = .T., ; + Width = 10, ; + ZOrderSet = 2, ; + GRIPPER.GRIPPERDOT1.Name = "GRIPPERDOT1", ; + GRIPPER.GRIPPERDOT1.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT1.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT1.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.GRIPPERDOT2.Name = "GRIPPERDOT2", ; + GRIPPER.GRIPPERDOT2.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT2.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT2.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.GRIPPERDOT3.Name = "GRIPPERDOT3", ; + GRIPPER.GRIPPERDOT3.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT3.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT3.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.GRIPPERDOT4.Name = "GRIPPERDOT4", ; + GRIPPER.GRIPPERDOT4.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT4.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT4.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.GRIPPERDOT5.Name = "GRIPPERDOT5", ; + GRIPPER.GRIPPERDOT5.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT5.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT5.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.Name = "GRIPPER" + *< END OBJECT: ClassLib="thor_sf_splitter.vcx" BaseClass="container" /> + + PROCEDURE contextmenufortoolbar + #Define ccCaption 'Enter caption' + #Define ccPicture 'Select picture' + #Define ccDefault 'Default (Thor icon)' + + #Define ccTool 'Thor' + #Define ccKey 'Thor ToolBar Path' + + + *** DH 2018-04-01: new URL: https://github.com/VFPX/Thor/blob/master/Docs/Thor_framework_contextmenu.md + * ContextMenu home page = http://vfpx.codeplex.com/wikipage?title=Thor%20Framework%20ContextMenu + Local loContextMenu As ContextMenu Of 'C:\VISUAL FOXPRO\PROGRAMS\9.0\COMMON\Thor\Source\Thor_Menu.vcx' + Local lcCaption, lcCurdir, lcNewMethodName, lcPRGName, lcPath, lcPicture, loException, loForm + Local lxValue + + lcPRGName = This.cPRGName + = Seek(Upper(lcPRGName), 'ToolBarTools', 'PRGName') + lcCaption = Evl(Trim(ToolBarTools.Caption), This.oTool.prompt) + lcPicture = ToolBarTools.Icon + + Do case + Case not Empty(lcCaption) + lnMark = 1 + Case File(lcPicture) and Upper(JustFname(lcPicture)) # Upper(ccThorIcon) + lnMark = 2 + Otherwise + lnMark = 3 + endcase + + loContextMenu = Execscript(_Screen.cThorDispatcher, 'Class= ContextMenu') + + loContextMenu.AddMenuItem(ccCaption,,,,,,lnMark = 1) + loContextMenu.AddMenuItem(ccPicture,,,,,,lnMark = 2) + loContextMenu.AddMenuItem(ccDefault,,,,,,lnMark = 3) + + If Not loContextMenu.Activate() + Return + Endif + + Do Case + Case loContextMenu.Keyword = ccCaption + Private pcCaption + loForm = Execscript(_Screen.cThorDispatcher, 'Class= DynamicFormDeskTop') + pcCaption = lcCaption + + With loForm + .Caption = This.oTool.Prompt + .MinWidth = 275 + .MinHeight = 100 + .MinButton = .F. + .MaxButton = .F. + .BorderStyle = 2 + + .cHeading = '' + Endwith + + Text To loForm.cBodyMarkup Noshow Textmerge + pcCaption .class = 'TextBox' + .caption = 'Caption:' + .width = 200 + .Increment = 1 + | + Endtext + + loForm.Show(1) + + If 'O' = Vartype(loForm) And loForm.lSaveClicked + lcCaption = pcCaption + Else + Return .F. + Endif + + Case loContextMenu.Keyword = ccPicture + + lcPath = Execscript(_Screen.cThorDispatcher, 'Get Option=', ccKey, ccTool) + If Isnull(lcPath) + lcPath = Addbs(Home(1)) + 'Graphics' + Endif + + lcCurdir = Sys(5) + Curdir() + Try + Cd(lcPath) + Catch To loException + Endtry + + lcPicture = Getpict() + Cd(lcCurdir) + + If Empty(lcPicture) + Return + Endif + + lcCaption = '' + Execscript(_Screen.cThorDispatcher, 'Set Option=', ccKey, ccTool, Justpath(lcPicture)) + + Otherwise + + lcCaption = '' + lcPicture = ccThorIcon + + Endcase + + Replace ; + Icon With lcPicture ; + Caption With lcCaption ; + In ToolBarTools + + This.Refresh() + + + + ENDPROC + + PROCEDURE createtool + *============================================================================== + * Method: CreateTool + * Purpose: Creates a template PRG for a tool + * Author: Doug Hennig + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 05/21/2011 / JRN + * Parameters: none + * Returns: none + * Environment in: _System.vcx exists in the VFP FFC folder + * Environment out: a PRG specified by the user is created with template code. + *============================================================================== + + Local loPEME_Tools AS Object + Local loThorInfo AS 'ThorInfo' OF 'Thor_Utils' + Local lcCode, lcFile, lcFolder, lcTemplateFile, lcTemplateFolder + + **************************************************************** + lcFolder = Thisform.oTools.Tag + Do Form CreateTool With lcFolder, Thisform.FontSize, Thisform.oThor To lcFile + If Empty (lcFile) + Return + EndIf + + If '|' $ lcFile + lcTemplateFolder = Addbs (lcFolder) + ccMyTemplates + lcTemplateFile = lcTemplateFolder + '\' + Substr(lcFile, At('|', lcFile) + 1) + lcFile = Left(lcFile, At('|', lcFile) - 1) + Else + lcTemplateFile = '' + EndIf + + **************************************************************** + + *!* lcCD = Sys(5) + Curdir() + *!* loFile = Newobject ('_ComDlg', Home() + 'FFC\_System.vcx') + *!* loFile.AddFilter ('Program file (*.prg)', '*.prg') + *!* loFile.lSaveDialog = .T. + *!* loFile.cInitialDirectory = Thisform.oTools.Tag + *!* loFile.ShowDialog() + *!* Cd (lcCD) + *!* lcFile = Addbs (loFile.cFilePath) + loFile.cFileTitle + + Do Case + Case Empty (lcFile) + Case Upper (Juststem (lcFile)) # Upper (ccTOOLNAMEPREFIX) + Messagebox (ccTOOL_PREFIX_ERROR, MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + Case File (lcFile) + Messagebox (Strtran (ccALREADY_EXISTS, '%1', lcFile), ; + MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + Otherwise + *** JRN 2011-04-18 : Get sample code for new PRG from ThorInfo + loThorInfo = Newobject ('ThorInfo', 'Thor_Utils') + If Empty(lcTemplateFile ) + lcCode = loThorInfo.GetSampleToolCode() + Else + lcCode = FileToStr(lcTemplateFile) + EndIf + Strtofile (lcCode, lcFile) + Modify Command (lcFile) Nowait + *** JRN 2011-05-05 : Move / resize window + loPEME_Tools = Execscript (_Screen.cThorDispatcher, 'class= tools from pemeditor') + If 'O' = Vartype (loPEME_Tools) + loPEME_Tools.AddMRUFile (lcFile) + _oPEMEditor.oUtils.oIDEx.MoveWindow() + Endif + + Endcase + + ENDPROC + + PROCEDURE createtoolbar + Local lcApp, lcFolder, loRunThor + lcApp = ThisForm.cThorFolder + 'Thor.App' + lcFolder = ThisForm.cThorFolder + 'Thor\' + loRunThor = Newobject ('Thor_Run', 'thor_run.vcx', '', lcApp, lcFolder) + loRunThor.AddProperty('cApplication', lcApp) + loRunThor.CreateToolBar() + + + ENDPROC + + PROCEDURE loadlist && Loads the ListView with tools + *============================================================================== + * Method: LoadList + * Purpose: Loads the ListView with tools + * Author: Doug Hennig + * Last revision: 04/23/2011 + * Parameters: none + * Returns: none + * Environment in: Thisform.oTools is a collection of ThorInfo objects + * Environment out: the ListView has been loaded with the registered tools + *============================================================================== + + local lnItems, ; + loTool, ; + laItems[1], ; + lcKey, ; + lnI, ; + lcPRGName, ; + loItem + + * First put the tools into an array so we can sort it as desired. + + *** DH 04/23/2011: added support for filter + lcFilter = upper(This.cToolFilter) + lnItems = 0 + Do while lnItems = 0 + for each loTool in Thisform.oTools + *** DH 04/23/2011: support filter + if empty(lcFilter) or ; + lcFilter $ upper(loTool.Prompt + loTool.Summary + loTool.Description + loTool.Category + loTool.Source) + lnItems = lnItems + 1 + dimension laItems[lnItems, 6] + *** JRN 4/20/2011 : Use .Summary, if possible + laItems[lnItems, 1] = loTool.Source + ': ' + ; + strextract(Evl(loTool.Summary,loTool.Description), '', chr(13), 1, 2) + laItems[lnItems, 2] = loTool.Prompt + laItems[lnItems, 3] = loTool.PRGName + laItems[lnItems, 4] = loTool.StatusBarText + laItems[lnItems, 5] = loTool.Source + str(loTool.Sort) + Evl(loTool.Summary, loTool.Description) + laItems[lnItems, 6] = loTool + endif empty(lcFilter) ... + next loTool + If lnItems = 0 + lcFilter = '' + EndIf + EndDo + asort(laItems, 5) + + * Save the selected item if the list is being reloaded. + + if vartype(This.oList.SelectedItem) = 'O' + lcKey = This.oList.SelectedItem.Key + endif vartype(This.oList.SelectedItem) = 'O' + + * Now load the list. + + with This.oList.ListItems + .Clear() + for lnI = 1 to lnItems + lcPRGName = laItems[lnI, 3] + loItem = .Add(, lcPRGName, laItems[lnI, 1]) + loItem.Tag = laItems[lnI, 6] + = seek(upper(lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + = seek(ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + loItem.SubItems(1) = trim(HotKeyDefinitions.Descript) + + = seek(upper(lcPRGName), 'StartUpTools', 'PRGName') + loItem.SubItems(2) = IIF(StartUpTools.Startup, 'Yes', '') + next lnI + endwith + + * Reselect the former item. + + if empty(lcKey) + This.SelectItem(This.oList.ListItems.Item(1)) + else + This.SelectItem(lcKey) + endif empty(lcKey) + + ENDPROC + + PROCEDURE otool_assign + Lparameters toTool + Local lcPRGName, lcPRGName60 + + If Vartype (toTool) = 'O' + + This.oTool = toTool + + lcPRGName = toTool.PRGName + + This.cPRGName = lcPRGName + This.cntToolInfo.otoolInfo.cPRGName = lcPrgName + + lcPRGName60 = Upper (Padr (lcPRGName, 60)) + = Seek (lcPRGName60, 'ToolHotKeyAssignments', 'PRGName') + = Seek (ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + = Seek (lcPRGName60, 'StartUpTools', 'PRGName') + = Seek (lcPRGName60, 'Favorites', 'PRGName') + + This.lcntToolInfoVisible = .T. + + Else + *!* * Removed 6/20/2012 / JRN + *!* lcPRGName = '' + *!* This.cPRGName = lcPRGName + *!* This.cntToolInfo.otoolInfo.cPRGName = lcPrgName + This.lcntToolInfoVisible = .F. + EndIf + + This.cntToolInfo.Refresh() + + ENDPROC + + PROCEDURE selectitem && Selects the specified item in the ListView + *============================================================================== + * Method: SelectItem + * Purpose: Selects the specified item in the ListView + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: tuItem - a node or a node key + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters loTool + + With This + .oTool = loTool + + If Not Thisform.lRefreshTools + .cntToolInfo.Refresh() + Endif Not Thisform.lRefreshTools + Endwith + + ENDPROC + + PROCEDURE cmdCreateTool.Click + This.Parent.CreateTool() + + ENDPROC + + PROCEDURE cmdCreateTool.Init + This.Caption = ccCREATE_TOOL + dodefault() + + ENDPROC + + PROCEDURE cmdOpenToolFolder.Click + Local lcPath + + lcPath = '"' + Thisform.oTools.Tag + 'My Tools\"' + Run /N "explorer" &lcPath + return + ENDPROC + + PROCEDURE cmdOpenToolFolder.Init + This.Caption = ccOPEN_TOOL_FOLDER + dodefault() + + ENDPROC + + PROCEDURE cntToolInfo.chkFavorite.InteractiveChange + Local lcPRGName + + lcPRGName = This.Parent.Parent.cPRGName + If Seek (Upper (lcPRGName), 'Favorites', 'PRGName') + Replace Startup With This.Value In Favorites + Else + Insert Into Favorites (PRGName, Startup) Values (lcPRGName, This.Value) + Endif + + + + ENDPROC + + PROCEDURE cntToolInfo.chkFavorite.Refresh + Local loTool + If Not Empty (This.Parent.Parent.cPRGName) + loTool = Thisform.oTools.Item (Upper (This.Parent.Parent.cPRGName)) + This.Value = Favorites.Startup + This.Enabled = .T. + This.Visible = .T. + Else + This.Value = .F. + This.Enabled = .F. + This.Visible = .T. + Endif + + DoDefault() + + + ENDPROC + + PROCEDURE cntToolInfo.chkStartup.InteractiveChange + Local lcPRGName + + lcPRGName = This.Parent.Parent.cPRGName + If Seek (Upper (lcPRGName), 'StartUpTools', 'PRGName') + Replace Startup With This.Value In StartUpTools + Else + Insert Into StartUpTools (PRGName, Startup) Values (lcPRGName, This.Value) + Endif + + + + ENDPROC + + PROCEDURE cntToolInfo.chkStartup.Refresh + Local loTool + If Not Empty (This.Parent.Parent.cPRGName) + loTool = Thisform.oTools.Item (Upper (This.Parent.Parent.cPRGName)) + If loTool.CanRunAtStartUp + This.Value = StartUpTools.Startup + This.Enabled = .T. + This.Visible = .T. + Else + This.Value = .F. + This.Enabled = .F. + This.Visible = .F. + Endif + Else + This.Value = .F. + This.Enabled = .F. + This.Visible = .T. + Endif + + DoDefault() + + + ENDPROC + + PROCEDURE cntToolInfo.chkToolBar.Refresh + Local lcPRGName, loTool + lcPRGName = This.Parent.Parent.cPRGName + If Not Empty (lcPRGName) + loTool = Thisform.oTools.Item (Upper (lcPRGName)) + = Seek (Upper (lcPRGName), 'ToolBarTools', 'PRGName') + This.Value = ToolBarTools.Enabled + This.Enabled = .T. + This.Visible = .T. + Else + This.Value = .F. + This.Enabled = .F. + This.Visible = .T. + Endif + + DoDefault() + + + ENDPROC + + PROCEDURE cntToolInfo.chkToolBar.Valid + Local lcPRGName, lcPrompt, lnMaxOrder + + lcPRGName = This.Parent.Parent.cPRGName + lcPrompt = This.Parent.Parent.oTool.Prompt + Calculate Max(Order + 1) To lnMaxOrder In ToolBarTools + If Seek (Upper (lcPRGName), 'ToolBarTools', 'PRGName') + Replace ; + Enabled With This.Value ; + ToolTip With lcPrompt ; + Order With lnMaxOrder ; + In ToolBarTools + Else + Insert Into ToolBarTools ; + (PRGName, Enabled, ToolTip, Order, Icon) Values ; + (lcPRGName, This.Value, lcPrompt, lnMaxOrder, ccThorIcon) + Endif + + If This.Value + This.Parent.Parent.ContextMenuForToolBar() + Endif + + This.Parent.cmdToolBarIcon.Refresh() + + This.Parent.Parent.CreateToolBar() + + + ENDPROC + + PROCEDURE cntToolInfo.cmdEditTool.Refresh + *!* if vartype(This.Parent.oList.SelectedItem) = 'O' + *!* This.cPRGName = This.Parent.oList.SelectedItem.Tag.FullFileName + *!* endif vartype(This.Parent.oList.SelectedItem) = 'O' + If Not Empty (This.Parent.Parent.cPRGName) + This.cPRGName = This.Parent.Parent.oTool.FullFileName + This.Enabled = .T. + Else + This.Enabled = .F. + Endif + ENDPROC + + PROCEDURE cntToolInfo.cmdEditTool.RightClick + *** DH 2018-04-01: new URL: https://github.com/VFPX/Thor/blob/master/Docs/Thor_tools_object.md + * tools home page = http://vfpx.codeplex.com/wikipage?title=thor%20tools%20object + Local loTools + loTools = Execscript (_Screen.cThorDispatcher, 'Class= tools from pemeditor') + loTools.EditSourceX (This.cPRGName) + ENDPROC + + PROCEDURE cntToolInfo.cmdRemoveTool.Click + Local lcPrgName + lcPrgName = This.Parent.Parent.cPRGName + If Not Empty (lcPrgName) + If Messagebox ('Remove this tool (' + lcPrgName + ')?', 35, 'Remove this tool?', 0) = 6 + If Thisform.oThor.RemoveTool (lcPrgName) + Messagebox ('Tool removed', 64, 'Removed', 0) + Else + Messagebox ('Unable to remove tool', 16, 'Failure', 0) + Endif + Endif + Endif + + ENDPROC + + PROCEDURE cntToolInfo.cmdRemoveTool.Refresh + Local loTool + If Not Empty (This.Parent.Parent.cPRGName) + loTool = Thisform.oTools.Item (Upper (This.Parent.Parent.cPRGName)) + If loTool.PrivateCopy # 0 + This.Enabled = .T. + This.Visible = .T. + Else + This.Enabled = .F. + This.Visible = .F. + Endif + Else + This.Enabled = .F. + This.Visible = .T. + Endif + + DoDefault() + + + ENDPROC + + PROCEDURE cntToolInfo.cmdToolBarIcon.Click + This.Parent.Parent.ContextMenuForToolBar() + Return + + + + #Define ccCaption 'Enter caption' + #Define ccPicture 'Select picture' + #Define ccDefault 'Default (Thor icon)' + + #Define ccTool 'Thor' + #Define ccKey 'Thor ToolBar Path' + + + *** DH 2018-04-10: new URL: https://github.com/VFPX/Thor/blob/master/Docs/Thor_framework_contextmenu.md + * ContextMenu home page = http://vfpx.codeplex.com/wikipage?title=Thor%20Framework%20ContextMenu + Local loContextMenu As ContextMenu Of 'C:\VISUAL FOXPRO\PROGRAMS\9.0\COMMON\Thor\Source\Thor_Menu.vcx' + Local lcCaption, lcCurdir, lcNewMethodName, lcPRGName, lcPath, lcPicture, loException, loForm + Local lxValue + + lcPRGName = This.Parent.Parent.cPRGName + = Seek(Upper(lcPRGName), 'ToolBarTools', 'PRGName') + lcCaption = Trim(ToolBarTools.Caption) + lcPicture = ToolBarTools.Icon + + Do case + Case not Empty(lcCaption) + lnMark = 1 + Case File(lcPicture) and Upper(JustFname(lcPicture)) # Upper(ccThorIcon) + lnMark = 2 + Otherwise + lnMark = 3 + endcase + + loContextMenu = Execscript(_Screen.cThorDispatcher, 'Class= ContextMenu') + + loContextMenu.AddMenuItem(ccCaption,,,,,,lnMark = 1) + loContextMenu.AddMenuItem(ccPicture,,,,,,lnMark = 2) + loContextMenu.AddMenuItem(ccDefault,,,,,,lnMark = 3) + + If Not loContextMenu.Activate() + Return + Endif + + Do Case + Case loContextMenu.Keyword = ccCaption + Private pcCaption + loForm = Execscript(_Screen.cThorDispatcher, 'Class= DynamicFormDeskTop') + pcCaption = lcCaption + + With loForm + .Caption = This.Parent.Parent.oTool.Prompt + .MinWidth = 275 + .MinHeight = 100 + .MinButton = .F. + .MaxButton = .F. + .BorderStyle = 2 + + .cHeading = '' + Endwith + + Text To loForm.cBodyMarkup Noshow Textmerge + pcCaption .class = 'TextBox' + .caption = 'Caption:' + .width = 200 + .Increment = 1 + | + Endtext + + loForm.Show(1) + + If 'O' = Vartype(loForm) And loForm.lSaveClicked + lcCaption = pcCaption + Else + Return .F. + Endif + + Case loContextMenu.Keyword = ccPicture + + lcPath = Execscript(_Screen.cThorDispatcher, 'Get Option=', ccKey, ccTool) + If Isnull(lcPath) + lcPath = Addbs(Home(1)) + 'Graphics' + Endif + + lcCurdir = Sys(5) + Curdir() + Try + Cd(lcPath) + Catch To loException + Endtry + + lcPicture = Getpict() + Cd(lcCurdir) + + If Empty(lcPicture) + Return + Endif + + lcCaption = '' + Execscript(_Screen.cThorDispatcher, 'Set Option=', ccKey, ccTool, Justpath(lcPicture)) + + Otherwise + + lcCaption = '' + lcPicture = ccThorIcon + + Endcase + + Replace ; + Icon With lcPicture ; + Caption With lcCaption ; + In ToolBarTools + + This.Refresh() + + + + ENDPROC + + PROCEDURE cntToolInfo.cmdToolBarIcon.Refresh + lcPRGName = This.Parent.Parent.cPRGName + If Not Empty (lcPRGName) + loTool = Thisform.oTools.Item (Upper (lcPRGName)) + = Seek (Upper (lcPRGName), 'ToolBarTools', 'PRGName') + This.Enabled = ToolBarTools.Enabled + This.Visible = ToolBarTools.Enabled + This.Picture = Trim(ToolBarTools.Icon) + This.Caption = Trim(ToolBarTools.Caption) + Else + This.Enabled = .F. + This.Visible = .F. + Endif + + DoDefault() + + + ENDPROC + + PROCEDURE cntToolInfo.cmdToolBarIcon.RightClick + Local lcPRGName + + lcPRGName = This.Parent.Parent.cPRGName + = Seek (Upper (lcPRGName), 'ToolBarTools', 'PRGName') + Replace Icon With 'Thor16.png' In ToolBarTools + This.Refresh() + + ENDPROC + + PROCEDURE cntToolInfo.Edittoolbutton1.Click + Thisform.RunTool(This.cPRGName) + + ENDPROC + + PROCEDURE cntToolInfo.Edittoolbutton1.Init + * no default + ENDPROC + + PROCEDURE cntToolInfo.Edittoolbutton1.Refresh + *!* if vartype(This.Parent.oList.SelectedItem) = 'O' + *!* This.cPRGName = This.Parent.oList.SelectedItem.Tag.FullFileName + *!* endif vartype(This.Parent.oList.SelectedItem) = 'O' + If Not Empty (This.Parent.Parent.cPRGName) + This.cPRGName = This.Parent.Parent.oTool.FullFileName + This.Enabled = .T. + Else + This.Enabled = .F. + Endif + ENDPROC + + PROCEDURE cntToolInfo.oHotKeyControls.onclearhotkey + * Remove the hotkey for the tool and update the list. + + local lcPRGName + lcPRGName = This.Parent.Parent.cPRGName + Thisform.oThor.RemoveToolHotKey(lcPRGName) + Thisform.Refresh() + + + ENDPROC + + PROCEDURE cntToolInfo.oHotKeyControls.onkeypressed + * Update the list. + + + ENDPROC + + PROCEDURE cntToolInfo.oHotKeyControls.onpreupdate + * Add a record to ToolHotKeyAssignments if necessary. + + local lcPRGName + lcPRGName = This.Parent.Parent.cPRGName + Thisform.oThor.AddToolHotKey(lcPRGName) + + ENDPROC + + PROCEDURE cntToolInfo.oHotKeyControls.Refresh + If Not Empty (This.Parent.Parent.cPRGName) + This.cHotKeyDescription = HotKeyDefinitions.Descript + This.Enabled = .T. + This.lOnKeyLabelOnly = This.Parent.Parent.oTool.OnKeyLabelOnly + + Else + This.cHotKeyDescription = '' + This.Enabled = .F. + Endif + DoDefault() + + ENDPROC + + PROCEDURE cntToolInfo.oToolInfo.edtToolInfo.When + * + ENDPROC + + PROCEDURE cntToolInfo.oToolInfo.Refresh + This.cPRGName = This.Parent.Parent.cPRGName + + + ENDPROC + + PROCEDURE cntToolInfo.Refresh + This.Visible = This.Parent.lcntToolInfoVisible + + ENDPROC + +ENDDEFINE + +DEFINE CLASS toolkeysold AS basecontainer OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdCreateTool" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdOpenToolFolder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Thor_sfsplitterh1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.oHotKeyControls" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.cmdEditTool" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.oToolInfo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.chkStartup" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cntToolInfo.cmdRemoveTool" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="SELECTTOOLFORBROWSING1" UniqueID="" Timestamp="" /> + + #INCLUDE "thor_ui.h" + * + *m: createtool + *m: loadlist && Loads the ListView with tools + *m: otool_assign + *m: selectitem && Selects the specified item in the ListView + *p: cprgname + *p: ctoolfilter && A filter for tools + *p: otool + * + + Anchor = 15 + cprgname = + ctoolfilter = && A filter for tools + Height = 260 + Name = "toolkeysold" + otool = .NULL. + Width = 630 + _memberdata = + + + + + + ADD OBJECT 'cmdCreateTool' AS basecommandbutton WITH ; + Anchor = 12, ; + Caption = "\ + + ADD OBJECT 'cmdOpenToolFolder' AS basecommandbutton WITH ; + Anchor = 12, ; + Caption = "\ + + ADD OBJECT 'cntToolInfo' AS basecontainer WITH ; + Anchor = 13, ; + Height = 235, ; + Left = 278, ; + Name = "cntToolInfo", ; + Top = 0, ; + Width = 351 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="container" /> + + ADD OBJECT 'cntToolInfo.chkStartup' AS basecheckbox WITH ; + Alignment = 0, ; + Anchor = 0, ; + Caption = "Run at startup?", ; + Left = 6, ; + Name = "chkStartup", ; + Top = 32 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'cntToolInfo.cmdEditTool' AS edittoolbutton WITH ; + Anchor = 8, ; + Left = 275, ; + Name = "cmdEditTool", ; + TabIndex = 5, ; + Top = 1 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cntToolInfo.cmdRemoveTool' AS basecommandbutton WITH ; + Anchor = 8, ; + Caption = "Remove Tool", ; + Height = 23, ; + Left = 255, ; + Name = "cmdRemoveTool", ; + TabIndex = 9, ; + Top = 28, ; + Width = 95 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cntToolInfo.oHotKeyControls' AS hotkeycontrols WITH ; + Anchor = 0, ; + calias = ToolHotKeyAssignments, ; + Left = 6, ; + Name = "oHotKeyControls", ; + TabIndex = 3, ; + Top = 1, ; + cmdClear.Name = "cmdClear", ; + cmdGetHotKey.Name = "cmdGetHotKey", ; + lblHotKey.Name = "lblHotKey", ; + txtHotKey.Name = "txtHotKey" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'cntToolInfo.oToolInfo' AS toolinfo WITH ; + Anchor = 15, ; + calias = ToolHotKeyAssignments, ; + Height = 177, ; + Left = 6, ; + Name = "oToolInfo", ; + TabIndex = 4, ; + Top = 54, ; + Width = 344, ; + edtToolInfo.Anchor = 15, ; + edtToolInfo.BackStyle = 0, ; + edtToolInfo.Height = 160, ; + edtToolInfo.IntegralHeight = .F., ; + edtToolInfo.Left = 0, ; + edtToolInfo.Name = "edtToolInfo", ; + edtToolInfo.ReadOnly = .T., ; + edtToolInfo.ScrollBars = 2, ; + edtToolInfo.SelectOnEntry = .F., ; + edtToolInfo.Top = 0, ; + edtToolInfo.Width = 343, ; + lblLink.Anchor = 4, ; + lblLink.Left = 0, ; + lblLink.Name = "lblLink", ; + lblLink.Top = 161, ; + lblOptions.Name = "lblOptions", ; + lblPlugIns.Name = "lblPlugIns", ; + lblVideo.Left = 215, ; + lblVideo.Name = "lblVideo", ; + lblVideo.Top = 161 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'SELECTTOOLFORBROWSING1' AS selecttoolforbrowsing WITH ; + Height = 260, ; + Left = 0, ; + Name = "SELECTTOOLFORBROWSING1", ; + Top = 0, ; + Width = 268, ; + Baselabel1.Left = 3, ; + Baselabel1.Name = "Baselabel1", ; + Baselabel1.Top = 5, ; + oTree.Height = 228, ; + oTree.Left = 1, ; + oTree.Name = "oTree", ; + oTree.Top = 30, ; + oTree.Width = 265, ; + txtcNewFilter.Height = 22, ; + txtcNewFilter.Left = 40, ; + txtcNewFilter.Name = "txtcNewFilter", ; + txtcNewFilter.Top = 1, ; + txtcNewFilter.Width = 118 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'Thor_sfsplitterh1' AS thor_sfsplitterh WITH ; + Anchor = 13, ; + cobject1name = SELECTTOOLFORBROWSING1, ; + cobject2name = cntToolInfo, ; + Height = 259, ; + Left = 268, ; + lshowgripper = .T., ; + Name = "Thor_sfsplitterh1", ; + nobject1minsize = 150, ; + nobject2minsize = 150, ; + Top = 1, ; + Visible = .T., ; + Width = 10, ; + ZOrderSet = 2, ; + GRIPPER.GRIPPERDOT1.Name = "GRIPPERDOT1", ; + GRIPPER.GRIPPERDOT1.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT1.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT1.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.GRIPPERDOT2.Name = "GRIPPERDOT2", ; + GRIPPER.GRIPPERDOT2.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT2.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT2.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.GRIPPERDOT3.Name = "GRIPPERDOT3", ; + GRIPPER.GRIPPERDOT3.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT3.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT3.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.GRIPPERDOT4.Name = "GRIPPERDOT4", ; + GRIPPER.GRIPPERDOT4.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT4.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT4.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.GRIPPERDOT5.Name = "GRIPPERDOT5", ; + GRIPPER.GRIPPERDOT5.SHAPEDARK.Name = "SHAPEDARK", ; + GRIPPER.GRIPPERDOT5.SHAPELIGHT.Name = "SHAPELIGHT", ; + GRIPPER.GRIPPERDOT5.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + GRIPPER.Name = "GRIPPER" + *< END OBJECT: ClassLib="thor_sf_splitter.vcx" BaseClass="container" /> + + PROCEDURE createtool + *============================================================================== + * Method: CreateTool + * Purpose: Creates a template PRG for a tool + * Author: Doug Hennig + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 05/21/2011 / JRN + * Parameters: none + * Returns: none + * Environment in: _System.vcx exists in the VFP FFC folder + * Environment out: a PRG specified by the user is created with template code. + *============================================================================== + + Local loPEME_Tools AS Object + Local loThorInfo AS 'ThorInfo' OF 'Thor_Utils' + Local lcCode, lcFile, lcFolder, lcTemplateFile, lcTemplateFolder + + **************************************************************** + lcFolder = Thisform.oTools.Tag + Do Form CreateTool With lcFolder, Thisform.FontSize, Thisform.oThor To lcFile + If Empty (lcFile) + Return + EndIf + + If '|' $ lcFile + lcTemplateFolder = Addbs (lcFolder) + ccMyTemplates + lcTemplateFile = lcTemplateFolder + '\' + Substr(lcFile, At('|', lcFile) + 1) + lcFile = Left(lcFile, At('|', lcFile) - 1) + Else + lcTemplateFile = '' + EndIf + + **************************************************************** + + *!* lcCD = Sys(5) + Curdir() + *!* loFile = Newobject ('_ComDlg', Home() + 'FFC\_System.vcx') + *!* loFile.AddFilter ('Program file (*.prg)', '*.prg') + *!* loFile.lSaveDialog = .T. + *!* loFile.cInitialDirectory = Thisform.oTools.Tag + *!* loFile.ShowDialog() + *!* Cd (lcCD) + *!* lcFile = Addbs (loFile.cFilePath) + loFile.cFileTitle + + Do Case + Case Empty (lcFile) + Case Upper (Juststem (lcFile)) # Upper (ccTOOLNAMEPREFIX) + Messagebox (ccTOOL_PREFIX_ERROR, MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + Case File (lcFile) + Messagebox (Strtran (ccALREADY_EXISTS, '%1', lcFile), ; + MB_OK + MB_ICONSTOP, ccTHOR_CAPTION) + Otherwise + *** JRN 2011-04-18 : Get sample code for new PRG from ThorInfo + loThorInfo = Newobject ('ThorInfo', 'Thor_Utils') + If Empty(lcTemplateFile ) + lcCode = loThorInfo.GetSampleToolCode() + Else + lcCode = FileToStr(lcTemplateFile) + EndIf + Strtofile (lcCode, lcFile) + Modify Command (lcFile) Nowait + *** JRN 2011-05-05 : Move / resize window + loPEME_Tools = Execscript (_Screen.cThorDispatcher, 'class= tools from pemeditor') + If 'O' = Vartype (loPEME_Tools) + loPEME_Tools.AddMRUFile (lcFile) + _oPEMEditor.oUtils.oIDEx.MoveWindow() + Endif + + Endcase + + ENDPROC + + PROCEDURE loadlist && Loads the ListView with tools + *============================================================================== + * Method: LoadList + * Purpose: Loads the ListView with tools + * Author: Doug Hennig + * Last revision: 04/23/2011 + * Parameters: none + * Returns: none + * Environment in: Thisform.oTools is a collection of ThorInfo objects + * Environment out: the ListView has been loaded with the registered tools + *============================================================================== + + local lnItems, ; + loTool, ; + laItems[1], ; + lcKey, ; + lnI, ; + lcPRGName, ; + loItem + + * First put the tools into an array so we can sort it as desired. + + *** DH 04/23/2011: added support for filter + lcFilter = upper(This.cToolFilter) + lnItems = 0 + Do while lnItems = 0 + for each loTool in Thisform.oTools + *** DH 04/23/2011: support filter + if empty(lcFilter) or ; + lcFilter $ upper(loTool.Prompt + loTool.Summary + loTool.Description + loTool.Category + loTool.Source) + lnItems = lnItems + 1 + dimension laItems[lnItems, 6] + *** JRN 4/20/2011 : Use .Summary, if possible + laItems[lnItems, 1] = loTool.Source + ': ' + ; + strextract(Evl(loTool.Summary,loTool.Description), '', chr(13), 1, 2) + laItems[lnItems, 2] = loTool.Prompt + laItems[lnItems, 3] = loTool.PRGName + laItems[lnItems, 4] = loTool.StatusBarText + laItems[lnItems, 5] = loTool.Source + str(loTool.Sort) + Evl(loTool.Summary, loTool.Description) + laItems[lnItems, 6] = loTool + endif empty(lcFilter) ... + next loTool + If lnItems = 0 + lcFilter = '' + EndIf + EndDo + asort(laItems, 5) + + * Save the selected item if the list is being reloaded. + + if vartype(This.oList.SelectedItem) = 'O' + lcKey = This.oList.SelectedItem.Key + endif vartype(This.oList.SelectedItem) = 'O' + + * Now load the list. + + with This.oList.ListItems + .Clear() + for lnI = 1 to lnItems + lcPRGName = laItems[lnI, 3] + loItem = .Add(, lcPRGName, laItems[lnI, 1]) + loItem.Tag = laItems[lnI, 6] + = seek(upper(lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + = seek(ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + loItem.SubItems(1) = trim(HotKeyDefinitions.Descript) + + = seek(upper(lcPRGName), 'StartUpTools', 'PRGName') + loItem.SubItems(2) = IIF(StartUpTools.Startup, 'Yes', '') + next lnI + endwith + + * Reselect the former item. + + if empty(lcKey) + This.SelectItem(This.oList.ListItems.Item(1)) + else + This.SelectItem(lcKey) + endif empty(lcKey) + + ENDPROC + + PROCEDURE otool_assign + Lparameters toTool + Local lcPRGName + + This.oTool = toTool + + If VarType (toTool) = 'O' + lcPRGName = toTool.PRGName + Else + lcPRGName = '' + Endif + + This.cPRGName = lcPRGName + + = Seek (Upper (lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + = Seek (ToolHotKeyAssignments.HotKeyID, 'HotKeyDefinitions', 'ID') + = Seek (Upper (lcPRGName), 'StartUpTools', 'PRGName') + + This.cntToolInfo.Refresh() + + ENDPROC + + PROCEDURE selectitem && Selects the specified item in the ListView + *============================================================================== + * Method: SelectItem + * Purpose: Selects the specified item in the ListView + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: tuItem - a node or a node key + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Lparameters loTool + + With This + .oTool = loTool + + If Not Thisform.lRefreshTools + .cntToolInfo.Refresh() + Endif Not Thisform.lRefreshTools + Endwith + + ENDPROC + + PROCEDURE cmdCreateTool.Click + This.Parent.CreateTool() + + ENDPROC + + PROCEDURE cmdCreateTool.Init + This.Caption = ccCREATE_TOOL + dodefault() + + ENDPROC + + PROCEDURE cmdOpenToolFolder.Click + Local lcPath + + lcPath = '"' + Thisform.oTools.Tag + 'My Tools\"' + Run /N "explorer" &lcPath + return + ENDPROC + + PROCEDURE cmdOpenToolFolder.Init + This.Caption = ccOPEN_TOOL_FOLDER + dodefault() + + ENDPROC + + PROCEDURE cntToolInfo.chkStartup.Init + This.Caption = ccSTARTUPCAPTION + ENDPROC + + PROCEDURE cntToolInfo.chkStartup.InteractiveChange + Local lcPRGName + + lcPRGName = This.Parent.Parent.cPRGName + If Seek (Upper (lcPRGName), 'StartUpTools', 'PRGName') + Replace Startup With This.Value In StartUpTools + Else + Insert Into StartUpTools (PRGName, Startup) Values (lcPRGName, This.Value) + Endif + + + + ENDPROC + + PROCEDURE cntToolInfo.chkStartup.Refresh + If Not Empty (This.Parent.Parent.cPRGName) + This.Value = StartUpTools.Startup + This.Enabled = .T. + Else + This.Value = .F. + This.Enabled = .F. + Endif + + DoDefault() + + ENDPROC + + PROCEDURE cntToolInfo.cmdEditTool.Refresh + *!* if vartype(This.Parent.oList.SelectedItem) = 'O' + *!* This.cPRGName = This.Parent.oList.SelectedItem.Tag.FullFileName + *!* endif vartype(This.Parent.oList.SelectedItem) = 'O' + If Not Empty (This.Parent.Parent.cPRGName) + This.cPRGName = This.Parent.Parent.oTool.FullFileName + This.Enabled = .T. + Else + This.Enabled = .F. + Endif + ENDPROC + + PROCEDURE cntToolInfo.cmdEditTool.RightClick + *** DH 2018-04-01: new URL: https://github.com/VFPX/Thor/blob/master/Docs/Thor_tools_object.md + * tools home page = http://vfpx.codeplex.com/wikipage?title=thor%20tools%20object + Local loTools + loTools = Execscript (_Screen.cThorDispatcher, 'Class= tools from pemeditor') + loTools.EditSourceX (This.cPRGName) + ENDPROC + + PROCEDURE cntToolInfo.cmdRemoveTool.Click + Local lcPrgName + lcPrgName = This.Parent.Parent.cPRGName + If Not Empty (lcPrgName) + If Messagebox ('Remove this tool (' + lcPrgName + ')?', 35, 'Remove this tool?', 0) = 6 + If Thisform.oThor.RemoveTool (lcPrgName) + Messagebox ('Tool removed', 64, 'Removed', 0) + Else + Messagebox ('Unable to remove tool', 16, 'Failure', 0) + Endif + Endif + Endif + + ENDPROC + + PROCEDURE cntToolInfo.oHotKeyControls.onclearhotkey + * Remove the hotkey for the tool and update the list. + + local lcPRGName + lcPRGName = This.Parent.Parent.cPRGName + Thisform.oThor.RemoveToolHotKey(lcPRGName) + + ENDPROC + + PROCEDURE cntToolInfo.oHotKeyControls.onkeypressed + * Update the list. + + + ENDPROC + + PROCEDURE cntToolInfo.oHotKeyControls.onpreupdate + * Add a record to ToolHotKeyAssignments if necessary. + + local lcPRGName + lcPRGName = This.Parent.Parent.cPRGName + Thisform.oThor.AddToolHotKey(lcPRGName) + + ENDPROC + + PROCEDURE cntToolInfo.oHotKeyControls.Refresh + If Not Empty (This.Parent.Parent.cPRGName) + This.cHotKeyDescription = HotKeyDefinitions.Descript + This.Enabled = .T. + Else + This.cHotKeyDescription = '' + This.Enabled = .F. + Endif + + DoDefault() + + ENDPROC + + PROCEDURE cntToolInfo.oToolInfo.edtToolInfo.When + * + ENDPROC + + PROCEDURE cntToolInfo.oToolInfo.Refresh + This.cPRGName = This.Parent.Parent.cPRGName + + + ENDPROC + + PROCEDURE cntToolInfo.Refresh + This.Visible = Not Empty (This.Parent.cPRGName) + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thor_utils.vc2 b/Thor/Source/thor_utils.vc2 new file mode 100644 index 00000000..ea27fd96 --- /dev/null +++ b/Thor/Source/thor_utils.vc2 @@ -0,0 +1,1120 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thor_utils.vcx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS findexe AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor.h" + * + *m: find + *m: updateexename + *p: _memberdata && XML Metadata for customizable properties + * + + Name = "findexe" + _memberdata = + + + && XML Metadata for customizable properties + + PROCEDURE find + Lparameters lcFileName + + Local lcFile As String ; + , llKeepTrying As Boolean ; + , lnResponse As Number + If File (lcFileName) + Return Fullpath (lcFileName) + Endif + + lnResponse = Messagebox (['] + lcFileName + [' not found. Search for it?], 4 + 32) + If lnResponse <> 6 + Return '' + Endif + + llKeepTrying = .T. + Do While llKeepTrying + Try + lcFile = Locfile (lcFileName) + If Upper (Right (lcFile, Len (lcFileName))) == Upper (lcFileName) + llKeepTrying = .F. + Else + Messagebox ('Not found: searching for ' + lcFileName, 16) + Endif + Catch + lcFile = '' + llKeepTrying = .F. + Endtry + Enddo + + Return lcFile + + ENDPROC + + PROCEDURE updateexename + Lparameters tcPRGFile, tcNewEXE + + Local lcBAKFile As String ; + , lcNewPRGText As String ; + , lcPRGFile As String ; + , lcPRGText As String ; + , lnLen As Number + + lcPRGFile = Forceext(tcPRGFile, 'PRG') + lcPRGText = Filetostr(lcPRGFile) + + lcBAKFile = Forceext(lcPRGFile, 'BKK') + Erase (lcBAKFile) + Strtofile(lcPRGText, lcBAKFile, 0) + + lnLen = At(ccCR, lcPRGText) + lcNewPRGText = [#Define ccExecutable '] + tcNewEXE + ['] + Substr(lcPRGText, lnLen) + + Erase (lcPRGFile) + Strtofile(lcNewPRGText, Forceext(lcPRGFile, 'PRG'), 0) + + ENDPROC + +ENDDEFINE + +DEFINE CLASS hotkey AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor_ui.h" + * + *m: createmacro && Creates the binary code for a single macro + *m: findhotkeybyscancode && Finds the hot key by the scan code + *m: gethotkeydescription && Gets the descriptive name for the hotkey + *m: getkeycode && Returns the 2-byte macro key code for the specified key + *m: getkeystate && Sets lShift, lCtrl, and lAlt based on the current key state + *m: getmodifiersvalue && Gets the state of the modifiers as a binary value + *m: getscancode + *m: getshifts + *m: isvalid && Returns .T. if the hotkey is valid + *p: ckey && The hot key name + *p: lalt && .T. if Alt is used + *p: lctrl && .T. if Ctrl is used + *p: lshift && .T. if Shift is used + *p: nscancode && The scan code for the key + *p: _memberdata && XML Metadata for customizable properties + * + + ckey = && The hot key name + lalt = .F. && .T. if Alt is used + lctrl = .F. && .T. if Ctrl is used + lshift = .F. && .T. if Shift is used + Name = "hotkey" + nscancode = 0 && The scan code for the key + Width = 17 + _memberdata = + + + + + + + + + + + + + + + && XML Metadata for customizable properties + + PROCEDURE createmacro && Creates the binary code for a single macro + *============================================================================== + * Method: CreateMacro + * Purpose: Creates the binary code for a single macro + * Author: Doug Hennig + * Last revision: 03/23/2011 + * Parameters: tcMacroName - the name of the macro + * tcCommand - the command to execute + * Returns: the binary code for the macro + * Environment in: see This.GetKeyCode for requirements + * Environment out: none + * Notes: + * To create a macro file, use code like this: + * + * lcMacros = chr(0xFF) + chr(0x79) + ; + replicate(chr(32), 13) + chr(0) + ; + chr(1) + chr(0) + ; + CreateMacro(KeyCode1, Modifier1, Name1, Code1) + ; + CreateMacro(KeyCode2, Modifier2, Name2, Code2) + ; + etc. + * + * where CHR(1) is the count of the number of macros in the file (if more than + * 255, update following byte as well). Then use the following to create the + * macro file and immediately load it so the macros are available for PLAY + * MACRO: + * + * SAVE MACROS lcMacros TO SomeFile.FKY + * RESTORE MACROS FROM SomeFile.FKY + *============================================================================== + + lparameters tcMacroName, ; + tcCommand + local lcKeyCode, ; + lcCode, ; + lcMacro, ; + lcMacros, ; + lnI + lcKeyCode = This.GetKeyCode() + if not isnull(lcKeyCode) + *** this ends with CHR(13) so it executes + lcCode = tcCommand + chr(13) + lcMacro = padr(trim(tcMacroName), 20, chr(0)) + ; + chr(len(lcCode)) + chr(0) + ; + lcKeyCode + lcMacros = '' + for lnI = 1 to len(lcCode) + lcMacros = lcMacros + substr(lcCode, lnI, 1) + chr(0) + next lnI + else + lcMacros = .NULL. + endif not isnull(lcKeyCode) + return lcMacros + + ENDPROC + + PROCEDURE findhotkeybyscancode && Finds the hot key by the scan code + *============================================================================== + * Method: FindHotKeyByScanCode + * Purpose: Finds the hot key by the scan code + * Author: Doug Hennig + * Last revision: 03/16/2011 + * Parameters: none + * Returns: .T. if the hot key was found + * Environment in: HotKeys is open + * This.nScanCode is set to the scan code for the key + * Environment out: HotKeys is positioned to the record for the hot key if + * found or EOF if not + * This.cKey is set to the key name if found + *============================================================================== + + llFound = seek(This.nScanCode, 'HotKeys', 'ScanCode') + if llFound + This.cKey = trim(HotKeys.Key) + endif llFound + return llFound + + ENDPROC + + PROCEDURE gethotkeydescription && Gets the descriptive name for the hotkey + *============================================================================== + * Method: GetHotKeyDescription + * Purpose: Gets the descriptive name for the hotkey + * Author: Doug Hennig + * Last revision: 03/17/2011 + * Parameters: none + * Returns: the descriptive name for the hotkey + * Environment in: This.lShift, lCtrl, and lAlt are .T. if those modifier keys + * are used + * This.cKey contains the descriptive name of the key + * Environment out: none + *============================================================================== + + local lcDescrip + with This + lcDescrip = iif(.lShift, ccSHIFT, '') + iif(.lCtrl, ccCTRL, '') + ; + iif(.lAlt, ccALT, '') + .cKey + endwith + return lcDescrip + + ENDPROC + + PROCEDURE getkeycode && Returns the 2-byte macro key code for the specified key + *============================================================================== + * Method: GetKeyCode + * Purpose: Returns the 2-byte macro key code for the specified key + * Author: Doug Hennig + * Last revision: 03/20/2011 + * Parameters: none + * Returns: the 2-byte macro key code for the specified key or .NULL. + * if we can't create a macro key code + * Environment in: This.nScanCode, lShift, lCtrl, and lAlt are set + * appropriately + * HotKeys is open + * Environment out: see This.FindHotKeyByScanCode + *============================================================================== + + local llFound, ; + lcReturn + + * Find the record for the keypress. + + lnShiftAltCtrl = This.GetModifiersValue() + llFound = This.FindHotKeyByScanCode() + do case + + * Return NULL if we can't find or create a macro for that key. + + case not llFound or ; + (lnShiftAltCtrl = cnNO_MODIFIER and HotKeys.BareKey = -1) or ; + (lnShiftAltCtrl = cnSHIFT and HotKeys.ShKey = -1) or ; + (lnShiftAltCtrl = cnCTRL and HotKeys.CtKey = -1) or ; + (lnShiftAltCtrl = cnALT and HotKeys.AltKey = -1) or ; + (lnShiftAltCtrl = cnSHIFT + cnCTRL and HotKeys.ShCtKey = -1) or ; + (lnShiftAltCtrl = cnSHIFT + cnALT and HotKeys.ShAltKey = -1) or ; + (lnShiftAltCtrl = cnCTRL + cnALT and HotKeys.CtAltKey = -1) or ; + (lnShiftAltCtrl = cnSHIFT + cnCTRL + cnALT and HotKeys.ShCtAltKey = -1) + lcReturn = .NULL. + + * Return the appropriate key code for the key. + + case lnShiftAltCtrl = cnNO_MODIFIER + lcReturn = chr(HotKeys.BareCode) + chr(HotKeys.BareKey) + case lnShiftAltCtrl = cnSHIFT + lcReturn = chr(HotKeys.ShCode) + chr(HotKeys.ShKey) + case lnShiftAltCtrl = cnCTRL + lcReturn = chr(HotKeys.CtCode) + chr(HotKeys.CtKey) + case lnShiftAltCtrl = cnALT + lcReturn = chr(HotKeys.AltCode) + chr(HotKeys.AltKey) + case lnShiftAltCtrl = cnSHIFT + cnCTRL + lcReturn = chr(HotKeys.ShCtCode) + chr(HotKeys.ShCtKey) + case lnShiftAltCtrl = cnSHIFT + cnALT + lcReturn = chr(HotKeys.AltCode) + chr(HotKeys.ShAltKey) + case lnShiftAltCtrl = cnCTRL + cnALT + lcReturn = chr(HotKeys.AltCode) + chr(HotKeys.CtAltKey) + otherwise + lcReturn = chr(HotKeys.AltCode) + chr(HotKeys.ShCtAltKey) + endcase + return Evl(lcReturn, '??') + + + ENDPROC + + PROCEDURE getkeystate && Sets lShift, lCtrl, and lAlt based on the current key state + *============================================================================== + * Method: GetKeyState + * Purpose: Sets lShift, lCtrl, and lAlt based on the current key state + * Author: Doug Hennig + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 03/16/2011 + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: This.lShift, lCtrl, and lAlt are set based on whether those + * keys are currently held down + *============================================================================== + + with This + .lShift = GetKeyState(VK_SHIFT) > 65000 + .lCtrl = GetKeyState(VK_CONTROL) > 65000 + .lAlt = GetKeyState(VK_MENU) > 65000 + endwith + + ENDPROC + + PROCEDURE getmodifiersvalue && Gets the state of the modifiers as a binary value + *============================================================================== + * Method: GetModifiersValue + * Purpose: Gets the state of the modifiers as a binary value + * Author: Doug Hennig + * Last revision: 03/17/2011 + * Parameters: none + * Returns: the state of the modifiers as a binary value + * Environment in: This.lShift, lCtrl, and lAlt are set appropriately + * Environment out: none + *============================================================================== + + local lnState + with This + lnState = iif(.lShift, cnSHIFT, cnNO_MODIFIER) + ; + iif(.lCtrl, cnCTRL, cnNO_MODIFIER) + ; + iif(.lAlt, cnALT, cnNO_MODIFIER) + endwith + return lnState + + ENDPROC + + PROCEDURE getscancode + *============================================================================== + * Method: GetScanCode + * Purpose: Returns the scan code corresponding to a key code + * Author: Jim Nelson + * Last revision: 06/17/2011 JRN + * Parameters: tnKeyCode + * Returns: ScanCode; 0 if not found + * Environment in: This.nScanCode, lShift, lCtrl, and lAlt are set + * appropriately + * HotKeys is open + * Environment out: Current record in HotKeys now aligned with the match + *============================================================================== + + Lparameters tnKeyCode + + Select HotKeys + Do Case + Case This.lAlt + Locate For altcode = tnKeyCode + Case This.lCtrl + Locate For Ctcode = IIF(tnKeyCode # 127, tnKeyCode, 8) + Case This.lShift + Locate For ShCode = tnKeyCode + Otherwise + Locate For KeyCode = tnKeyCode + Endcase + + If Found() + Return ScanCode + Else + Return 0 + Endif + ENDPROC + + PROCEDURE getshifts + *============================================================================== + * Method: GetShifts + * Purpose: Returns shiftstate (sum of different shift keys) + * Author: Jim Nelson + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 06/17/2011 JRN + * Parameters: none + * Returns: none + * Environment in: none + * Environment out: none + *============================================================================== + + Return IIf (This.lShift, 1, 0) ; + + IIf (This.lCtrl, 2, 0) ; + + IIf (This.lAlt, 4, 0) + + ENDPROC + + PROCEDURE Init + * Open the HotKeys table if necessary. + + if not used('HotKeys') + use HotKeys in 0 + endif not used('HotKeys') + + * Declare Windows API functions we need. + + declare integer GetKeyState in Win32API integer vKey + + ENDPROC + + PROCEDURE isvalid && Returns .T. if the hotkey is valid + *============================================================================== + * Method: IsValid + * Purpose: Returns .T. if the hotkey is valid + * Author: Doug Hennig + * Copyright: (c) 2011 Stonefield Systems Group Inc. + * Last revision: 04/09/2011 + * Parameters: tlOKL - .T. if this is used for ON KEY LABEL + * Returns: .T. if the hotkey is valid + * Environment in: This.nScanCode, lShift, lCtrl, and lAlt are set as + * necessary + * see This.FindHotKeyByScanCode for others + * Environment out: see This.FindHotKeyByScanCode + *============================================================================== + + lparameters tlOKL + with This + llReturn = .FindHotKeyByScanCode() + do case + case not llReturn + case tlOKL and ((.lShift and .lCtrl) or (.lShift and .lAlt) or ; + (.lCtrl and .lAlt)) + && don't allow combinations of modifiers for ON KEY LABEL + llReturn = .F. + case .lShift and .lCtrl and .lAlt + llReturn = HotKeys.ShCtAltKey > 0 + case .lShift and .lCtrl + llReturn = HotKeys.ShCtKey > 0 + case .lShift and .lAlt + llReturn = HotKeys.ShAltKey > 0 + case .lCtrl and .lAlt + llReturn = HotKeys.CtAltKey > 0 + case .lShift + llReturn = HotKeys.ShKey > 0 + case .lCtrl + llReturn = HotKeys.CtKey > 0 + case .lAlt + llReturn = HotKeys.AltKey > 0 + otherwise + llReturn = HotKeys.BareCode > 0 + endcase + endwith + return llReturn + + ENDPROC + +ENDDEFINE + +DEFINE CLASS idewindowsevents AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: eventhandler && Handles the Windows events we're bound to + *m: findideclientwindow && Finds the client window of the IDE window with the specified caption + *m: findidewindow && Finds an IDE window by caption + *p: ccaption && The caption of the window to capture events for + *p: noldproc && The former Windows event handler + *p: _memberdata && XML Metadata for customizable properties + * + + ccaption = && The caption of the window to capture events for + Name = "idewindowsevents" + noldproc = 0 && The former Windows event handler + Width = 17 + _memberdata = + + + + + + && XML Metadata for customizable properties + + PROCEDURE eventhandler && Handles the Windows events we're bound to + *============================================================================== + * Method: EventHandler + * Purpose: Handles the Windows events we're bound to + * Author: Doug Hennig + * Last revision: 03/17/2011 + * Parameters: hWnd - the hWnd for the window the event is for + * Msg - the event ID + * wParam - parameter about the event + * lParam - additional parameter about the event + * Returns: none + * Environment in: This.nOldProc has been set to the former Windows event + * handler + * the Windows API function CallWindowProc has been declared + * Environment out: the former Windows event handler has been called + *============================================================================== + + lparameters hWnd, ; + Msg, ; + wParam, ; + lParam + return CallWindowProc(This.nOldProc, hWnd, Msg, wParam, lParam) + + ENDPROC + + PROCEDURE findideclientwindow && Finds the client window of the IDE window with the specified caption + *============================================================================== + * Method: FindIDEClientWindow + * Purpose: Finds the client window of the IDE window with the + * specified caption + * Author: Doug Hennig + * Last revision: 03/17/2011 + * Parameters: tcCaption - the caption of the IDE window + * Returns: the window's hWnd if it was found or 0 if not + * Environment in: none + * Environment out: see This.FindIDEWindow + *============================================================================== + + lparameters tcCaption + local lnhWnd, ; + lnwHandle, ; + lnwChild + lnhWnd = This.FindIDEWindow(tcCaption) + if lnhWnd > 0 + lnwHandle = sys(2326, lnhWnd) + lnwChild = sys(2325, lnwHandle) + lnhWnd = sys(2327, lnwChild) + endif lnhWnd > 0 + return lnhWnd + + ENDPROC + + PROCEDURE findidewindow && Finds an IDE window by caption + *============================================================================== + * Method: FindIDEWindow + * Purpose: Finds an IDE window by caption + * Author: Doug Hennig + * Last revision: 03/17/2011 + * Parameters: tcCaption - the caption of the IDE window + * Returns: the window's hWnd if it was found or 0 if not + * Environment in: the Windows API functions FindWindowEx and GetWindowText + * have been declared + * Environment out: This.cCaption is set to tcCaption + *============================================================================== + + lparameters tcCaption + local lnhWnd, ; + lnhChild, ; + lcCaption + This.cCaption = tcCaption + lnhWnd = _screen.hWnd + lnhChild = 0 + do while .T. + lnhChild = FindWindowEx(lnhWnd, lnhChild, 0, 0) + if lnhChild = 0 + exit + endif lnhChild = 0 + lcCaption = space(80) + GetWindowText(lnhChild, @lcCaption, len(lcCaption)) + lcCaption = upper(left(lcCaption, at(chr(0), lcCaption) - 1)) + if lcCaption = upper(tcCaption) + exit + endif lcCaption = upper(tcCaption) + enddo while .T. + return lnhChild + + ENDPROC + + PROCEDURE Init + #define GWL_WNDPROC -4 + + declare integer GetWindowLong in Win32API ; + integer hWnd, integer nIndex + declare integer CallWindowProc in Win32API ; + integer lpPrevWndFunc, integer hWnd, integer Msg, integer wParam, ; + integer lParam + declare integer FindWindowEx in Win32API; + integer, integer, string, string + declare integer GetWindowText in Win32API ; + integer, string @, integer + This.nOldProc = GetWindowLong(_screen.hWnd, GWL_WNDPROC) + + ENDPROC + +ENDDEFINE + +DEFINE CLASS thorinfo AS custom + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "thor.h" + * + *m: addquotes + *m: addthorproperty + *m: appname_assign + *m: clear && Blanks out all properties + *m: fullappname_assign + *m: getsampleselfregistercode + *m: getsampletoolcode + *m: register && Creates a PRG and registers it with Thor, using the values of the properties in this class. + *p: appname + *p: author + *p: bloglink + *p: blogname + *p: canrunatstartup + *p: category + *p: changeloglink + *p: changelogname + *p: classdefinitions + *p: classes && List of classes to be published for this APP, separated by commas. e.g., 'thorinfo of thor_utils' + *p: code && Code that will be run for this Tool. May be multiple lines, separated by CRs + *p: definestatements + *p: description && The tool's full description; may be as long as needed, and may include CRs, etc. Also used for .Summary if .Summary is blank. REQUIRED. + *p: foldername + *p: forumlink + *p: forumname + *p: fullappname + *p: fullfilename + *p: internalsort + *p: link && A link to a Web page for the tool + *p: onkeylabelonly + *p: optionclasses && The name of the main APP file, without the path (e.g., GoFish4.App) + *p: optiontool + *p: pluginclasses + *p: plugins + *p: prgname && The name of the PRG to run the tool + *p: privatecopy + *p: prompt && The default prompt for the tool in menus. REQUIRED + *p: sort && The sort order; used to sort tools that all have the same Source. + *p: source && The tool's source (e.g., 'PEM Editor' or 'GoFish4') + *p: statusbartext && The status bar text for the menu item for the tool. If empty, .Summary or the first line of .Description is used. + *p: subcategory && The name of the main APP file, without the path (e.g., GoFish4.App) + *p: summary && A one-line summary for the tool. If left blank, the first line from .Description is used. + *p: updateprg + *p: version && The version number + *p: versionfileurl + *p: versionlocalfilename + *p: videolink + *p: _memberdata && XML Metadata for customizable properties + * + + appname = + author = + bloglink = + blogname = + canrunatstartup = .T. + category = + changeloglink = + changelogname = + classdefinitions = + classes = && List of classes to be published for this APP, separated by commas. e.g., 'thorinfo of thor_utils' + code = && Code that will be run for this Tool. May be multiple lines, separated by CRs + definestatements = + description = && The tool's full description; may be as long as needed, and may include CRs, etc. Also used for .Summary if .Summary is blank. REQUIRED. + foldername = + forumlink = + forumname = + fullappname = + fullfilename = + internalsort = + link = && A link to a Web page for the tool + Name = "thorinfo" + onkeylabelonly = .F. + optionclasses = && The name of the main APP file, without the path (e.g., GoFish4.App) + optiontool = .F. + pluginclasses = + plugins = .F. + prgname = && The name of the PRG to run the tool + privatecopy = 0 + prompt = && The default prompt for the tool in menus. REQUIRED + sort = 0 && The sort order; used to sort tools that all have the same Source. + source = && The tool's source (e.g., 'PEM Editor' or 'GoFish4') + statusbartext = && The status bar text for the menu item for the tool. If empty, .Summary or the first line of .Description is used. + subcategory = && The name of the main APP file, without the path (e.g., GoFish4.App) + summary = && A one-line summary for the tool. If left blank, the first line from .Description is used. + updateprg = .F. + version = && The version number + versionfileurl = + versionlocalfilename = + videolink = + Width = 17 + _memberdata = + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + && XML Metadata for customizable properties + + PROCEDURE addquotes + Lparameters tcText + + Local lcText + + If 'C' # Vartype(tcText) + Return [''] + EndIf + + lcText = Alltrim(tcText) + + If Len (lcText) > 250 + lcText = QuotesAroundLongText (Left (lcText, 250)) + ';' + Chr(13) + Space(9) + '+' + QuotesAroundLongText (Substr (lcText, 251)) + Return lcText + Endif + + lcText = Strtran (lcText, ccLF, []) + lcText = Strtran (lcText, ['], [' + "'" + ']) + lcText = Strtran (lcText, ccCR, [' + Chr(13) + ']) + lcText = ['] + lcText + ['] + lcText = Strtran (lcText, ['' + ], []) + lcText = Strtran (lcText, [ + ''], []) + Return lcText + + + ENDPROC + + PROCEDURE addthorproperty + #Define ccSkipThisMarker '*&*&' + #Define cnNameWidth 18 + #Define ccIndentation ccTab + ccTab + + Lparameters tcPropertyName, tcDescription, txDefault + + Local lcComments, lcName, lcResult, lxValue + lxValue = Getpem(This, tcPropertyName) + lcName = Padr(tcPropertyName, cnNameWidth) + lcComments = Iif(Empty(tcDescription), '', ' &' + '& ' + tcDescription) + + Do Case + Case 'L' = Vartype(lxValue) + If lxValue # txDefault + lcResult = '.' + lcName + ' = ' + Transform(lxValue) + lcComments + Else + Return ccSkipThisMarker + Endif + + Case Empty(lxValue) + Return ccSkipThisMarker + + Case 'N' = Vartype(lxValue) + lcResult = '.' + lcName + ' = ' + Transform(lxValue) + lcComments + + Case ccTab $ lxValue ; + Or ccCR $ lxValue ; + Or ccLF $ lxValue ; + Or ['] $ lxValue + lcResult = '#@@@#Text to .' + tcPropertyName + ' NoShow' + lcComments ; + + ccCRLF + lxValue ; + + ccCRLF + '#@@@#EndText' + + Case Len(lxValue) > 250 + lcResult = '#@@@#Text to .' + tcPropertyName + ' NoShow' + lcComments ; + + ccCRLF + This.AddQuotes(lxValue) ; + + ccCRLF + '#@@@#EndText' + + Otherwise + lcResult = '.' + lcName + [ = '] + Trim(lxValue, 1, ' ', ccTab) + ['] + lcComments + + Endcase + + Return ccIndentation + lcResult + + + ENDPROC + + PROCEDURE appname_assign + Lparameters tAPPName + + Local lcExec, lnI + + With This + .APPName = tAPPName + If Empty (This.FullAppName) + .FullAppName = '' + .FolderName = '' + + If Not Empty (tAPPName) + For lnI = 1 To 100 + lcExec = Sys(16, lnI) + Do Case + Case Empty (lcExec) + Exit + Case Upper (.APPName) $ Upper (lcExec) + .FullAppName = lcExec + .FolderName = Justpath (lcExec) + Exit + Endcase + Endfor && lnI = 1 to 100 + Endif && not Empty(This.APPName) + Endif + Endwith && this + + + ENDPROC + + PROCEDURE clear && Blanks out all properties + With This + .AppName = '' + .Author = '' + .Category = '' + .ClassDefinitions = '' + .Classes = '' + .Code = '' + .Description = '' + .FolderName = '' + .FullAppName = '' + .FullFileName = '' + .InternalSort = '' + .Link = '' + .OnKeyLabelOnly = .F. + .OptionClasses = '' + .OptionTool = '' + .PRGName = '' + .Prompt = '' + .Sort = 0 + .Source = '' + .StatusBarText = '' + .SubCategory = '' + .Summary = '' + .Version = '' + Endwith + + ENDPROC + + PROCEDURE fullappname_assign + Lparameters tFullAppName + + With This + .FullAppName = tFullAppName + If Empty (This.AppName) + .AppName = Justfname (tFullAppName) + .FolderName = Justpath (tFullAppName) + Endif + Endwith + + ENDPROC + + PROCEDURE getsampleselfregistercode + Local lcCode + + Text To lcCode Noshow Textmerge + Try + loThorInfo = ExecScript(_screen.cThorDispatcher,'Thor Register=') + Catch + loThorInfo = .Null. + EndTry + + If IsNull(loThorInfo) + Return .F. + EndIf + + With loThorInfo + * Required + .Prompt = 'Prompt for the tool' && used when tool appears in a menu + .Description = 'Description for the tool' && may be lengthy, including CRs, etc + .PRGName = 'Thor_Tool_??????' && a unique name for the tool; note the required prefix + + .AppName = 'The name of the executable' && no path, but include the extension; for example, GoFish4.App + * Note that this creates This.FullAppName, which determines the full path of the APP + * and also This.FolderName + + lcFolderName = .FolderName + lcFullAppName = .FullAppName + + <<'Text to .Code noshow textmerge'>> + * Put your executable code for the tool here. It may be as long as needed, or just a single line. + * Within this code, you can refer to the installed APP (with its full path), by using '<>' + * and the full path by using '<>' + * Notice the use of quotes, in case the folder name has spaces. + *For example: + Do '|lcFullAppName|' + <<'EndText'>> + + * Optional + .StatusBarText = 'Status bar text for the menu item' + .Summary = 'One-line summary for the tool' && if empty, first line of .Description is used + .Classes = "List of classes to be published for this APP" &&, separated by commas. e.g., 'thorinfo of thor_utils' + + * For public tools, such as PEM Editor, etc. + .Source = 'Name of the tool' && e.g., 'PEM Editor' + .Version = 'Version number' && e.g., 'Version 7, May 18, 2011' + .Sort = 100 && the sort order for all items from the same .Source + .Link = 'http://www.mywebsite.com' + + .Register() + + EndWith + Endtext + + lcCode = Strtran(lcCode, '|lcFullAppName|', '<>') + Return lcCode + ENDPROC + + PROCEDURE getsampletoolcode + Local lcCode + + text to lcCode noshow + Lparameters lxParam1 + + **************************************************************** + **************************************************************** + * Standard prefix for all tools for Thor, allowing this tool to + * tell Thor about itself. + + If Pcount() = 1 ; + And 'O' = Vartype (lxParam1) ; + And 'thorinfo' == Lower (lxParam1.Class) + + With lxParam1 + + * Required + .Prompt = 'Prompt for the tool' && used in menus + + * Optional + @@@Text to .Description NoShow && a description for the tool + Enter a description for the tool here + @@@EndText + .StatusBarText = '' + .CanRunAtStartUp = .T. + + * These are used to group and sort tools when they are displayed in menus or the Thor form + .Source = '' && where did this tool come from? Your own initials, for instance + .Category = '' && creates categorization of tools; defaults to .Source if empty + .Sort = 0 && the sort order for all items from the same Category + + * For public tools, such as PEM Editor, etc. + .Version = '' && e.g., 'Version 7, May 18, 2011' + .Author = '' + .Link = '' && link to a page for this tool + .VideoLink = '' && link to a video for this tool + + Endwith + + Return lxParam1 + Endif + + If Pcount() = 0 + Do ToolCode + Else + Do ToolCode With lxParam1 + Endif + + Return + + **************************************************************** + **************************************************************** + * Normal processing for this tool begins here. + Procedure ToolCode + Lparameters lxParam1 + + EndProc + + endtext + + + Return Strtran(lcCode, '@@@', '') + + + ENDPROC + + PROCEDURE register && Creates a PRG and registers it with Thor, using the values of the properties in this class. + * Note use of '#@@@#' for multi-layers Text/EndText + + Lparameters tlRunThor + + Local lcCode, lcExec, lcExecutable, lcFolder, lcFullAPPName, lcOldCode, lcPRG, llReplace, lnI + + lcExecutable = This.Code + + *** JRN 2011-04-27 : AppName assigned, but not found? + If(Not Empty(This.APPName)) And Empty(This.FolderName) + Return .F. + Endif + + Text To lcCode Noshow Textmerge + Lparameters lxParam1 + + **************************************************************** + **************************************************************** + * Standard prefix for all tools for Thor, allowing this tool to + * tell Thor about itself. + + If Pcount() = 1 ; + And 'O' = Vartype (lxParam1) ; + And 'thorinfo' = Lower (lxParam1.Class) + + With lxParam1 + + * Required + <> + <> + <> + + * Optional + <> + <> + <> + <> + <> + <> + <> + <> + <> + <> + + * For public tools, such as PEM Editor, etc. + <> + <> + <> + <> + <> + <> + <> + <> + <> + <> + <> + <> + <> + Endwith + + Return lxParam1 + Endif + + If Pcount() = 0 + Do ToolCode + Else + Do ToolCode With lxParam1 + Endif + + Return + + **************************************************************** + **************************************************************** + * Normal processing for this tool begins here. + Procedure ToolCode + Lparameters lxParam1 + <> + EndProc + + Endtext + + If Not Empty(This.DefineStatements) + lcCode = This.DefineStatements + Chr(13) + Chr(10) + Chr(13) + Chr(10) + lcCode + EndIf + + If Not Empty(This.ClassDefinitions) + lcCode = lcCode + Chr(13) + Chr(10) + Chr(13) + Chr(10) + This.ClassDefinitions + EndIf + + lcFolder = Execscript(_Screen.cThorDispatcher, 'Tool Folder=') + lcCode = '* Registered with Thor: ' + Ttoc(datetime()) + Chr(13) + Chr(10) + lcCode + + lcCode = Strtran(lcCode, '#@@@#', '') + lcCode = Strtran(lcCode, ccCR + '*&*&', '') + lcCode = Strtran(lcCode, ccCRLF + '*&*&', '') + + lcPRG = Addbs(lcFolder) + Forceext(This.PRGName, '.PRG') + + llReplace = .T. + + If File(lcPRG) + lcOldCode = Filetostr(lcPRG) + If lcCode = '*' ; + And lcOldCode = '*' ; + And Substr(lcCode, At(Chr[13], lcCode)) == ; + Substr(lcOldCode, At(Chr[13], lcOldCode)) + llReplace = .F. + Endif + Endif + + If llReplace + Strtofile(lcCode, lcPRG, 0) + Endif + + If tlRunThor + Execscript(_Screen.cThorDispatcher, 'Run') + Endif + + Return + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thorformruntool.sc2 b/Thor/Source/thorformruntool.sc2 new file mode 100644 index 00000000..561d6c28 --- /dev/null +++ b/Thor/Source/thorformruntool.sc2 @@ -0,0 +1,369 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thorformruntool.scx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +#INCLUDE "thor_ui.h" + +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="2" /> + + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + +ENDDEFINE + +DEFINE CLASS formruntool1 AS formruntool OF "thor_ui.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="lblLink" UniqueID="" Timestamp="" /> + + * + *m: resetalldefaults + *m: resizeform + *p: lduringforminit + *p: lhiderightside + *p: nhiddenwidth + *p: ntoolkeys1margin + * + + Caption = "Tool Launcher" + DoCreate = .T. + HalfHeightCaption = .T. + Height = 202 + lduringforminit = .F. + lhiderightside = .F. + MaxButton = .F. + MinButton = .F. + Name = "Formruntool1" + nhiddenwidth = 0 + ntoolkeys1margin = 0 + Width = 522 + _memberdata = + + + + + + + + + + Basecheckbox1.Alignment = 0 + Basecheckbox1.Left = 42 + Basecheckbox1.Name = "Basecheckbox1" + Basecheckbox1.TabIndex = 4 + Basecheckbox1.Top = 183 + cmdEscape.Name = "cmdEscape" + cmdRefresh.Left = 12 + cmdRefresh.Name = "cmdRefresh" + cmdRefresh.TabIndex = 2 + cmdRefresh.Top = 179 + lblVersion.Left = 466 + lblVersion.Name = "lblVersion" + lblVersion.TabIndex = 3 + lblVersion.Top = 181 + oImageList.Height = 26 + oImageList.Left = 365 + oImageList.Name = "oImageList" + oImageList.Top = 67 + oImageList.Width = 36 + Toolkeys1.cmdCreateTool.Name = "cmdCreateTool" + Toolkeys1.cmdCreateTool.Top = 184 + Toolkeys1.cmdOpenToolFolder.Name = "cmdOpenToolFolder" + Toolkeys1.cmdOpenToolFolder.Top = 184 + Toolkeys1.cntFrame.cmdLeft.Left = 173 + Toolkeys1.cntFrame.cmdLeft.Name = "cmdLeft" + Toolkeys1.cntFrame.cmdLeft.Top = 2 + Toolkeys1.cntFrame.cmdRight.Height = 21 + Toolkeys1.cntFrame.cmdRight.Left = 173 + Toolkeys1.cntFrame.cmdRight.Name = "cmdRight" + Toolkeys1.cntFrame.cmdRight.Top = 2 + Toolkeys1.cntFrame.Frame.basepage1.Name = "basepage1" + Toolkeys1.cntFrame.Frame.basepage1.PageOrder = 1 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Basecheckbox2.Alignment = 0 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Basecheckbox2.Left = 40 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Basecheckbox2.Name = "Basecheckbox2" + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Basecheckbox2.Top = 28 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Baselabel1.Name = "Baselabel1" + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Baselabel1.TabIndex = 3 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Height = 142 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Left = 0 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Name = "Selecttoolforlauncher1" + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.oTree.Height = 94 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.oTree.Left = 1 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.oTree.Name = "oTree" + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.oTree.TabIndex = 2 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.oTree.Top = 48 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.oTree.Width = 193 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Top = 0 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.txtcNewFilter.Name = "txtcNewFilter" + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.txtcNewFilter.TabIndex = 1 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.txtcNewFilter.Width = 125 + Toolkeys1.cntFrame.Frame.basepage1.Selecttoolforlauncher1.Width = 197 + Toolkeys1.cntFrame.Frame.basepage2.edtNoneFound.Height = 136 + Toolkeys1.cntFrame.Frame.basepage2.edtNoneFound.Left = 0 + Toolkeys1.cntFrame.Frame.basepage2.edtNoneFound.Name = "edtNoneFound" + Toolkeys1.cntFrame.Frame.basepage2.edtNoneFound.Width = 197 + Toolkeys1.cntFrame.Frame.basepage2.Name = "basepage2" + Toolkeys1.cntFrame.Frame.basepage2.oTree.Height = 142 + Toolkeys1.cntFrame.Frame.basepage2.oTree.Left = 0 + Toolkeys1.cntFrame.Frame.basepage2.oTree.Name = "oTree" + Toolkeys1.cntFrame.Frame.basepage2.oTree.Top = 0 + Toolkeys1.cntFrame.Frame.basepage2.oTree.Width = 197 + Toolkeys1.cntFrame.Frame.basepage2.PageOrder = 3 + Toolkeys1.cntFrame.Frame.basepage3.Name = "basepage3" + Toolkeys1.cntFrame.Frame.basepage3.PageOrder = 2 + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.Basecheckbox2.Alignment = 0 + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.Basecheckbox2.Name = "Basecheckbox2" + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.Baselabel1.Name = "Baselabel1" + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.Name = "Selecttoolforlauncher1" + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.oTree.Height = 92 + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.oTree.Left = 1 + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.oTree.Name = "oTree" + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.oTree.Top = 48 + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.oTree.Width = 194 + Toolkeys1.cntFrame.Frame.basepage3.Selecttoolforlauncher1.txtcNewFilter.Name = "txtcNewFilter" + Toolkeys1.cntFrame.Frame.ErasePage = .T. + Toolkeys1.cntFrame.Frame.Height = 178 + Toolkeys1.cntFrame.Frame.Name = "Frame" + Toolkeys1.cntFrame.Frame.Top = 0 + Toolkeys1.cntFrame.Frame.Width = 200 + Toolkeys1.cntFrame.Height = 172 + Toolkeys1.cntFrame.Name = "cntFrame" + Toolkeys1.cntFrame.Width = 200 + Toolkeys1.cntToolInfo.chkFavorite.Alignment = 0 + Toolkeys1.cntToolInfo.chkFavorite.Name = "chkFavorite" + Toolkeys1.cntToolInfo.chkStartup.Alignment = 0 + Toolkeys1.cntToolInfo.chkStartup.Name = "chkStartup" + Toolkeys1.cntToolInfo.chkToolBar.Alignment = 0 + Toolkeys1.cntToolInfo.chkToolBar.Name = "chkToolBar" + Toolkeys1.cntToolInfo.cmdEditTool.Left = 107 + Toolkeys1.cntToolInfo.cmdEditTool.Name = "cmdEditTool" + Toolkeys1.cntToolInfo.cmdEditTool.Top = 144 + Toolkeys1.cntToolInfo.cmdRemoveTool.Left = 197 + Toolkeys1.cntToolInfo.cmdRemoveTool.Name = "cmdRemoveTool" + Toolkeys1.cntToolInfo.cmdRemoveTool.Top = 144 + Toolkeys1.cntToolInfo.cmdToolBarIcon.Name = "cmdToolBarIcon" + Toolkeys1.cntToolInfo.Edittoolbutton1.Left = 17 + Toolkeys1.cntToolInfo.Edittoolbutton1.Name = "Edittoolbutton1" + Toolkeys1.cntToolInfo.Edittoolbutton1.Top = 144 + Toolkeys1.cntToolInfo.Height = 171 + Toolkeys1.cntToolInfo.Left = 210 + Toolkeys1.cntToolInfo.Name = "cntToolInfo" + Toolkeys1.cntToolInfo.oHotKeyControls.cmdClear.Name = "cmdClear" + Toolkeys1.cntToolInfo.oHotKeyControls.cmdGetHotKey.Name = "cmdGetHotKey" + Toolkeys1.cntToolInfo.oHotKeyControls.lblHotKey.Name = "lblHotKey" + Toolkeys1.cntToolInfo.oHotKeyControls.lrefreshform = .T. + Toolkeys1.cntToolInfo.oHotKeyControls.Name = "oHotKeyControls" + Toolkeys1.cntToolInfo.oHotKeyControls.txtHotKey.Name = "txtHotKey" + Toolkeys1.cntToolInfo.oToolInfo.edtToolInfo.Height = 70 + Toolkeys1.cntToolInfo.oToolInfo.edtToolInfo.Name = "edtToolInfo" + Toolkeys1.cntToolInfo.oToolInfo.edtToolInfo.Width = 288 + Toolkeys1.cntToolInfo.oToolInfo.Height = 88 + Toolkeys1.cntToolInfo.oToolInfo.lblLink.Name = "lblLink" + Toolkeys1.cntToolInfo.oToolInfo.lblLink.Top = 72 + Toolkeys1.cntToolInfo.oToolInfo.lblOptions.Name = "lblOptions" + Toolkeys1.cntToolInfo.oToolInfo.lblOptions.Top = 72 + Toolkeys1.cntToolInfo.oToolInfo.lblPlugIns.Name = "lblPlugIns" + Toolkeys1.cntToolInfo.oToolInfo.lblPlugIns.Top = 72 + Toolkeys1.cntToolInfo.oToolInfo.lblVideo.Name = "lblVideo" + Toolkeys1.cntToolInfo.oToolInfo.lblVideo.Top = 72 + Toolkeys1.cntToolInfo.oToolInfo.Name = "oToolInfo" + Toolkeys1.cntToolInfo.oToolInfo.Width = 289 + Toolkeys1.cntToolInfo.Width = 300 + Toolkeys1.Height = 172 + Toolkeys1.Left = 6 + Toolkeys1.Name = "Toolkeys1" + Toolkeys1.TabIndex = 1 + Toolkeys1.Thor_sfsplitterh1.cobject1name = cntFrame + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot1.Name = "GripperDot1" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot1.ShapeDark.Name = "ShapeDark" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot1.ShapeLight.Name = "ShapeLight" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot1.ShapeMiddle.Name = "ShapeMiddle" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot2.Name = "GripperDot2" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot2.ShapeDark.Name = "ShapeDark" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot2.ShapeLight.Name = "ShapeLight" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot2.ShapeMiddle.Name = "ShapeMiddle" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot3.Name = "GripperDot3" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot3.ShapeDark.Name = "ShapeDark" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot3.ShapeLight.Name = "ShapeLight" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot3.ShapeMiddle.Name = "ShapeMiddle" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot4.Name = "GripperDot4" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot4.ShapeDark.Name = "ShapeDark" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot4.ShapeLight.Name = "ShapeLight" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot4.ShapeMiddle.Name = "ShapeMiddle" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot5.Name = "GripperDot5" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot5.ShapeDark.Name = "ShapeDark" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot5.ShapeLight.Name = "ShapeLight" + Toolkeys1.Thor_sfsplitterh1.gripper.GripperDot5.ShapeMiddle.Name = "ShapeMiddle" + Toolkeys1.Thor_sfsplitterh1.gripper.Name = "gripper" + Toolkeys1.Thor_sfsplitterh1.Height = 170 + Toolkeys1.Thor_sfsplitterh1.Left = 200 + Toolkeys1.Thor_sfsplitterh1.Name = "Thor_sfsplitterh1" + Toolkeys1.Top = 6 + Toolkeys1.Width = 510 + + ADD OBJECT 'lblLink' AS baselabel WITH ; + Anchor = 4, ; + Caption = "Thor videos", ; + FontUnderline = .T., ; + ForeColor = 0,0,255, ; + Left = 274, ; + MousePointer = 15, ; + Name = "lblLink", ; + Top = 184 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + PROCEDURE Init + Lparameters tcThorFolder + + This.nToolkeys1Margin = This.Width - This.toolkeys1.Width + + DoDefault(tcThorFolder) + + This.ToolKeys1.cntFrame.Frame.BasePage1.Selecttoolforlauncher1.ApplyFilter() + + ENDPROC + + PROCEDURE resetalldefaults + With Thisform + .ResetToDefault ('Dockable') + *!* * Removed 6/24/2012 / JRN + *!* .ResetToDefault ('Top') + *!* .ResetToDefault ('Left') + .ResetToDefault ('Height') + .ResetToDefault ('Width') + + .ResetToDefault ('lHideRightSide') + *!* * Removed 6/24/2012 / JRN + *!* .ResetToDefault ('lReOpen') + .ResetToDefault ('nHiddenWidth') + + With This.ToolKeys1.thor_sfsplitterh1 + .ResetToDefault ('Left') + .MoveSplitterToPosition (.Left) + Endwith + + .Refresh() + + Endwith + + ENDPROC + + PROCEDURE resizeform + Lparameters tlHideRightSide + Local lnAnchor, lnNewWidth, lnSplitterPos, loSplitter + + If Pcount() = 1 + Thisform.lHideRightSide = tlHideRightSide + Endif + + With This.toolkeys1 + lnAnchor = .Anchor + .Anchor = 0 + + loSplitter = .Thor_sfsplitterh1 + lnSplitterPos = loSplitter.Left + + If Thisform.lHideRightSide + lnNewWidth = lnSplitterPos + .Left + This.nHiddenWidth = This.Width - lnNewWidth + This.Width = lnNewWidth + Else + This.Width = This.Width + This.nHiddenWidth + .Width = This.Width - This.nToolkeys1Margin + Endif + + loSplitter.MoveSplitterToPosition (lnSplitterPos) + + .Height = This.Height - 28 + .Anchor = lnAnchor + + Endwith + + ENDPROC + + PROCEDURE restoresettings + Local lnAnchor + DoDefault() + + * Restore saved settings from FOXUSER. + + With This + .lHideRightSide = Nvl (.oPersist.Get ('HideRightSide'), .lHideRightSide) + .nHiddenWidth = Nvl (.oPersist.Get ('HiddenWidth'), .nHiddenWidth) + .ToolKeys1.cntFrame.Frame.BasePage1.Selecttoolforlauncher1.cNewFilter = Nvl (.oPersist.Get ('NewFilter'), '') + + If .lHideRightSide + With This.ToolKeys1 + lnAnchor = .Anchor + .Anchor = 0 + .Width = .Width + This.Width - .thor_sfsplitterh1.Width - .Left + .Height = This.Height - 28 + .Anchor = lnAnchor + Endwith + Endif + Endwith + + + ENDPROC + + PROCEDURE savesettings + Local llHideRightSide + With This + llHideRightSide = .lHideRightSide + .oPersist.Set ('HideRightSide', llHideRightSide) + .oPersist.Set ('HiddenWidth', .nHiddenWidth) + .oPersist.Set ('NewFilter', .ToolKeys1.cntFrame.Frame.BasePage1.Selecttoolforlauncher1.cNewFilter) + Endwith + + DoDefault() + + ENDPROC + + PROCEDURE Show + Lparameters nStyle + + Local loSplitter + + loSplitter = This.Toolkeys1.Thor_sfsplitterh1 + Do Case + Case This.lHideRightSide + loSplitter.MoveSplitterToPosition(Max(loSplitter.nObject1MinSize, This.Width - This.Toolkeys1.Left)) + Case Thisform.nSplitterPosition # loSplitter.Left ; + And Thisform.nSplitterPosition >= 0 + loSplitter.MoveSplitterToPosition(Max(loSplitter.nObject1MinSize, Thisform.nSplitterPosition)) + Endcase + + ENDPROC + + PROCEDURE cmdRefresh.RightClick + Thisform.ResetAllDefaults() + + ENDPROC + + PROCEDURE lblLink.Click + *** DH 2018-04-10: new URL + *ExecScript(_Screen.cThorDispatcher, 'Thor_Proc_Shell', 'http://vfpx.codeplex.com/wikipage?title=Thor%20Videos') + ExecScript(_Screen.cThorDispatcher, 'Thor_Proc_Shell', 'https://github.com/VFPX/Thor/blob/master/Docs/Thor_videos.md') + + ENDPROC + + PROCEDURE Toolkeys1.cntToolInfo.oHotKeyControls.onkeypressed + Thisform.Toolkeys1.cntFrame.Frame.Refresh() + + ENDPROC + + PROCEDURE Toolkeys1.Thor_sfsplitterh1.Refresh + * + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thorruntool.sc2 b/Thor/Source/thorruntool.sc2 new file mode 100644 index 00000000..367cde0c --- /dev/null +++ b/Thor/Source/thorruntool.sc2 @@ -0,0 +1,598 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thorruntool.scx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +#INCLUDE "thor_ui.h" + +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="2" /> + + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + +ENDDEFINE + +DEFINE CLASS frmthor AS baseform OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdRunThor" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdRefresh" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblVersion" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblFolder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Toolkeys1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="oImageList" UniqueID="" Timestamp="" /> + + * + *m: addpemeditortools + *m: edittool && Edits the specified tool + *m: gethotkeydescription + *m: help + *m: loadtree && Loads the TreeView + *m: notthorinternalmenu + *m: refreshtools && Refreshes the tools + *m: runthor && Runs Thor to update the hotkeys and menus + *m: setfontsize + *p: cthorfolder + *p: lrefreshselecttooltreeview + *p: lrefreshtools && Flags that we're refreshing tools + *p: nfontsize + *p: noptionssplitterleft + *p: oselecttool + *p: othor && A reference to a Thor_Engine object + *p: otools && A reference to a collection of tools + * + + BindControls = .F. + Caption = "Run Tool" + cfoxuserid = ThorRunTool + cfoxusername = ThorRunTool + cthorfolder = + DataSession = 2 + DoCreate = .T. + Height = 300 + Icon = thor16.ico + lrefreshselecttooltreeview = .F. + lrefreshtools = .F. && Flags that we're refreshing tools + MinButton = .F. + MinHeight = 200 + MinWidth = 200 + Name = "frmThor" + nfontsize = 9 + noptionssplitterleft = 0 + oselecttool = .NULL. + othor = .NULL. && A reference to a Thor_Engine object + otools = .NULL. && A reference to a collection of tools + Visible = .T. + Width = 630 + _memberdata = + + + + + + + + + + + + + + + + + + + + + + ADD OBJECT 'cmdRefresh' AS basecommandbutton WITH ; + Alignment = 4, ; + Anchor = 4, ; + Caption = "", ; + Left = 8, ; + Name = "cmdRefresh", ; + Picture = refresh2.bmp, ; + TabIndex = 2, ; + Top = 275, ; + Width = 23 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdRunThor' AS basecommandbutton WITH ; + Alignment = 4, ; + Anchor = 4, ; + Caption = "", ; + Left = 33, ; + Name = "cmdRunThor", ; + Picture = thor16.png, ; + TabIndex = 3, ; + Top = 275, ; + Width = 23 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'lblFolder' AS baselabel WITH ; + Alignment = 0, ; + Anchor = 4, ; + Caption = "Folder", ; + Left = 69, ; + Name = "lblFolder", ; + Top = 278 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'lblVersion' AS baselabel WITH ; + Alignment = 1, ; + Anchor = 12, ; + Caption = "Version", ; + Left = 577, ; + Name = "lblVersion", ; + Top = 278 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'oImageList' AS olecontrol WITH ; + Height = 26, ; + Left = 488, ; + Name = "oImageList", ; + Top = 92, ; + Width = 36 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\syswow64\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAOAIKt9CR80BAwAAAEABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXAAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAAQAAAAAAAAABAAAAAIAAAD+/////v////7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////8jfyQskYXREbFqAMDwKDYoIUM0EggAAADtAwAA7QMAAIB+4eYAAAYAIAAAAAAAAADAwMAA//9MAAHvzasAAAUAXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAYAUAD/////BQAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==" /> + + ADD OBJECT 'Toolkeys1' AS toolkeys WITH ; + BackColor = 255,255,255, ; + BackStyle = 1, ; + Height = 261, ; + Left = 6, ; + Name = "Toolkeys1", ; + Top = 6, ; + cmdCreateTool.Left = 331, ; + cmdCreateTool.Name = "cmdCreateTool", ; + cmdCreateTool.Top = 273, ; + cmdCreateTool.Visible = .F., ; + cmdOpenToolFolder.Left = 464, ; + cmdOpenToolFolder.Name = "cmdOpenToolFolder", ; + cmdOpenToolFolder.Top = 273, ; + cmdOpenToolFolder.Visible = .F., ; + cntToolInfo.chkStartup.Alignment = 0, ; + cntToolInfo.chkStartup.Name = "chkStartup", ; + cntToolInfo.cmdEditTool.Anchor = 4, ; + cntToolInfo.cmdEditTool.Left = 143, ; + cntToolInfo.cmdEditTool.Name = "cmdEditTool", ; + cntToolInfo.cmdEditTool.Top = 206, ; + cntToolInfo.cmdRemoveTool.Anchor = 4, ; + cntToolInfo.cmdRemoveTool.Left = 239, ; + cntToolInfo.cmdRemoveTool.Name = "cmdRemoveTool", ; + cntToolInfo.cmdRemoveTool.Top = 206, ; + cntToolInfo.Height = 260, ; + cntToolInfo.Name = "cntToolInfo", ; + cntToolInfo.oHotKeyControls.CMDCLEAR.Name = "CMDCLEAR", ; + cntToolInfo.oHotKeyControls.cmdGetHotKey.Name = "cmdGetHotKey", ; + cntToolInfo.oHotKeyControls.LBLHOTKEY.Name = "LBLHOTKEY", ; + cntToolInfo.oHotKeyControls.Name = "oHotKeyControls", ; + cntToolInfo.oHotKeyControls.txtHotKey.Name = "txtHotKey", ; + cntToolInfo.oToolInfo.edtToolInfo.Height = 159, ; + cntToolInfo.oToolInfo.edtToolInfo.Name = "edtToolInfo", ; + cntToolInfo.oToolInfo.edtToolInfo.Width = 339, ; + cntToolInfo.oToolInfo.Height = 177, ; + cntToolInfo.oToolInfo.lblLink.Name = "lblLink", ; + cntToolInfo.oToolInfo.lblLink.Top = 161, ; + cntToolInfo.oToolInfo.lblVideo.Left = 211, ; + cntToolInfo.oToolInfo.lblVideo.Name = "lblVideo", ; + cntToolInfo.oToolInfo.lblVideo.Top = 161, ; + cntToolInfo.oToolInfo.Name = "oToolInfo", ; + cntToolInfo.oToolInfo.Width = 340, ; + cntToolInfo.Top = 0, ; + SELECTTOOLFORBROWSING1.Baselabel1.Name = "Baselabel1", ; + SELECTTOOLFORBROWSING1.cmdApply.Name = "cmdApply", ; + SELECTTOOLFORBROWSING1.cmdApply.Top = 0, ; + SELECTTOOLFORBROWSING1.CMDCLEAR.Name = "CMDCLEAR", ; + SELECTTOOLFORBROWSING1.CMDCLEAR.Top = 0, ; + SELECTTOOLFORBROWSING1.Height = 261, ; + SELECTTOOLFORBROWSING1.Name = "SELECTTOOLFORBROWSING1", ; + SELECTTOOLFORBROWSING1.oTree.Height = 229, ; + SELECTTOOLFORBROWSING1.oTree.Left = 1, ; + SELECTTOOLFORBROWSING1.oTree.Name = "oTree", ; + SELECTTOOLFORBROWSING1.oTree.Top = 30, ; + SELECTTOOLFORBROWSING1.oTree.Width = 251, ; + SELECTTOOLFORBROWSING1.txtcNewFilter.Height = 22, ; + SELECTTOOLFORBROWSING1.txtcNewFilter.Left = 45, ; + SELECTTOOLFORBROWSING1.txtcNewFilter.Name = "txtcNewFilter", ; + SELECTTOOLFORBROWSING1.txtcNewFilter.Top = 1, ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.Name = "GRIPPERDOT1", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.Name = "GRIPPERDOT2", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.Name = "GRIPPERDOT3", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.Name = "GRIPPERDOT4", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.Name = "GRIPPERDOT5", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.Name = "GRIPPER", ; + THOR_SFSPLITTERH1.Name = "THOR_SFSPLITTERH1" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + PROCEDURE addpemeditortools + Lparameters toTree, lcParentKey, lnMenuID, raTools, lcFilter + + Local laMenuTools[1], lcHotKey, lcKey, lcKeystroke, lcMenuStatusBar, lcPRGName, lcPrompt + Local lcStatusBar, llSeparator, lnHotKeyID, lnI, lnID, lnIndex, lnSubMenuID, loNode + + Select MenuTools.Prompt ; + , Separator ; + , SubMenuID ; + , PRGName ; + , MenuTools.Id ; + , MenuDefinitions.HotKeyID ; + From MenuTools ; + Left Join MenuDefinitions ; + On SubMenuID = MenuDefinitions.Id ; + Where MenuID = lnMenuID ; + Order By MenuTools.sortorder ; + Into Array laMenuTools + + For lnI = 1 To _Tally + lcPrompt = Alltrim (laMenuTools (lnI, 1)) + llSeparator = laMenuTools (lnI, 2) + lnSubMenuID = laMenuTools (lnI, 3) + lcPRGName = Alltrim (laMenuTools (lnI, 4)) + lnID = laMenuTools (lnI, 5) + lnHotKeyID = laMenuTools (lnI, 6) + + Do Case + Case llSeparator + * loNode = toTree.Nodes.Add (lcParentKey, 4, lcParentKey + '\' + Str (lnID), Replicate('-', 30)) + Case lnSubMenuID # 0 + lcKey = lcParentKey + '\' + Chrtran (lcPrompt, '/\', '__') + lcHotKey = Thisform.GetHotKeyDescription (lnHotKeyID) + loNode = toTree.Nodes.Add (lcParentKey, 4, lcKey, ; + lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_MENU) + This.AddPEMEditorTools (toTree, lcKey, lnSubMenuID, @raTools, lcFilter) + loNode.Expanded = Not Empty (lcFilter) + Otherwise + If Empty (lcFilter) Or 0 # Ascan (raTools, lcPRGName, 6, -1, -1, 15) + lcKey = lcParentKey + '\' + Str (lnID) + = Seek (Upper (lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + lcHotKey = Thisform.GetHotKeyDescription (ToolHotKeyAssignments.HotKeyID) + loNode = toTree.Nodes.Add (lcParentKey, 4, lcKey, ; + lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_TOOL) + lnIndex = Thisform.oTools.GetKey (Upper (lcPRGName)) + If lnIndex > 0 + loNode.Tag = Thisform.oTools (lnIndex) + Endif + Endif + Endcase + Endfor + + If toTree.Nodes (lcParentKey).Children = 0 + toTree.Nodes.Remove (lcParentKey) + Endif + + ENDPROC + + PROCEDURE Destroy + * Run Thor to update all hotkeys and menus. + + _Screen.oThorUI = .Null. + This.oSelectTool = .Null. + + * Close all tables. + + close tables all + dodefault() + + ENDPROC + + PROCEDURE edittool && Edits the specified tool + *============================================================================== + * Method: EditTool + * Purpose: Edits the specified tool + * Author: Doug Hennig + * Last revision: 04/23/2011 + * Parameters: tcPRGName - the name of the PRG to edit + * Returns: none + * Environment in: This.oThor contains a reference to a ThorEngine object + * Environment out: if the PRG is found, it's opened in an editor window + *============================================================================== + + Lparameters tcPRGName + Local lcFile, loPEME_Tools + lcFile = This.oThor.FindFile (tcPRGName) + If Empty (lcFile) + Messagebox (Strtran (ccCANT_FIND, '%1', tcPRGName), MB_OK + MB_ICONSTOP, ; + ccTHOR_CAPTION) + Else + Execscript (_Screen.cThorDispatcher, 'Thor_Proc_EditProc', lcFile) + Endif Empty (lcFile) + + ENDPROC + + PROCEDURE gethotkeydescription + Lparameters tnHotKeyID + + If Seek (tnHotKeyID, 'HotKeyDefinitions', 'ID') + Return Trim (HotKeyDefinitions.Descript) + Else + Return '' + Endif + + ENDPROC + + PROCEDURE help + Local loLink + loLink = Newobject('_ShellExecute', Home() + 'FFC\_Environ.vcx') + loLink.ShellExecute(ThorHelpURL) + + ENDPROC + + PROCEDURE Init + Lparameters toTools, ; + tcThorFolder + With This + + With This.oImageList + .ListImages.Add(1, ccIMAGE_MENU, LoadPicture('Menus.ico')) + .ListImages.Add(2, ccIMAGE_TOOL, LoadPicture('Programs.ico')) + .ListImages.Add(3, ccIMAGE_POPUP, LoadPicture('Popup.ico')) + Endwith + + * Create a Thor_Engine object and open its tables. + + .oThor = Newobject ('Thor_Engine', 'Thor.vcx', '', tcThorFolder + 'Thor\') + .oThor.OpenTables() + + * Set the caption. + + .lblVersion.Caption = ccTHORVERSION + .lblFolder.Caption = Lower(tcThorFolder) + + * Save the passed parameters. + + .oTools = toTools + .cThorFolder = tcThorFolder + + *!* * Removed 6/10/2012 / JRN + *!* * Don't allow the form to be sized smaller than the default. + + *!* .MinHeight = .Height + *!* .MinWidth = .Width + + * Activate the first page so the TreeView loads. + .nFontSize = .oThor.GetOption ('FontSize') + .SetFontSize(.nFontSize) + + .BindControls = .T. + + Endwith + DoDefault() + + ENDPROC + + PROCEDURE loadtree && Loads the TreeView + Lparameters toTree, tcFilter + + Local laPrev[1], laThis[1], laTools[1], lcCategory, lcFilter, lcHotKey, lcKey, lcPRGName + Local lcParentKey, lcPrev, lcPreviousCategory, lcPrompt, lcSortKey, lcSource, lcSubCategory, lcThis + Local lnI, lnJ, lnK, lnMax1, lnMax2, lnSort, lnStart, lnToolCount, loNode, loTool, loTools + + toTree.Nodes.Clear() + loTools = Thisform.oTools + lnToolCount = 0 + lcFilter = Upper (tcFilter) + + Do While lnToolCount = 0 + For lnI = 1 To loTools.Count + loTool = loTools.Item (lnI) + lcSource = Evl (Trim (loTool.Source), '(No Source)') + lcCategory = Evl (Trim (loTool.Category), lcSource) + lcSubCategory = Trim (loTool.SubCategory) + lnSort = Evl(loTool.Sort, 9999) + lcSortKey = loTool.InternalSort + lcPRGName = loTool.PRGName + + If (Empty (lcFilter)) ; + Or lcFilter $ Upper (lcSortKey + lcSource + loTool.Summary + loTool.Description) + lnToolCount = lnToolCount + 1 + Dimension laTools (lnToolCount, 6) + laTools (lnToolCount, 1) = lnI + laTools (lnToolCount, 2) = lcSource + laTools (lnToolCount, 3) = lcCategory + laTools (lnToolCount, 4) = lcSubCategory + laTools (lnToolCount, 5) = lcSortKey + laTools (lnToolCount, 6) = lcPRGName + Endif + Endfor + If lnToolCount = 0 + Messagebox ([No matches to '] + tcFilter + [' found. Showing all tools.], 16) + lcFilter = '' + Endif + Enddo && while lnToolCount = 0 + + Asort (laTools, 5) + lcPreviousCategory = '' + + For lnI = 1 To lnToolCount + + loTool = loTools.Item (laTools (lnI, 1)) + lcSource = laTools (lnI, 2) + lcCategory = laTools (lnI, 3) + + *!* * Removed 2/3/2012 + *!* If lcSource == 'Thor' + *!* Loop + *!* Endif + + If Not lcCategory == lcPreviousCategory + lnMax1 = Alines (laPrev, lcPreviousCategory, 5, '|') + lnMax2 = Alines (laThis, lcCategory, 5, '|') + If lnI = 1 + lnJ = 1 + Else + lnStart = 1 + Min (lnMax1, lnMax2) + lcKey = '' + For lnJ = 1 To Min (lnMax1, lnMax2) + lcPrev = laPrev[lnJ] + lcThis = laThis[lnJ] + If Not Upper (lcPrev) == Upper (lcThis) + lnStart = lnJ + Exit + Endif + lcKey = Upper(lcKey + Iif (lnJ > 1, '\', '') + lcThis) + Endfor + Endif + For lnK = lnJ To lnMax2 + If lnK = 1 + lcKey = Upper(laThis[1]) + loNode = toTree.Nodes.Add (, 1, lcKey, laThis[1], ccIMAGE_MENU) + loNode.Expanded = Not Empty (lcFilter) + loNode.Bold = .T. + Else + lcParentKey = Upper(lcKey) + lcKey = Upper(lcParentKey + '\' + Chrtran(laThis[lnK], '.,;\/', '-----')) + loNode = toTree.Nodes.Add (lcParentKey, 4, lcKey, laThis[lnK], ccIMAGE_MENU) + loNode.Expanded = Not Empty (lcFilter) + Endif + Endfor + Endif + + lcPrompt = loTool.Prompt + lcPRGName = loTool.PRGName + = Seek (Upper (lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + lcHotKey = Thisform.GetHotKeyDescription (ToolHotKeyAssignments.HotKeyID) + loNode = toTree.Nodes.Add (lcKey, 4, lcKey + '\' + lcPRGName ; + , lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_TOOL) + loNode.Tag = loTool + + lcPreviousCategory = lcCategory + + Endfor && lnI = 1 To lnToolCount + + + + ENDPROC + + PROCEDURE notthorinternalmenu + Do Case + Case Trim (MenuDefinitions.PopupName) == 'Thor_Internal' + Return .F. + Case Trim (MenuDefinitions.PopupName) == ccRunAllTools + Return .F. + Otherwise + Return .T. + Endcase + ENDPROC + + PROCEDURE refreshtools && Refreshes the tools + *============================================================================== + * Method: RefreshTools + * Purpose: Refreshes the tools + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: none + * Returns: none + * Environment in: This.oTools.Tag contains the tools folder + * Environment out: the tools collection has been recreated and controls on the + * form refreshed + *============================================================================== + + with This + .oTools = .oThor.GetToolsCollection(.oTools.Tag) + .lRefreshTools = .T. + .lRefreshSelectToolTreeView = .T. + .Refresh() + .lRefreshTools = .F. + messagebox(ccTOOLS_REFRESHED, MB_OK, ccTHOR_CAPTION) + endwith + + ENDPROC + + PROCEDURE runthor && Runs Thor to update the hotkeys and menus + *============================================================================== + * Method: RunThor + * Purpose: Runs Thor to update the hotkeys and menus + * Author: Doug Hennig + * Last revision: 04/09/2011 + * Parameters: none + * Returns: none + * Environment in: This.cThorFolder contains the Thor folder + * Environment out: Thor_Run has been instantiated and its Run method called + *============================================================================== + + local lcApp, ; + lcFolder, ; + loRunThor + lcApp = This.cThorFolder + 'Thor.App' + lcFolder = This.cThorFolder + 'Thor\' + loRunThor = newobject ('Thor_Run', 'thor_run.vcx', '', lcApp, lcFolder) + loRunThor.Run(.T.) && but no startups + + * Display a message if we're supposed to. + + if This.oThor.GetOption('UpdateMessage') + messagebox (ccRUN_THOR_DONE, MB_OK, ccTHOR_CAPTION, 3000) + endif This.oThor.GetOption('UpdateMessage') + + ENDPROC + + PROCEDURE setfontsize + Lparameters tnFontSize + + Local lnFontsize + lnFontsize = Nvl (tnFontSize, 8) + With This + .FontSize = lnFontsize + .SetAll ('FontSize', lnFontsize) + Thisform.Toolkeys1.SELECTTOOLFORBROWSING1.oTree.Font.Size = lnFontsize + Endwith + + ENDPROC + + PROCEDURE cmdRefresh.Click + Thisform.RefreshTools() + + ENDPROC + + PROCEDURE cmdRefresh.Init + This.ToolTipText = ccTOOL_TOOLTIP + DoDefault() + + ENDPROC + + PROCEDURE cmdRunThor.Click + Local lnRecno + lnRecno = Recno ('MenuDefinitions') + + Thisform.RunThor() + + Try + Goto (lnRecno) In MenuDefinitions + Catch + + Endtry + + + ENDPROC + + PROCEDURE cmdRunThor.Init + This.ToolTipText = ccTHOR_TOOLTIP + DoDefault() + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/thorui.sc2 b/Thor/Source/thorui.sc2 new file mode 100644 index 00000000..15890fff --- /dev/null +++ b/Thor/Source/thorui.sc2 @@ -0,0 +1,1014 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (ES) AUTOGENERADO - ˇˇATENCIÓN!! - ˇˇNO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!! +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.19" SourceFile="thorui.scx" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +#INCLUDE "thor_ui.h" + +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="2" /> + + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + +ENDDEFINE + +DEFINE CLASS frmthor AS baseform OF "basecontrols.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="pgfThor" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfThor.basepage1.oMenu" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfThor.Basepage2.Toolkeys1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfThor.Basepage3.Thoroptions1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfThor.Basepage4.Hotkeylist1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfThor.Basepage5.Startuptools1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdRunThor" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdRefresh" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblVersion" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblFolder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdHelp" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="oImageList" UniqueID="" Timestamp="" /> + + * + *m: addpemeditortools + *m: edittool && Edits the specified tool + *m: gethotkeydescription + *m: help + *m: loadtree && Loads the TreeView + *m: notthorinternalmenu + *m: openoptionspage + *m: refreshtools && Refreshes the tools + *m: runthor && Runs Thor to update the hotkeys and menus + *m: setfontsize + *p: cthorfolder + *p: lrefreshselecttooltreeview + *p: lrefreshtools && Flags that we're refreshing tools + *p: nfontsize + *p: noptionssplitterleft + *p: oselecttool + *p: othor && A reference to a Thor_Engine object + *p: otools && A reference to a collection of tools + * + + BindControls = .F. + Caption = "Thor" + cfoxuserid = Thor + cfoxusername = ThorEditor + cthorfolder = + DataSession = 2 + DoCreate = .T. + Height = 334 + Icon = thor16.ico + lrefreshselecttooltreeview = .F. + lrefreshtools = .F. && Flags that we're refreshing tools + Name = "frmThor" + nfontsize = 9 + noptionssplitterleft = 0 + oselecttool = .NULL. + othor = .NULL. && A reference to a Thor_Engine object + otools = .NULL. && A reference to a collection of tools + Visible = .T. + Width = 660 + _memberdata = + + + + + + + + + + + + + + + + + + + + + + cmdEscape.Name = "cmdEscape" + + ADD OBJECT 'cmdHelp' AS basecommandbutton WITH ; + Anchor = 8, ; + Caption = "", ; + Left = 630, ; + Name = "cmdHelp", ; + Picture = refhelp.bmp, ; + TabIndex = 3, ; + Top = 5, ; + Width = 23 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdRefresh' AS basecommandbutton WITH ; + Anchor = 8, ; + Caption = "", ; + Left = 580, ; + Name = "cmdRefresh", ; + Picture = refresh2.bmp, ; + TabIndex = 2, ; + Top = 5, ; + Width = 23 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdRunThor' AS basecommandbutton WITH ; + Anchor = 8, ; + Caption = "", ; + Left = 605, ; + Name = "cmdRunThor", ; + Picture = thor16.png, ; + TabIndex = 3, ; + Top = 5, ; + Width = 23 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'lblFolder' AS baselabel WITH ; + Alignment = 0, ; + Anchor = 6, ; + Caption = "Folder", ; + Left = 12, ; + Name = "lblFolder", ; + Top = 315 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'lblVersion' AS baselabel WITH ; + Alignment = 1, ; + Anchor = 12, ; + Caption = "Version", ; + Left = 615, ; + Name = "lblVersion", ; + Top = 315 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="label" /> + + ADD OBJECT 'oImageList' AS olecontrol WITH ; + Height = 26, ; + Left = 480, ; + Name = "oImageList", ; + Top = 6, ; + Width = 36 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\syswow64\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAB9XsoZ84BAwAAAEABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXAAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAAQAAAAAAAAABAAAAAIAAAD+/////v////7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////8jfyQskYXREbFqAMDwKDYoIUM0EggAAADtAwAA7QMAAIB+4eYAAAYAIAAAAAAAAADAwMAA//9MAAHvzasAAAUAXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAYAUAD/////BQAAgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==" /> + + ADD OBJECT 'pgfThor' AS basepageframe WITH ; + Anchor = 15, ; + ErasePage = .T., ; + Height = 305, ; + Left = 10, ; + Name = "pgfThor", ; + PageCount = 5, ; + TabIndex = 1, ; + Top = 10, ; + Width = 645, ; + _memberdata = + + + + + + + + + + , ; + basepage1.Caption = "Menu Definitions", ; + basepage1.Name = "basepage1", ; + basepage1.PageOrder = 1, ; + Basepage2.Caption = "Tool Definitions", ; + Basepage2.Name = "Basepage2", ; + Basepage2.PageOrder = 2, ; + Basepage3.Caption = "Options", ; + Basepage3.Name = "Basepage3", ; + Basepage3.PageOrder = 5, ; + Basepage4.Caption = "Hot Key Assignments", ; + Basepage4.Name = "Basepage4", ; + Basepage4.PageOrder = 3, ; + Basepage5.Caption = "Startup Tools", ; + Basepage5.Name = "Basepage5", ; + Basepage5.PageOrder = 4 + *< END OBJECT: ClassLib="basecontrols.vcx" BaseClass="pageframe" /> + + ADD OBJECT 'pgfThor.basepage1.oMenu' AS menus WITH ; + Left = 14, ; + Name = "oMenu", ; + Top = 11, ; + cmdAddMenu.Name = "cmdAddMenu", ; + cmdAddSeparator.Name = "cmdAddSeparator", ; + cmdAddSeparator.Top = 235, ; + cmdAddSubMenu.Name = "cmdAddSubMenu", ; + cmdAddSubMenu.Top = 235, ; + cmdAddTool.Name = "cmdAddTool", ; + oImageList.Height = 26, ; + oImageList.Left = 150, ; + oImageList.Name = "oImageList", ; + oImageList.Top = 0, ; + oImageList.Width = 36, ; + oTree.Height = 231, ; + oTree.Left = 0, ; + oTree.Name = "oTree", ; + oTree.Top = 0, ; + oTree.Width = 186, ; + pgfProperties.Basepage1.Basecheckbox1.Alignment = 1, ; + pgfProperties.Basepage1.Basecheckbox1.Name = "Basecheckbox1", ; + pgfProperties.Basepage1.cmdAddCopiedMenu.Name = "cmdAddCopiedMenu", ; + pgfProperties.Basepage1.cmdAddPopup.Name = "cmdAddPopup", ; + pgfProperties.Basepage1.cmdAddTopLevel.Name = "cmdAddTopLevel", ; + pgfProperties.Basepage1.cmdCopyMenu.Name = "cmdCopyMenu", ; + pgfProperties.Basepage1.cmdMoveDown.Name = "cmdMoveDown", ; + pgfProperties.Basepage1.cmdMoveUp.Name = "cmdMoveUp", ; + pgfProperties.Basepage1.cmdRemove.Name = "cmdRemove", ; + pgfProperties.Basepage1.edtStatusBarText.Name = "edtStatusBarText", ; + pgfProperties.Basepage1.lblOrder.Name = "lblOrder", ; + pgfProperties.Basepage1.lblPrompt.Name = "lblPrompt", ; + pgfProperties.Basepage1.lblStatusBarText.Name = "lblStatusBarText", ; + pgfProperties.Basepage1.Name = "Basepage1", ; + pgfProperties.Basepage1.oHotKeyControls.cmdClear.Name = "cmdClear", ; + pgfProperties.Basepage1.oHotKeyControls.cmdGetHotKey.Name = "cmdGetHotKey", ; + pgfProperties.Basepage1.oHotKeyControls.lblHotKey.Name = "lblHotKey", ; + pgfProperties.Basepage1.oHotKeyControls.Name = "oHotKeyControls", ; + pgfProperties.Basepage1.oHotKeyControls.txtHotKey.Name = "txtHotKey", ; + pgfProperties.Basepage1.txtPrompt.Name = "txtPrompt", ; + pgfProperties.Basepage2.Baseeditbox1.Name = "Baseeditbox1", ; + pgfProperties.Basepage2.Baselabel1.Name = "Baselabel1", ; + pgfProperties.Basepage2.cmdEditTool.Name = "cmdEditTool", ; + pgfProperties.Basepage2.cmdMoveDown.Name = "cmdMoveDown", ; + pgfProperties.Basepage2.cmdMoveUp.Name = "cmdMoveUp", ; + pgfProperties.Basepage2.cmdRemove.Name = "cmdRemove", ; + pgfProperties.Basepage2.edtStatusBarText.Name = "edtStatusBarText", ; + pgfProperties.Basepage2.lblOrder.Name = "lblOrder", ; + pgfProperties.Basepage2.lblStatusBarText.Name = "lblStatusBarText", ; + pgfProperties.Basepage2.Name = "Basepage2", ; + pgfProperties.Basepage2.oFilter.lblFilter.Name = "lblFilter", ; + pgfProperties.Basepage2.oFilter.Name = "oFilter", ; + pgfProperties.Basepage2.oFilter.txtFilter.Name = "txtFilter", ; + pgfProperties.Basepage2.oHotKeyControls.cmdClear.Name = "cmdClear", ; + pgfProperties.Basepage2.oHotKeyControls.cmdGetHotKey.Name = "cmdGetHotKey", ; + pgfProperties.Basepage2.oHotKeyControls.lblHotKey.Name = "lblHotKey", ; + pgfProperties.Basepage2.oHotKeyControls.Name = "oHotKeyControls", ; + pgfProperties.Basepage2.oHotKeyControls.txtHotKey.Name = "txtHotKey", ; + pgfProperties.Basepage2.oToolInfo.edtToolInfo.Name = "edtToolInfo", ; + pgfProperties.Basepage2.oToolInfo.lblLink.Name = "lblLink", ; + pgfProperties.Basepage2.oToolInfo.lblOptions.Name = "lblOptions", ; + pgfProperties.Basepage2.oToolInfo.lblPlugIns.Name = "lblPlugIns", ; + pgfProperties.Basepage2.oToolInfo.lblVideo.Name = "lblVideo", ; + pgfProperties.Basepage2.oToolInfo.Name = "oToolInfo", ; + pgfProperties.Basepage2.Selecttool1.Baselabel1.Name = "Baselabel1", ; + pgfProperties.Basepage2.Selecttool1.cboCombo.Name = "cboCombo", ; + pgfProperties.Basepage2.Selecttool1.cmdApply.Name = "cmdApply", ; + pgfProperties.Basepage2.Selecttool1.cmdClear.Name = "cmdClear", ; + pgfProperties.Basepage2.Selecttool1.lblPrompt1.Name = "lblPrompt1", ; + pgfProperties.Basepage2.Selecttool1.Name = "Selecttool1", ; + pgfProperties.Basepage2.Selecttool1.oImageList.Height = 100, ; + pgfProperties.Basepage2.Selecttool1.oImageList.Left = 120, ; + pgfProperties.Basepage2.Selecttool1.oImageList.Name = "oImageList", ; + pgfProperties.Basepage2.Selecttool1.oImageList.Top = 40, ; + pgfProperties.Basepage2.Selecttool1.oImageList.Width = 100, ; + pgfProperties.Basepage2.Selecttool1.oTree.Height = 174, ; + pgfProperties.Basepage2.Selecttool1.oTree.Left = 5, ; + pgfProperties.Basepage2.Selecttool1.oTree.Name = "oTree", ; + pgfProperties.Basepage2.Selecttool1.oTree.Top = 29, ; + pgfProperties.Basepage2.Selecttool1.oTree.Width = 166, ; + pgfProperties.Basepage2.Selecttool1.shpTreeView.Name = "shpTreeView", ; + pgfProperties.Basepage2.Selecttool1.txtcNewFilter.Name = "txtcNewFilter", ; + pgfProperties.ErasePage = .T., ; + pgfProperties.Height = 232, ; + pgfProperties.Left = 191, ; + pgfProperties.Name = "pgfProperties", ; + pgfProperties.Top = 3 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'pgfThor.Basepage2.Toolkeys1' AS toolkeys WITH ; + Height = 261, ; + Left = 6, ; + Name = "Toolkeys1", ; + Top = 6, ; + CMDCREATETOOL.Name = "CMDCREATETOOL", ; + cmdOpenToolFolder.Name = "cmdOpenToolFolder", ; + cntToolInfo.chkFavorite.Alignment = 0, ; + cntToolInfo.chkFavorite.Name = "chkFavorite", ; + cntToolInfo.chkStartup.Alignment = 0, ; + cntToolInfo.chkStartup.Name = "chkStartup", ; + cntToolInfo.chkToolBar.Alignment = 0, ; + cntToolInfo.chkToolBar.Name = "chkToolBar", ; + cntToolInfo.cmdEditTool.Name = "cmdEditTool", ; + cntToolInfo.cmdRemoveTool.Name = "cmdRemoveTool", ; + cntToolInfo.cmdToolBarIcon.Name = "cmdToolBarIcon", ; + cntToolInfo.Edittoolbutton1.Enabled = .F., ; + cntToolInfo.Edittoolbutton1.Name = "Edittoolbutton1", ; + cntToolInfo.Edittoolbutton1.Visible = .F., ; + cntToolInfo.Name = "cntToolInfo", ; + cntToolInfo.oHotKeyControls.cmdClear.Name = "cmdClear", ; + cntToolInfo.oHotKeyControls.cmdGetHotKey.Name = "cmdGetHotKey", ; + cntToolInfo.oHotKeyControls.lblHotKey.Name = "lblHotKey", ; + cntToolInfo.oHotKeyControls.Name = "oHotKeyControls", ; + cntToolInfo.oHotKeyControls.txtHotKey.Name = "txtHotKey", ; + cntToolInfo.oToolInfo.edtToolInfo.Height = 160, ; + cntToolInfo.oToolInfo.edtToolInfo.Name = "edtToolInfo", ; + cntToolInfo.oToolInfo.Height = 178, ; + cntToolInfo.oToolInfo.lblLink.Name = "lblLink", ; + cntToolInfo.oToolInfo.lblLink.Top = 162, ; + cntToolInfo.oToolInfo.lblOptions.Name = "lblOptions", ; + cntToolInfo.oToolInfo.lblOptions.Top = 162, ; + cntToolInfo.oToolInfo.lblPlugIns.Name = "lblPlugIns", ; + cntToolInfo.oToolInfo.lblVideo.Name = "lblVideo", ; + cntToolInfo.oToolInfo.lblVideo.Top = 162, ; + cntToolInfo.oToolInfo.Name = "oToolInfo", ; + cntToolInfo.Top = 0, ; + SELECTTOOLFORBROWSING1.Baselabel1.Name = "Baselabel1", ; + SELECTTOOLFORBROWSING1.Name = "SELECTTOOLFORBROWSING1", ; + SELECTTOOLFORBROWSING1.oTree.Height = 201, ; + SELECTTOOLFORBROWSING1.oTree.Left = 1, ; + SELECTTOOLFORBROWSING1.oTree.Name = "oTree", ; + SELECTTOOLFORBROWSING1.oTree.Top = 30, ; + SELECTTOOLFORBROWSING1.oTree.Width = 265, ; + SELECTTOOLFORBROWSING1.Top = 0, ; + SELECTTOOLFORBROWSING1.txtcNewFilter.Name = "txtcNewFilter", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.Name = "GRIPPERDOT1", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT1.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.Name = "GRIPPERDOT2", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT2.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.Name = "GRIPPERDOT3", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT3.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.Name = "GRIPPERDOT4", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT4.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.Name = "GRIPPERDOT5", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.SHAPEDARK.Name = "SHAPEDARK", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.SHAPELIGHT.Name = "SHAPELIGHT", ; + THOR_SFSPLITTERH1.GRIPPER.GRIPPERDOT5.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + THOR_SFSPLITTERH1.GRIPPER.Name = "GRIPPER", ; + THOR_SFSPLITTERH1.Name = "THOR_SFSPLITTERH1", ; + THOR_SFSPLITTERH1.Top = 0 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'pgfThor.Basepage3.Thoroptions1' AS thoroptions WITH ; + Left = 14, ; + Name = "Thoroptions1", ; + Top = 11, ; + cntDefault.CHKVALUE.Alignment = 0, ; + cntDefault.CHKVALUE.Name = "CHKVALUE", ; + cntDefault.EDTVALUE.Name = "EDTVALUE", ; + cntDefault.LBLVALUE.Name = "LBLVALUE", ; + cntDefault.Name = "cntDefault", ; + cntDefault.SPNVALUE.Name = "SPNVALUE", ; + cntNonDefault.Name = "cntNonDefault", ; + oList.Height = 260, ; + oList.Left = 0, ; + oList.Name = "oList", ; + oList.Top = 0, ; + oList.Width = 200, ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT1.Name = "GRIPPERDOT1", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT1.SHAPEDARK.Name = "SHAPEDARK", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT1.SHAPELIGHT.Name = "SHAPELIGHT", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT1.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT2.Name = "GRIPPERDOT2", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT2.SHAPEDARK.Name = "SHAPEDARK", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT2.SHAPELIGHT.Name = "SHAPELIGHT", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT2.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT3.Name = "GRIPPERDOT3", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT3.SHAPEDARK.Name = "SHAPEDARK", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT3.SHAPELIGHT.Name = "SHAPELIGHT", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT3.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT4.Name = "GRIPPERDOT4", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT4.SHAPEDARK.Name = "SHAPEDARK", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT4.SHAPELIGHT.Name = "SHAPELIGHT", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT4.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT5.Name = "GRIPPERDOT5", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT5.SHAPEDARK.Name = "SHAPEDARK", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT5.SHAPELIGHT.Name = "SHAPELIGHT", ; + Thor_sfsplitterh1.GRIPPER.GRIPPERDOT5.SHAPEMIDDLE.Name = "SHAPEMIDDLE", ; + Thor_sfsplitterh1.GRIPPER.Name = "GRIPPER", ; + Thor_sfsplitterh1.Name = "Thor_sfsplitterh1" + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'pgfThor.Basepage4.Hotkeylist1' AS hotkeylist WITH ; + Height = 266, ; + Name = "Hotkeylist1", ; + Top = 2, ; + Visible = .T., ; + Width = 638, ; + cmdToClipboard.Name = "cmdToClipboard", ; + cmdToClipboard.Top = 234, ; + gridKeys.ColDescription.Header1.Name = "Header1", ; + gridKeys.ColDescription.Name = "ColDescription", ; + gridKeys.ColDescription.Text1.Name = "Text1", ; + gridKeys.ColHotKey.Header1.Name = "Header1", ; + gridKeys.ColHotKey.Name = "ColHotKey", ; + gridKeys.ColHotKey.Text1.Name = "Text1", ; + gridKeys.ColSource.Header1.Name = "Header1", ; + gridKeys.ColSource.Name = "ColSource", ; + gridKeys.ColSource.Text1.Name = "Text1", ; + gridKeys.Height = 221, ; + gridKeys.Left = 6, ; + gridKeys.Name = "gridKeys", ; + gridKeys.Top = 6, ; + gridKeys.Width = 628 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + ADD OBJECT 'pgfThor.Basepage5.Startuptools1' AS startuptools WITH ; + Height = 272, ; + Name = "Startuptools1", ; + Top = 2, ; + Visible = .T., ; + Width = 638, ; + gridKeys.ColDescription.Header1.Name = "Header1", ; + gridKeys.ColDescription.Name = "ColDescription", ; + gridKeys.ColDescription.Text1.Name = "Text1", ; + gridKeys.ColPrompt.Header1.Name = "Header1", ; + gridKeys.ColPrompt.Name = "ColPrompt", ; + gridKeys.ColPrompt.Text1.Name = "Text1", ; + gridKeys.ColumnCheckBox.check1.Alignment = 0, ; + gridKeys.ColumnCheckBox.check1.Name = "check1", ; + gridKeys.ColumnCheckBox.Header1.Name = "Header1", ; + gridKeys.ColumnCheckBox.Name = "ColumnCheckBox", ; + gridKeys.Height = 260, ; + gridKeys.Name = "gridKeys", ; + gridKeys.Width = 626 + *< END OBJECT: ClassLib="thor_ui.vcx" BaseClass="container" /> + + PROCEDURE addpemeditortools + Lparameters toTree, lcParentKey, lnMenuID, raTools, lcFilter + + Local laMenuTools[1], lcHotKey, lcKey, lcKeystroke, lcMenuStatusBar, lcPRGName, lcPrompt + Local lcStatusBar, llSeparator, lnHotKeyID, lnI, lnID, lnIndex, lnSubMenuID, loNode + + Select MenuTools.Prompt ; + , Separator ; + , SubMenuID ; + , PRGName ; + , MenuTools.Id ; + , MenuDefinitions.HotKeyID ; + From MenuTools ; + Left Join MenuDefinitions ; + On SubMenuID = MenuDefinitions.Id ; + Where MenuID = lnMenuID ; + Order By MenuTools.sortorder ; + Into Array laMenuTools + + For lnI = 1 To _Tally + lcPrompt = Alltrim (laMenuTools (lnI, 1)) + llSeparator = laMenuTools (lnI, 2) + lnSubMenuID = laMenuTools (lnI, 3) + lcPRGName = Alltrim (laMenuTools (lnI, 4)) + lnID = laMenuTools (lnI, 5) + lnHotKeyID = laMenuTools (lnI, 6) + + Do Case + Case llSeparator + * loNode = toTree.Nodes.Add (lcParentKey, 4, lcParentKey + '\' + Str (lnID), Replicate('-', 30)) + Case lnSubMenuID # 0 + lcKey = lcParentKey + '\' + Chrtran (lcPrompt, '/\', '__') + lcHotKey = Thisform.GetHotKeyDescription (lnHotKeyID) + loNode = toTree.Nodes.Add (lcParentKey, 4, lcKey, ; + lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_MENU) + This.AddPEMEditorTools (toTree, lcKey, lnSubMenuID, @raTools, lcFilter) + loNode.Expanded = Not Empty (lcFilter) + Otherwise + If Empty (lcFilter) Or 0 # Ascan (raTools, lcPRGName, 6, -1, -1, 15) + lcKey = lcParentKey + '\' + Str (lnID) + = Seek (Upper (lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + lcHotKey = Thisform.GetHotKeyDescription (ToolHotKeyAssignments.HotKeyID) + loNode = toTree.Nodes.Add (lcParentKey, 4, lcKey, ; + lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_TOOL) + lnIndex = Thisform.oTools.GetKey (Upper (lcPRGName)) + If lnIndex > 0 + loNode.Tag = Thisform.oTools (lnIndex) + Endif + Endif + Endcase + Endfor + + If toTree.Nodes (lcParentKey).Children = 0 + toTree.Nodes.Remove (lcParentKey) + Endif + + ENDPROC + + PROCEDURE Destroy + * Run Thor to update all hotkeys and menus. + + _Screen.oThorUI = .Null. + This.oSelectTool = .Null. + This.RunThor() + + * Close all tables. + + close tables all + dodefault() + + ENDPROC + + PROCEDURE edittool && Edits the specified tool + *============================================================================== + * Method: EditTool + * Purpose: Edits the specified tool + * Author: Doug Hennig + * Last revision: 04/23/2011 + * Parameters: tcPRGName - the name of the PRG to edit + * Returns: none + * Environment in: This.oThor contains a reference to a ThorEngine object + * Environment out: if the PRG is found, it's opened in an editor window + *============================================================================== + + Lparameters tcPRGName + Local lcFile, loPEME_Tools + lcFile = This.oThor.FindFile (tcPRGName) + If Empty (lcFile) + Messagebox (Strtran (ccCANT_FIND, '%1', tcPRGName), MB_OK + MB_ICONSTOP, ; + ccTHOR_CAPTION) + Else + Execscript (_Screen.cThorDispatcher, 'Thor_Proc_EditProc', lcFile) + Endif Empty (lcFile) + + ENDPROC + + PROCEDURE gethotkeydescription + Lparameters tnHotKeyID + + If Seek (tnHotKeyID, 'HotKeyDefinitions', 'ID') + Return Trim (HotKeyDefinitions.Descript) + Else + Return '' + Endif + + ENDPROC + + PROCEDURE help + Local loLink + loLink = Newobject('_ShellExecute', Home() + 'FFC\_Environ.vcx') + loLink.ShellExecute(ThorHelpURL) + + ENDPROC + + PROCEDURE Init + Lparameters toTools, ; + tcThorFolder + With This + + With This.oImageList + .ListImages.Add(1, ccIMAGE_MENU, LoadPicture('Menus.ico')) + .ListImages.Add(2, ccIMAGE_TOOL, LoadPicture('Programs.ico')) + .ListImages.Add(3, ccIMAGE_POPUP, LoadPicture('Popup.ico')) + Endwith + + * Create a Thor_Engine object and open its tables. + + .oThor = Newobject ('Thor_Engine', 'Thor.vcx', '', tcThorFolder + 'Thor\') + .oThor.OpenTables() + + * Set the caption. + + .Caption = ccTHOR_CAPTION + .lblVersion.Caption = ccTHORVERSION + .lblFolder.Caption = Lower(tcThorFolder) + + * Save the passed parameters. + + .oTools = toTools + .cThorFolder = tcThorFolder + + * Don't allow the form to be sized smaller than the default. + + .MinHeight = .Height + .MinWidth = .Width + + * Activate the first page so the TreeView loads. + .nFontSize = .oThor.GetOption ('FontSize') + .SetFontSize(.nFontSize) + + .pgfThor.ActivePage = 1 + + .BindControls = .T. + + Endwith + DoDefault() + + ENDPROC + + PROCEDURE loadtree && Loads the TreeView + Lparameters toTree, tcFilter + + Local laPrev[1], laThis[1], laTools[1], lcCategory, lcFilter, lcHotKey, lcKey, lcPRGName + Local lcParentKey, lcPrev, lcPreviousCategory, lcPrompt, lcSortKey, lcSource, lcSubCategory, lcThis + Local lnI, lnJ, lnK, lnMax1, lnMax2, lnPersonalBackColor, lnPersonalForeColor, lnPrivateBackColor + Local lnPrivateForeColor, lnSort, lnStart, lnToolCount, loNode, loTool, loTools + + lcFilter = Chrtran(tcFilter, ',.;:', ' ') + toTree.Nodes.Clear() + loTools = Thisform.oTools + lnToolCount = 0 + + lnPrivateBackColor = Nvl(This.oThor.GetOption ('PrivateBackColor'), cnDefaultPrivateBackColor) + lnPrivateForeColor = Nvl(This.oThor.GetOption ('PrivateForeColor'), cnDefaultPrivateForeColor) + + lnPersonalBackColor = Nvl(This.oThor.GetOption ('PersonalBackColor'), cnDefaultPersonalBackColor) + lnPersonalForeColor = Nvl(This.oThor.GetOption ('PersonalForeColor'), cnDefaultPersonalForeColor) + + For lnI = 1 To loTools.Count + loTool = loTools.Item(lnI) + lcSource = Evl(Trim(loTool.Source), '(No Source)') + lcCategory = Evl(Trim(loTool.Category), lcSource) + lcSubCategory = Trim(loTool.SubCategory) + lnSort = Evl(loTool.Sort, 9999) + lcSortKey = loTool.InternalSort + lcPRGName = loTool.PRGName + + If FilterTool (lcFilter, loTool) + lnToolCount = lnToolCount + 1 + Dimension laTools(lnToolCount, 6) + laTools(lnToolCount, 1) = lnI + laTools(lnToolCount, 2) = lcSource + laTools(lnToolCount, 3) = lcCategory + laTools(lnToolCount, 4) = lcSubCategory + laTools(lnToolCount, 5) = lcSortKey + laTools(lnToolCount, 6) = lcPRGName + Endif + Endfor + + If lnToolCount > 0 + Asort(laTools, 5) + lcPreviousCategory = '' + + For lnI = 1 To lnToolCount + + loTool = loTools.Item(laTools(lnI, 1)) + lcSource = laTools(lnI, 2) + lcCategory = laTools(lnI, 3) + + *!* * Removed 2/3/2012 + *!* If lcSource == 'Thor' + *!* Loop + *!* Endif + + If Not lcCategory == lcPreviousCategory + lnMax1 = Alines(laPrev, lcPreviousCategory, 5, '|') + lnMax2 = Alines(laThis, lcCategory, 5, '|') + If lnI = 1 + lnJ = 1 + Else + lnStart = 1 + Min(lnMax1, lnMax2) + lcKey = '' + For lnJ = 1 To Min(lnMax1, lnMax2) + lcPrev = laPrev[lnJ] + lcThis = laThis[lnJ] + If Not Upper(lcPrev) == Upper(lcThis) + lnStart = lnJ + Exit + Endif + lcKey = Upper(lcKey + Iif(lnJ > 1, '\', '') + lcThis) + Endfor + Endif + For lnK = lnJ To lnMax2 + If lnK = 1 + lcKey = Upper(laThis[1]) + loNode = toTree.Nodes.Add(, 1, lcKey, laThis[1], ccIMAGE_MENU) + loNode.Expanded = .T. + loNode.Bold = .T. + Else + lcParentKey = Upper(lcKey) + lcKey = Upper(lcParentKey + '\' + Chrtran(laThis[lnK], '.,;\/', '-----')) + loNode = toTree.Nodes.Add(lcParentKey, 4, lcKey, laThis[lnK], ccIMAGE_MENU) + loNode.Expanded = Not Empty(lcFilter) + Endif + Endfor + Endif + + lcPrompt = loTool.Prompt + lcPRGName = loTool.PRGName + = Seek(Upper(lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + lcHotKey = Thisform.GetHotKeyDescription(ToolHotKeyAssignments.HotKeyID) + loNode = toTree.Nodes.Add(lcKey, 4, lcKey + '\' + lcPRGName ; + , lcPrompt + Iif(Empty(lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_TOOL) + Do Case + Case loTool.PrivateCopy = 1 + loNode.ForeColor = m.lnPersonalForeColor + loNode.BackColor = m.lnPersonalBackColor + Case loTool.PrivateCopy = -1 + loNode.ForeColor = m.lnPrivateForeColor + loNode.BackColor = m.lnPrivateBackColor + Endcase + + loNode.Tag = loTool + + lcPreviousCategory = lcCategory + + Endfor && lnI = 1 To lnToolCount + + Else + + lcKey = 'No matches found' + loNode = toTree.Nodes.Add(, 1, lcKey, lcKey, ccIMAGE_MENU) + loNode.Bold = .T. + loNode.ForeColor = Rgb(255, 0, 0) + + Endif + + Return + + ************************************************************************************ + ************************************************************************************ + + Lparameters toTree, tcFilter + + + toTree.Nodes.Clear() + loTools = Thisform.oTools + lnToolCount = 0 + lcFilter = Upper (tcFilter) + + Do While lnToolCount = 0 + For lnI = 1 To loTools.Count + loTool = loTools.Item (lnI) + lcSource = Evl (Trim (loTool.Source), '(No Source)') + lcCategory = Evl (Trim (loTool.Category), lcSource) + lcSubCategory = Trim (loTool.SubCategory) + lnSort = Evl(loTool.Sort, 9999) + lcSortKey = loTool.InternalSort + lcPRGName = loTool.PRGName + + If (Empty (lcFilter)) ; + Or lcFilter $ Upper (lcSortKey + lcSource + loTool.Summary + loTool.Description) + lnToolCount = lnToolCount + 1 + Dimension laTools (lnToolCount, 6) + laTools (lnToolCount, 1) = lnI + laTools (lnToolCount, 2) = lcSource + laTools (lnToolCount, 3) = lcCategory + laTools (lnToolCount, 4) = lcSubCategory + laTools (lnToolCount, 5) = lcSortKey + laTools (lnToolCount, 6) = lcPRGName + Endif + Endfor + If lnToolCount = 0 + Messagebox ([No matches to '] + tcFilter + [' found. Showing all tools.], 16) + lcFilter = '' + Endif + Enddo && while lnToolCount = 0 + + Asort (laTools, 5) + lcPreviousCategory = '' + + For lnI = 1 To lnToolCount + + loTool = loTools.Item (laTools (lnI, 1)) + lcSource = laTools (lnI, 2) + lcCategory = laTools (lnI, 3) + + *!* * Removed 2/3/2012 + *!* If lcSource == 'Thor' + *!* Loop + *!* Endif + + If Not lcCategory == lcPreviousCategory + lnMax1 = Alines (laPrev, lcPreviousCategory, 5, '|') + lnMax2 = Alines (laThis, lcCategory, 5, '|') + If lnI = 1 + lnJ = 1 + Else + lnStart = 1 + Min (lnMax1, lnMax2) + lcKey = '' + For lnJ = 1 To Min (lnMax1, lnMax2) + lcPrev = laPrev[lnJ] + lcThis = laThis[lnJ] + If Not Upper (lcPrev) == Upper (lcThis) + lnStart = lnJ + Exit + Endif + lcKey = Upper(lcKey + Iif (lnJ > 1, '\', '') + lcThis) + Endfor + Endif + For lnK = lnJ To lnMax2 + If lnK = 1 + lcKey = Upper(laThis[1]) + loNode = toTree.Nodes.Add (, 1, lcKey, laThis[1], ccIMAGE_MENU) + loNode.Expanded = Not Empty (lcFilter) + loNode.Bold = .T. + Else + lcParentKey = Upper(lcKey) + lcKey = Upper(lcParentKey + '\' + Chrtran(laThis[lnK], '.,;\/', '-----')) + loNode = toTree.Nodes.Add (lcParentKey, 4, lcKey, laThis[lnK], ccIMAGE_MENU) + loNode.Expanded = Not Empty (lcFilter) + Endif + Endfor + Endif + + lcPrompt = loTool.Prompt + lcPRGName = loTool.PRGName + = Seek (Upper (lcPRGName), 'ToolHotKeyAssignments', 'PRGName') + lcHotKey = Thisform.GetHotKeyDescription (ToolHotKeyAssignments.HotKeyID) + loNode = toTree.Nodes.Add (lcKey, 4, lcKey + '\' + lcPRGName ; + , lcPrompt + Iif (Empty (lcHotKey), '', ' (' + lcHotKey + ')'), ccIMAGE_TOOL) + loNode.Tag = loTool + + lcPreviousCategory = lcCategory + + Endfor && lnI = 1 To lnToolCount + + + + ENDPROC + + PROCEDURE notthorinternalmenu + Do Case + Case Trim (MenuDefinitions.PopupName) == 'Thor_Internal' + Return .F. + Case Trim (MenuDefinitions.PopupName) == ccRunAllTools + Return .F. + Otherwise + Return .T. + Endcase + ENDPROC + + PROCEDURE openoptionspage + Lparameters lcTool + + With This.pgfThor + .ActivePage = 5 + If Not Empty(lcTool) + Try + .Pages[3].ThorOptions1.Selectitem(lcTool) + Catch + + Endtry + Endif + Endwith + + + ENDPROC + + PROCEDURE refreshtools && Refreshes the tools + *============================================================================== + * Method: RefreshTools + * Purpose: Refreshes the tools + * Author: Doug Hennig + * Last revision: 03/31/2011 + * Parameters: none + * Returns: none + * Environment in: This.oTools.Tag contains the tools folder + * Environment out: the tools collection has been recreated and controls on the + * form refreshed + *============================================================================== + + with This + .oTools = .oThor.GetToolsCollection(.oTools.Tag) + .lRefreshTools = .T. + .lRefreshSelectToolTreeView = .T. + .Refresh() + .lRefreshTools = .F. + messagebox(ccTOOLS_REFRESHED, MB_OK, ccTHOR_CAPTION) + endwith + + ENDPROC + + PROCEDURE runthor && Runs Thor to update the hotkeys and menus + *============================================================================== + * Method: RunThor + * Purpose: Runs Thor to update the hotkeys and menus + * Author: Doug Hennig + * Last revision: 04/09/2011 + * Parameters: none + * Returns: none + * Environment in: This.cThorFolder contains the Thor folder + * Environment out: Thor_Run has been instantiated and its Run method called + *============================================================================== + + local lcApp, ; + lcFolder, ; + loRunThor + lcApp = This.cThorFolder + 'Thor.App' + lcFolder = This.cThorFolder + 'Thor\' + loRunThor = newobject ('Thor_Run', 'thor_run.vcx', '', lcApp, lcFolder) + loRunThor.AddProperty('cApplication', lcApp) + loRunThor.Run(.T.) && but no startups + + * Display a message if we're supposed to. + + if This.oThor.GetOption('UpdateMessage') + messagebox (ccRUN_THOR_DONE, MB_OK, ccTHOR_CAPTION, 3000) + endif This.oThor.GetOption('UpdateMessage') + + + ENDPROC + + PROCEDURE setfontsize + Lparameters tnFontSize + + Local lnFontsize + lnFontsize = Nvl (tnFontSize, 8) + With This + .FontSize = lnFontsize + .SetAll ('FontSize', lnFontsize) + With .pgfThor + .BASEPAGE1.omenu.oTree.Font.Size = lnFontsize + * .BASEPAGE2.Toolkeys1.oList.Font.Size = lnFontsize + .BASEPAGE3.ThorOptions1.oList.Font.Size = lnFontsize + Endwith + Endwith + ENDPROC + + PROCEDURE cmdHelp.Click + Thisform.Help() + + ENDPROC + + PROCEDURE cmdHelp.Init + This.ToolTipText = ccHELP_TOOLTIP + DoDefault() + + ENDPROC + + PROCEDURE cmdRefresh.Click + Thisform.RefreshTools() + + ENDPROC + + PROCEDURE cmdRefresh.Init + This.ToolTipText = ccTOOL_TOOLTIP + DoDefault() + + ENDPROC + + PROCEDURE cmdRunThor.Click + Local lnRecno + lnRecno = Recno ('MenuDefinitions') + + Thisform.RunThor() + + Try + Goto (lnRecno) In MenuDefinitions + Catch + + Endtry + + + ENDPROC + + PROCEDURE cmdRunThor.Init + This.ToolTipText = ccTHOR_TOOLTIP + DoDefault() + + ENDPROC + + PROCEDURE pgfThor.basepage1.Init + This.Caption = ccMENU_DEFINITIONS + dodefault() + + ENDPROC + + PROCEDURE pgfThor.Basepage2.Activate + * This is here as a workaround for a weird issue that cause a ghost image to + * appear when the Hot Key Assignments page is selected for the first time. + + dodefault() + Thisform.Cls() + + ENDPROC + + PROCEDURE pgfThor.Basepage2.Init + This.Caption = ccTOOL_DEFINITIONS + dodefault() + + ENDPROC + + PROCEDURE pgfThor.Basepage3.Init + This.Caption = ccOPTIONS + dodefault() + + ENDPROC + + PROCEDURE pgfThor.Basepage4.Activate + * This is here as a workaround for a weird issue that cause a ghost image to + * appear when the Hot Key Assignments page is selected for the first time. + + dodefault() + This.Hotkeylist1.LoadList() + Thisform.Cls() + + ENDPROC + + PROCEDURE pgfThor.Basepage5.Activate + * This is here as a workaround for a weird issue that cause a ghost image to + * appear when the Hot Key Assignments page is selected for the first time. + + dodefault() + This.Startuptools1.LoadList() + Thisform.Cls() + + ENDPROC + +ENDDEFINE diff --git a/Thor/Source/tmpbasecontrols.vct b/Thor/Source/tmpbasecontrols.vct deleted file mode 100644 index 57e206b0..00000000 Binary files a/Thor/Source/tmpbasecontrols.vct and /dev/null differ diff --git a/Thor/Source/tmpbasecontrols.vcx b/Thor/Source/tmpbasecontrols.vcx deleted file mode 100644 index 04251722..00000000 Binary files a/Thor/Source/tmpbasecontrols.vcx and /dev/null differ diff --git a/Thor/Source/tmpbaseprojecthooks.vct b/Thor/Source/tmpbaseprojecthooks.vct deleted file mode 100644 index 742afd66..00000000 Binary files a/Thor/Source/tmpbaseprojecthooks.vct and /dev/null differ diff --git a/Thor/Source/tmpbaseprojecthooks.vcx b/Thor/Source/tmpbaseprojecthooks.vcx deleted file mode 100644 index 4a82be86..00000000 Binary files a/Thor/Source/tmpbaseprojecthooks.vcx and /dev/null differ diff --git a/Thor/Source/tmpbuildthor.prg b/Thor/Source/tmpbuildthor.prg deleted file mode 100644 index fc82a674..00000000 --- a/Thor/Source/tmpbuildthor.prg +++ /dev/null @@ -1,137 +0,0 @@ -Lparameters tlDebugInfo - -Local laFiles[1], laStack[1], lcApp, lcAppName, lcDestSourceFolder, lcFile, lcFolder, lcFullAppName -Local lcJimsFile, lcNewVersion, lcProcFolder, lcProject, lcSourceFolder, lcSubFolder, llBeta, lnI -Local loException -lcNewVersion = UpdateThorVersionNumber() -llBeta = Occurs ('.', lcNewVersion) = 3 - -lcProject = 'Thor.PJX' -Select 0 -Use (lcProject) Again -Locate For Type = 'H' -Replace Debug With .T. && tlDebugInfo Or llBeta -Use - -Erase thor_main.prg -InsertPRGTextFromTemplateFiles ('Thor_Main_Template', 'Thor_Main') - -Astackinfo (laStack) -lcApp = laStack[1, 2] -lcFolder = Addbs (Justpath (lcApp)) - -If Upper ('Beta') $ Upper (lcNewVersion) - lcAppName = '..\Installation Folder - Beta\Thor' -Else - lcAppName = '..\Installation Folder\Thor' -Endif - -lcFullAppName = lcFolder + lcAppName + '.app' -Build App (lcFullAppName) From ('Thor.PJX') recompile - -* ================================================================================ -* ================================================================================ -* erase files in the installation Procs folder -EraseFilesInFolder(lcAppName + '\Tools\Procs\') - -lcSourceFolder = Addbs (Curdir()) + 'Procs\' -lcProcFolder = lcAppName + '\Tools\Procs\' -Adir (laFiles, lcSourceFolder + '*.*', '', 1) -For lnI = 1 To Alen (laFiles, 1) - lcFile = laFiles[lnI, 1] - Copy File (lcSourceFolder + lcFile) To (lcProcFolder + 'Tmp' + lcFile) - RenameFile (Lower (lcProcFolder + 'Tmp' + lcFile), lcProcFolder + lcFile) -Endfor - -************************************************************** -* erase files in the installation Source folder -lcDestSourceFolder = lcAppName + '\Source\' -EraseFilesInFolder(lcDestSourceFolder) - -lcSourceFolder = Addbs (Curdir()) -Adir (laFiles, lcSourceFolder + '*.*', 'D', 1) -For lnI = 1 To Alen (laFiles, 1) - lcFile = laFiles[lnI, 1] - Do Case - Case 'D' $ laFiles[lnI, 5] && folder - - m.lcSubFolder = lcDestSourceFolder + lcFile - Try - Mkdir (m.lcSubFolder) - Catch To loException - Endtry - - EraseFilesInFolder(m.lcSubFolder) - Try - Copy File (lcSourceFolder + lcFile + '\*.*') To (m.lcSubFolder) - Catch - Endtry - - Case Inlist(Upper (Justext (lcFile)), 'BAK', 'FXP', 'VCA') - - Otherwise - Try - Copy File (lcSourceFolder + lcFile) To (lcDestSourceFolder + 'Tmp' + lcFile) - RenameFile (Lower (lcDestSourceFolder + 'Tmp' + lcFile), m.lcSubFolder) - Catch To loException - - Endtry - Endcase -EndFor - -************************************************************** -lcThorFolder = GetThorFolder() -lcJimsFile = 'C:\Visual FoxPro\Programs\MyThor\THOR.APP' -If Directory (Justpath (lcJimsFile)) - If llBeta Or Messagebox ('Replace my copy? ', 4) = 6 - If File (lcJimsFile) - Erase (lcJimsFile) - Endif - Copy File (lcFullAppName) To (lcJimsFile) - Endif -Endif -Return - - - - -Procedure RenameFile (lcOldName, lcNewName) - Local success - - Declare Integer MoveFile In win32api String @ src, String @ Dest - - success = Not Empty (MoveFile (lcOldName, lcNewName)) - - Return success -Endproc - - -Procedure EraseFilesInFolder(tcFolder) - Local laFiles[1], lcFolder, lnCount, lnI - lcFolder = Addbs(tcFolder) - lnCount = Adir (laFiles, lcFolder + '*.*', '', 1) - For lnI = 1 To lnCount - Erase (lcFolder + laFiles[lnI, 1]) - Endfor -EndProc - - - -Procedure GetThorFolder() - - Local laFolders[1], lcFolder, lcFolders, lnCount, lnI - - Text To m.lcFolders Noshow Textmerge -C:\Users\Jim Nelson\DropBox\VFP Utilities\MyThor -C:\DropBox\VFP Utilities\MyThor -C:\Visual Foxpro\Programs\MyThor - Endtext - - lnCount = Alines(laFolders, m.lcFolders) - For lnI = 1 To m.lnCount - lcFolder = Addbs(m.laFolders[m.lni]) - If File(m.lcFolder + 'Thor.APP') - Return m.lcFolder - Endif - Endfor -Endproc diff --git a/Thor/Source/tmpcreatecloudversionfile.prg b/Thor/Source/tmpcreatecloudversionfile.prg deleted file mode 100644 index 281f5d7e..00000000 --- a/Thor/Source/tmpcreatecloudversionfile.prg +++ /dev/null @@ -1,34 +0,0 @@ -Lparameters lcPrefix, lcVersion, lcSourceURL, lcUpdateVersionFile, lcLinkPrompt, lcLink, tcNote, lcAltSourceUTL - -********************************************************* -Local lcNewVersion, lcText -lcNewVersion = lcPrefix + ' - ' + Alltrim (lcVersion) + [ - ] + SpellDate() + ' - ' + Dtoc(Date(),1) - -Text To lcText Noshow Textmerge -Lparameters toUpdateInfo - -Local lcNote -AddProperty(toUpdateInfo, 'AvailableVersion', '<>') -AddProperty(toUpdateInfo, 'SourceFileUrl', '<>') -AddProperty(toUpdateInfo, 'AltSourceFileUrl', '<>') -AddProperty(toUpdateInfo, 'LinkPrompt', '<>') -AddProperty(toUpdateInfo, 'Link', '<>') - -###Text to lcNote NoShow -<> -###EndText - -AddProperty(toUpdateInfo, 'Notes', lcNote) - -Execscript (_Screen.cThorDispatcher, 'Result=', toUpdateInfo) -Return toUpdateInfo - -Endtext - -lcText = Strtran(lcText, '###', '') - -Erase (lcUpdateVersionFile) -Strtofile (lcText, lcUpdateVersionFile, 0) -********************************************************* - -Return lcNewVersion diff --git a/Thor/Source/tmpcreateinternaltools.prg b/Thor/Source/tmpcreateinternaltools.prg deleted file mode 100644 index 37304148..00000000 --- a/Thor/Source/tmpcreateinternaltools.prg +++ /dev/null @@ -1,97 +0,0 @@ -Local laPRGs[1], lcCode, lcCreateGetPROC, lcCreatePRG, lcFileName, lcInstallTool, lcNewProcs, lcPRG -Local lcProcName, lnI - -loPRGList = Createobject('Collection') -AddPrgs(loPRGList, 'Thor_Tool_*.PRG') -AddPrgs(loPRGList, 'Procs_For_Thor\Thor_*.PRG') -* AddPrgs(loPRGList, 'Updates\Thor_*.PRG') - -lcCode = '' -lcNewProcs = '' - -For lnI = 1 To loPRGList.Count - lcPRG = Strtran(Alltrim (loPRGList[lnI]), '.PRG', '', 1, 1, 1) - lcProcName = Substr (lcPRG, 1 + Rat ('\', lcPRG)) - lcFileName = Forceext (lcPRG, 'PRG') - - ********************************************** - TEXT To lcCreatePRG Textmerge Noshow - - InstallTool(Get<> (tcFolder), ; - lcToolsFolder + '<>') - - ENDTEXT - ********************************************** - - lcCode = lcCode + lcCreatePRG + Chr(13) + Chr(10) - - ********************************************** - TEXT To lcCreateGetPROC Textmerge Noshow -Procedure Get<> (tcFolder) - - Local lcCode, lcVersion - lcVersion = ccTHORVERSION - {{TEXT}} To lcCode Noshow Textmerge -{{{{GoGet('<>')}}}} - {{ENDTEXT}} - Return Strtran(lcCode, '*##*', '') - -EndProc - - - ENDTEXT - ********************************************** - - lcCreateGetPROC = Strtran (lcCreateGetPROC, '{{TEXT}}', 'Text') - lcCreateGetPROC = Strtran (lcCreateGetPROC, '{{ENDTEXT}}', 'EndText') - lcCreateGetPROC = Strtran (lcCreateGetPROC, '{{{{', '<<<<') - lcCreateGetPROC = Strtran (lcCreateGetPROC, '}}}}', '>>>>') - - lcNewProcs = lcNewProcs + lcCreateGetPROC - -Endfor - -TEXT To lcInstallTool Textmerge Noshow -EndProc - - -Procedure InstallTool(tcCode, tcFileName) - Erase (tcFileName) - StrToFile (tcCode, tcFileName) - -EndProc - - -ENDTEXT -Return lcCode + lcInstallTool + lcNewProcs - - - - -Procedure GoGet (tcFileName) - Local lcResult, lcText - *!* If '\' $ tcFileName - *!* lcFolder = 'C:\Documents and Settings\Jim\My Documents\Dropbox\Public\Thor Repository\Current\' - *!* lcResult = Filetostr (Forceext (lcFolder + tcFileName, 'PRG')) - *!* Else - lcResult = Filetostr (Forceext (tcFileName, 'PRG')) - lcText = Strextract (lcResult, '.Version', Chr(13), 1, 5) - If Not Empty (lcText) And '.VERSION' == Upper(GetWordNum(lcText, 1)) - lcResult = Stuff (lcResult, At (lcText, lcResult), Len (lcText), ".Version = '<>'" + Chr(13)) - Endif - *!* Endif - Assert Not Empty(lcResult) - Return lcResult -Endproc - - -Procedure AddPrgs (loPRGList, lcTemplate) - Local laFiles[1], lcPrefix, lnFileCount, lnI - lcPrefix = Left(lcTemplate, At('\', lcTemplate)) - lnFileCount = Adir(laFiles, lcTemplate,'',1) - For lnI = 1 To lnFileCount - loPRGList.Add(lcPrefix + laFiles[lnI,1]) - Endfor -Endproc - - diff --git a/Thor/Source/tmpcreatethorrepository.prg b/Thor/Source/tmpcreatethorrepository.prg deleted file mode 100644 index 200fa8c3..00000000 --- a/Thor/Source/tmpcreatethorrepository.prg +++ /dev/null @@ -1,4 +0,0 @@ -Erase xxx.html -StrToFile(CreateThorToolCatalogVFPx('thor repository,ide tools'), 'xxx.html') - loLink = Newobject ('_ShellExecute', Home() + 'FFC\_Environ.vcx') - loLink.ShellExecute ('xxx.html') diff --git a/Thor/Source/tmpcreatethortoolcatalog.prg b/Thor/Source/tmpcreatethortoolcatalog.prg deleted file mode 100644 index ab578e08..00000000 --- a/Thor/Source/tmpcreatethortoolcatalog.prg +++ /dev/null @@ -1,168 +0,0 @@ -Lparameters tcSources, tlStyle - -Local laTools[1], lcCategory, lcCategoryHeader, lcCategoryStyle, lcDescription, lcFilename, lcHtml -Local lcLink, lcPreviousCategory, lcSources, lcSubCat, lcTableCellStyle, lcTableHeaderStyle -Local lcTableStyle, lcTool, lcToolFolder, lcToolName, lcVideoLink, lcVideoTime, lcVideoUrl -Local lnCategoryCount, lnCount, lnPos, lnX, loThor, loTool, loTools -Local x - -If Empty (tcSources) - lcSources = '' -Else - lcSources = Upper ('|' + Chrtran (tcSources, ',;', '||') + '|') -Endif - -lcToolFolder = Execscript (_Screen.cThorDispatcher, 'Tool Folder=') -loThor = Execscript (_Screen.cThorDispatcher, 'Thor Engine=') -loTools = loThor.GetToolsCollection (lcToolFolder) - -Dimension laTools (loTools.Count, 2) -lnX = 1 - -For Each loTool In loTools - laTools[lnX, 1] = loTool.internalsort - laTools[lnX, 2] = loTool - lnX = lnX + 1 -Endfor - -= Asort (laTools) - -lcPreviousCategory = 'XXXXXXXXXX' -lcHtml = '' -lnCategoryCount = 0 - -*--- Define CSS Styles --------------------------------- - -Text To lcCategoryStyle Noshow Pretext 15 - border-width: 1px; - border-style: solid; - background-color: #FFFF99; - border-color: #EBEBEB; - margin-bottom: 5px; - padding: 5px; -Endtext - -Text To lcTableStyle Noshow Pretext 15 - border-width: 0px; - border-spacing: 0px; - border-style: solid; - border-color: white; - border-collapse: collapse; - background-color: white; - margin-top: -1px; - width: 100% -Endtext - -Text To lcTableHeaderStyle Noshow Pretext 15 - border-width: 0px; - padding: 1px; - border-style: inset; - border-color: gray; - background-color: white; -Endtext - -Text To lcTableCellStyle Noshow Pretext 15 - border-width: 1px; - padding: 2px; - border-style: solid; - border-color: #E2E2E2; - background-color: white; - vertical-align: top; -Endtext - -lnCount = 0 - - lcToolFolder = ExecScript(_Screen.cThorDispatcher, "Tool Folder=") - Assert .F. - -For x = 1 To loTools.Count - - loTool = laTools[x, 2] - - If Empty (lcSources) Or ; - (Upper ('|' + loTool.Source + '|') $ lcSources and Upper(lcToolFolder) == Upper(Addbs(JustPath(loTool.FullFilename)))) - lcCategory = Getwordnum (loTool.Category, 1, '|') - lnPos = Atc ('|', loTool.Category) - - If lnPos = 0 - lcSubCat = '' - Else - lcSubCat = '' + Substr (loTool.Category, lnPos + 1) - lcSubCat = Strtran (lcSubCat, '|', ' =>
') - lcSubCat = lcSubCat + ' =>
' - Endif - - lcToolName = '' + loTool.Prompt + '' - - *===== Category section ================================ - If lcCategory # lcPreviousCategory - - If lnCategoryCount > 0 - lcHtml = lcHtml + '' - Endif - - Text To lcCategoryHeader Noshow Textmerge -
- Category: <> -
- Endtext - - lcHtml = lcHtml + Iif (lnCategoryCount > 0, '

 

', '') - lcHtml = lcHtml + lcCategoryHeader - - lcPreviousCategory = lcCategory - lnCategoryCount = lnCategoryCount + 1 - - *-- Start a new table for the tools in this Category. - lcHtml = lcHtml + '' - - Endif - - *======== Tools within each Category - lcFilename = '
' + 'Filename: ' + Justfname (loTool.FullFilename) - lcLink = Iif (Not Empty (loTool.Link), '
Link: Tool home page', '') - lcVideoUrl = Getwordnum (loTool.videolink, 1, '|') - lcVideoTime = Getwordnum (loTool.videolink, 2, '|') - lcVideoLink = Iif (Not Empty (loTool.videolink), '
Video: Watch video', '') - If Not Empty (lcVideoTime) - lcVideoLink = lcVideoLink + '   (' + lcVideoTime + ')' - Endif - - lcDescription = Strtran (loTool.Description, Chr(13), '
') - lcDescription = lcDescription + '

Source: ' + loTool.Source - If Not Empty (loTool.Link) - lcDescription = lcDescription + '    Tool home page' - Endif - If Not Empty (loTool.videolink) - lcVideoUrl = Getwordnum (loTool.videolink, 1, '|') - lcVideoTime = Getwordnum (loTool.videolink, 2, '|') - lcDescription = lcDescription + '    Watch Video' - If Not Empty (lcVideoTime) - lcDescription = lcDescription + '  (' + lcVideoTime + ')' - Endif - Endif - - Text To lcTool Noshow Textmerge - - - - - - Endtext - - lcHtml = lcHtml + lcTool - lnCount = lnCount + 1 - - Endif - -Endfor - -Wait lnCount Window Nowait -Return lcHtml diff --git a/Thor/Source/tmpcreatethortoolcatalogvfpx.prg b/Thor/Source/tmpcreatethortoolcatalogvfpx.prg deleted file mode 100644 index 98bbcbbe..00000000 --- a/Thor/Source/tmpcreatethortoolcatalogvfpx.prg +++ /dev/null @@ -1,179 +0,0 @@ -Lparameters tcSources, tlStyle - -Local laTools[1], lcCategory, lcCategoryHeader, lcCategoryStyle, lcDescription, lcFilename, lcHtml -Local lcLink, lcPreviousCategory, lcSources, lcSubCat, lcTableCellStyle, lcTableHeaderStyle -Local lcTableStyle, lcTool, lcToolFolder, lcToolName, lcVideoLink, lcVideoTime, lcVideoUrl -Local lnCategoryCount, lnCount, lnPos, lnX, loThor, loTool, loTools -Local x - -If Empty (tcSources) - lcSources = '' -Else - lcSources = Upper ('|' + Chrtran (tcSources, ',;', '||') + '|') -Endif - -lcToolFolder = Execscript (_Screen.cThorDispatcher, 'Tool Folder=') -loThor = Execscript (_Screen.cThorDispatcher, 'Thor Engine=') -loTools = loThor.GetToolsCollection (lcToolFolder) - -Dimension laTools (loTools.Count, 2) -lnX = 1 - -For Each loTool In loTools - laTools[lnX, 1] = loTool.internalsort - laTools[lnX, 2] = loTool - lnX = lnX + 1 -Endfor - -= Asort (laTools) - -lcPreviousCategory = 'XXXXXXXXXX' -lcHtml = '' -lnCategoryCount = 0 - -*--- Define CSS Styles --------------------------------- - -Text To lcCategoryStyle Noshow Pretext 15 -Endtext - -Text To lcTableStyle Noshow Pretext 15 - border-width: 0px; - border-spacing: 0px; - border-style: solid; - border-color: white; - border-collapse: collapse; - background-color: white; - margin-top: -1px; -Endtext - -Text To lcTableHeaderStyle Noshow Pretext 15 - border-width: 0px; - padding: 1px; - border-style: inset; - border-color: gray; - background-color: white; -Endtext - -Text To lcTableCellStyle Noshow Pretext 15 - border-width: 1px; - padding: 2px; - border-style: solid; - border-color: #E2E2E2; - background-color: white; - vertical-align: top; -Endtext - -lnCount = 0 - -lcToolFolder = Execscript (_Screen.cThorDispatcher, 'Tool Folder=') - -For x = 1 To loTools.Count - - loTool = laTools[x, 2] - - If Upper (lcToolFolder) == Upper (Addbs (Justpath (loTool.FullFilename))) and; - (Empty (lcSources) Or (Upper ('|' + loTool.Source + '|') $ lcSources)) - - lcCategory = Getwordnum (Evl(loTool.Category, loTool), 1, '|') - If Upper(lcCategory) == Upper('Applications') - Loop - EndIf - - lnPos = Atc ('|', loTool.Category) - - If lnPos = 0 - lcSubCat = '' - Else - lcSubCat = Substr (loTool.Category, lnPos + 1) - Endif - - *!* * Removed 2/11/2012 - *!* lcToolName = '' + loTool.Prompt + '' - lcToolName = loTool.Prompt - - *===== Category section ================================ - If lcCategory # lcPreviousCategory - - If lnCategoryCount > 0 - lcHtml = lcHtml + '
-   - - <> - <> - - <> -
' - Endif - - Text To lcCategoryHeader Noshow Textmerge -
- Category: <> -
- Endtext - - *!* * Removed 2/12/2012 - *!* lcHtml = lcHtml + Iif (lnCategoryCount > 0, '

 

', '') - lcHtml = lcHtml + lcCategoryHeader - - lcPreviousCategory = lcCategory - lnCategoryCount = lnCategoryCount + 1 - - *-- Start a new table for the tools in this Category. - lcHtml = lcHtml + '' - - lcPreviousSubCat = '' - - EndIf - - If Not lcSubCat == lcPreviousSubCat - Text To lcTool Noshow Textmerge - - - - Endtext - - lcHtml = lcHtml + lcTool - lcPreviousSubCat = lcSubCat - EndIf - - *======== Tools within each Category - lcDescription = Strtran (loTool.Description, Chr(13), '
') - - *!* * Removed 2/11/2012 - *!* lcFilename = '
' + 'Filename: ' + Justfname (loTool.FullFilename) - *!* lcLink = Iif (Not Empty (loTool.Link), '
Link: Tool home page', '') - *!* lcVideoUrl = Getwordnum (loTool.videolink, 1, '|') - *!* lcVideoTime = Getwordnum (loTool.videolink, 2, '|') - *!* lcVideoLink = Iif (Not Empty (loTool.videolink), '
Video: Watch video', '') - *!* If Not Empty (lcVideoTime) - *!* lcVideoLink = lcVideoLink + '   (' + lcVideoTime + ')' - *!* Endif - - *!* lcDescription = lcDescription + '

Source: ' + loTool.Source - *!* If Not Empty (loTool.Link) - *!* lcDescription = lcDescription + '    Tool home page' - *!* Endif - *!* If Not Empty (loTool.videolink) - *!* lcVideoUrl = Getwordnum (loTool.videolink, 1, '|') - *!* lcVideoTime = Getwordnum (loTool.videolink, 2, '|') - *!* lcDescription = lcDescription + '    Watch Video' - *!* If Not Empty (lcVideoTime) - *!* lcDescription = lcDescription + '  (' + lcVideoTime + ')' - *!* Endif - *!* Endif - - Text To lcTool Noshow Textmerge - - - - - Endtext - - lcHtml = lcHtml + lcTool - lnCount = lnCount + 1 - - Endif - -Endfor - -Wait lnCount Window Nowait -Return lcHtml diff --git a/Thor/Source/tmpcreatetool.sct b/Thor/Source/tmpcreatetool.sct deleted file mode 100644 index 767f288a..00000000 Binary files a/Thor/Source/tmpcreatetool.sct and /dev/null differ diff --git a/Thor/Source/tmpcreatetool.scx b/Thor/Source/tmpcreatetool.scx deleted file mode 100644 index 57f991df..00000000 Binary files a/Thor/Source/tmpcreatetool.scx and /dev/null differ diff --git a/Thor/Source/tmpdeploythor.prg b/Thor/Source/tmpdeploythor.prg deleted file mode 100644 index a702c68f..00000000 --- a/Thor/Source/tmpdeploythor.prg +++ /dev/null @@ -1,3 +0,0 @@ -lcFolder = Curdir() -lcFileName = ["] + Sys(5) + Addbs(lcFolder) + 'DeployThor.ps1' + ["] -Run /N &lcFilename \ No newline at end of file diff --git a/Thor/Source/tmpdown.bmp b/Thor/Source/tmpdown.bmp deleted file mode 100644 index 421c0a2b..00000000 Binary files a/Thor/Source/tmpdown.bmp and /dev/null differ diff --git a/Thor/Source/tmpfiltertool.prg b/Thor/Source/tmpfiltertool.prg deleted file mode 100644 index 5cdd7f89..00000000 --- a/Thor/Source/tmpfiltertool.prg +++ /dev/null @@ -1,22 +0,0 @@ -Lparameters tcFilter, toTool - -Local laLines[1], lcText, lnI - -If Empty(tcFilter) - Return .T. -Endif - -lcText = toTool.Prompt + ' ' + ; - toTool.Summary + ' ' + ; - toTool.Description + ' ' + ; - toTool.Category + ' ' + ; - toTool.Source + ' ' + ; - toTool.Author - -For lnI = 1 To Alines(laLines, tcFilter, 5, ' ') - If 0 = Atc(laLines[lnI], lcText) - Return .F. - Endif -Endfor -Return .T. - diff --git a/Thor/Source/tmpfoo.prg b/Thor/Source/tmpfoo.prg deleted file mode 100644 index 16b90a7a..00000000 --- a/Thor/Source/tmpfoo.prg +++ /dev/null @@ -1,200 +0,0 @@ -#include Thor_UI.H -CreateThorTables ('C:\temp\jjj\') - -Procedure CreateThorTables - - * Create the Thor tables if they do not already exist - - Lparameters tcFolder - - * HotKeyDefinitions - - If Not File (tcFolder + 'HotKeyDefinitions.DBF') - Create Table (tcFolder + 'HotKeyDefinitions') Free ; - (Id I Autoinc, nKeyCode I, nShifts N(1), Descript C(40), ; - FKYValue C(2) NoCPTrans) - Index On Id Tag Id - Use - Endif Not File (tcFolder + 'HotKeyDefinitions.DBF') - - * MenuDefinitions - - If Not File (tcFolder + 'MenuDefinitions.DBF') - Create Table (tcFolder + 'MenuDefinitions') Free ; - (Id I Autoinc, Prompt C(60), Internal L, TopLevel L, Popup L, ; - PopupName C(20), SortOrder I, HotKeyID I, StatusBar M) - Index On SortOrder Tag SortOrder - Index On Id Tag Id - Index On HotKeyID Tag HotKeyID - - Insert Into MenuDefinitions (Prompt, Internal, TopLevel, PopupName, SortOrder) ; - Values ('File', .T., .T., '_mFile', 1) - Insert Into MenuDefinitions (Prompt, Internal, TopLevel, PopupName, SortOrder) ; - Values ('Edit', .T., .T., '_mEdit', 2) - Insert Into MenuDefinitions (Prompt, Internal, TopLevel, PopupName, SortOrder) ; - Values ('View', .T., .T., '_mView', 3) - Insert Into MenuDefinitions (Prompt, Internal, TopLevel, PopupName, SortOrder) ; - Values ('Tools', .T., .T., '_mTools', 4) - Insert Into MenuDefinitions (Prompt, Internal, TopLevel, PopupName, SortOrder) ; - Values ('Program', .T., .T., '_mProg', 5) - Insert Into MenuDefinitions (Prompt, Internal, TopLevel, PopupName, SortOrder) ; - Values ('Window', .T., .T., '_mWindow', 6) - Insert Into MenuDefinitions (Prompt, Internal, TopLevel, PopupName, SortOrder) ; - Values ('Help', .T., .T., '_mSystem', 7) - Insert Into MenuDefinitions (Prompt, Internal, TopLevel, PopupName, SortOrder) ; - Values ('Tho\ 'C' - m.cName = '' - ENDIF - IF THIS.OpenResource() - m.nSelect = SELECT() - - m.cType = PADR(THIS.ResourceType, LEN(FoxResource.Type)) - m.cID = PADR(m.cID, LEN(FoxResource.ID)) - - SELECT FoxResource - LOCATE FOR Type == m.cType AND ID == m.cID AND Name == m.cName - IF !FOUND() - APPEND BLANK IN FoxResource - REPLACE ; - Type WITH m.cType, ; - Name WITH m.cName, ; - ID WITH m.cID, ; - ReadOnly WITH .F. ; - IN FoxResource - ENDIF - - IF !FoxResource.ReadOnly - IF THIS.oCollection.Count > 0 - DIMENSION aOptions[THIS.oCollection.Count, 2] - FOR m.i = 1 TO THIS.oCollection.Count - aOptions[m.i, 1] = THIS.oCollection.GetKey(m.i) - aOptions[m.i, 2] = THIS.oCollection.Item(m.i) - ENDFOR - SAVE TO MEMO Data ALL LIKE aOptions - ELSE - BLANK FIELDS Data IN FoxResource - ENDIF - - REPLACE ; - Updated WITH DATE(), ; - ckval WITH VAL(SYS(2007, FoxResource.Data)) ; - IN FoxResource - ENDIF - - THIS.CloseResource() - - SELECT (m.nSelect) - ENDIF - ENDPROC - - PROCEDURE Load(cID, cName) - LOCAL nSelect - LOCAL cType - LOCAL i - LOCAL nCnt - LOCAL ARRAY aOptions[1] - - IF VARTYPE(m.cName) <> 'C' - m.cName = '' - ENDIF - - * THIS.Clear() - IF THIS.OpenResource() - m.nSelect = SELECT() - - m.cType = PADR(THIS.ResourceType, LEN(FoxResource.Type)) - m.cID = PADR(m.cID, LEN(FoxResource.ID)) - - SELECT FoxResource - LOCATE FOR Type == m.cType AND ID == m.cID AND Name == m.cName - IF FOUND() AND !EMPTY(Data) AND ckval == VAL(SYS(2007, Data)) - RESTORE FROM MEMO Data ADDITIVE - IF VARTYPE(aOptions[1,1]) == 'C' - m.nCnt = ALEN(aOptions, 1) - FOR m.i = 1 TO m.nCnt - THIS.Set(aOptions[m.i, 1], aOptions[m.i, 2]) - ENDFOR - ENDIF - ENDIF - - THIS.CloseResource() - - SELECT (m.nSelect) - ENDIF - ENDPROC - - FUNCTION GetData(cID, cName) - LOCAL cData - LOCAL nSelect - LOCAL cType - - IF VARTYPE(m.cName) <> 'C' - m.cName = '' - ENDIF - - m.cData = .NULL. - IF THIS.OpenResource() - m.nSelect = SELECT() - - m.cType = PADR(THIS.ResourceType, LEN(FoxResource.Type)) - m.cID = PADR(m.cID, LEN(FoxResource.ID)) - - SELECT FoxResource - LOCATE FOR Type == m.cType AND ID == m.cID AND Name == m.cName - IF FOUND() AND !EMPTY(Data) && AND ckval == VAL(SYS(2007, Data)) - m.cData = FoxResource.Data - ENDIF - - THIS.CloseResource() - - SELECT (m.nSelect) - ENDIF - - RETURN m.cData - ENDFUNC - - FUNCTION SetData(cID, cName, cSetData, nCkVal) - LOCAL nSelect - LOCAL cType - LOCAL lSuccess - - IF VARTYPE(m.cName) <> 'C' - m.cName = '' - ENDIF - - m.lSuccess = .F. - IF THIS.OpenResource() - m.nSelect = SELECT() - - m.cType = PADR(THIS.ResourceType, LEN(FoxResource.Type)) - m.cID = PADR(m.cID, LEN(FoxResource.ID)) - - SELECT FoxResource - LOCATE FOR Type == m.cType AND ID == m.cID AND Name == m.cName - IF !FOUND() - APPEND BLANK IN FoxResource - REPLACE ; - Type WITH m.cType, ; - Name WITH m.cName, ; - ID WITH m.cID, ; - ReadOnly WITH .F. ; - IN FoxResource - ENDIF - - IF !FoxResource.ReadOnly - REPLACE Data WITH m.cSetData IN FoxResource - - IF VARTYPE(nCkVal) <> 'N' - nCkVal = VAL(SYS(2007, FoxResource.Data)) - ENDIF - - REPLACE ; - Updated WITH DATE(), ; - ckval WITH nCkVal ; - IN FoxResource - - m.lSuccess = .T. - ENDIF - - - THIS.CloseResource() - - SELECT (m.nSelect) - ENDIF - - RETURN m.lSuccess - ENDFUNC - - * Add an item to an MRU list - FUNCTION AddToMRU(cMRUName, cMRUItem) - LOCAL cMRUData - LOCAL nSelect - LOCAL i - LOCAL nCnt - LOCAL ARRAY aMRUList[1] - - IF THIS.OpenResource() - m.nSelect = SELECT() - - m.cType = PADR(THIS.ResourceType, LEN(FoxResource.Type)) - m.cMRUName = PADR(m.cMRUName, LEN(FoxResource.ID)) - - SELECT FoxResource - LOCATE FOR Type == m.cType AND ID == m.cMRUName AND EMPTY(Name) - IF !FOUND() - APPEND BLANK IN FoxResource - REPLACE ; - Type WITH m.cType, ; - Name WITH '', ; - ID WITH m.cMRUName, ; - ReadOnly WITH .F., ; - Data WITH CHR(4) + CHR(0) + CHR(0) ; - IN FoxResource - ENDIF - IF !FoxResource.ReadOnly - m.nCnt = ALINES(aMRUList, SUBSTR(FoxResource.Data, 3), .F., CHR(0)) - - m.cMRUList = m.cMRUItem + CHR(0) - FOR m.i = 1 TO m.nCnt - IF !(UPPER(m.cMRUItem) == UPPER(aMRUList[m.i])) - m.cMRUList = m.cMRUList + aMRUList[m.i] + CHR(0) - ENDIF - ENDFOR - m.cMRUList = m.cMRUList + CHR(0) - - REPLACE ; - Data WITH CHR(4) + CHR(0) + m.cMRUList, ; - CkVal WITH VAL(SYS(2007, m.cMRUList)), ; - Updated WITH DATE() ; - IN FoxResource - - m.lSuccess = .T. - ENDIF - - THIS.CloseResource() - - SELECT (m.nSelect) - ENDIF - ENDFUNC - - * save to a specific fieldname - FUNCTION SaveTo(cField, cAlias) - LOCAL i - LOCAL nSelect - LOCAL lSuccess - LOCAL ARRAY aOptions[1] - - IF VARTYPE(m.cAlias) <> 'C' - m.cAlias = ALIAS() - ENDIF - - IF USED(m.cAlias) - m.nSelect = SELECT() - SELECT (m.cAlias) - - IF THIS.oCollection.Count > 0 - DIMENSION aOptions[THIS.oCollection.Count, 2] - FOR m.i = 1 TO THIS.oCollection.Count - aOptions[m.i, 1] = THIS.oCollection.GetKey(m.i) - aOptions[m.i, 2] = THIS.oCollection.Item(m.i) - ENDFOR - SAVE TO MEMO &cField ALL LIKE aOptions - ELSE - BLANK FIELDS &cField IN FoxResource - ENDIF - SELECT (m.nSelect) - m.lSuccess = .T. - ELSE - m.lSuccess = .F. - ENDIF - - RETURN m.lSuccess - ENDFUNC - - - FUNCTION RestoreFrom(cField, cAlias) - LOCAL i - LOCAL nSelect - LOCAL lSuccess - LOCAL ARRAY aOptions[1] - - IF VARTYPE(m.cAlias) <> 'C' - m.cAlias = ALIAS() - ENDIF - - IF USED(m.cAlias) - m.nSelect = SELECT() - SELECT (m.cAlias) - - RESTORE FROM MEMO &cField ADDITIVE - IF VARTYPE(aOptions[1,1]) == 'C' - m.nCnt = ALEN(aOptions, 1) - FOR m.i = 1 TO m.nCnt - THIS.Set(aOptions[m.i, 1], aOptions[m.i, 2]) - ENDFOR - ENDIF - - SELECT (m.nSelect) - m.lSuccess = .T. - ELSE - m.lSuccess = .F. - ENDIF - - RETURN m.lSuccess - ENDFUNC -ENDDEFINE - diff --git a/Thor/Source/tmpgf_saved_search_results.dbf b/Thor/Source/tmpgf_saved_search_results.dbf deleted file mode 100644 index d7cf6d88..00000000 Binary files a/Thor/Source/tmpgf_saved_search_results.dbf and /dev/null differ diff --git a/Thor/Source/tmpgf_saved_search_results.fpt b/Thor/Source/tmpgf_saved_search_results.fpt deleted file mode 100644 index 601fa8de..00000000 Binary files a/Thor/Source/tmpgf_saved_search_results.fpt and /dev/null differ diff --git a/Thor/Source/tmphotkeys.cdx b/Thor/Source/tmphotkeys.cdx deleted file mode 100644 index 7eefd8f1..00000000 Binary files a/Thor/Source/tmphotkeys.cdx and /dev/null differ diff --git a/Thor/Source/tmphotkeys.dbf b/Thor/Source/tmphotkeys.dbf deleted file mode 100644 index f1a67af2..00000000 Binary files a/Thor/Source/tmphotkeys.dbf and /dev/null differ diff --git a/Thor/Source/tmpinsertprgtextfromtemplatefiles.prg b/Thor/Source/tmpinsertprgtextfromtemplatefiles.prg deleted file mode 100644 index e57d0fbe..00000000 --- a/Thor/Source/tmpinsertprgtextfromtemplatefiles.prg +++ /dev/null @@ -1,18 +0,0 @@ -Lparameters lcFromPRG, lcToPRG - -Local lcNewText, lcSourceCode, lcText - -lcSourceCode = Filetostr (Forceext (lcFromPRG, 'PRG')) -Do While .T. - lcText = Strextract (lcSourceCode, '<<<<', '>>>>', 1, 4) - If Empty (lcText) - Exit - Endif - lcNewText = Evaluate (Substr (lcText, 5, Len (lcText) - 8)) - lcSourceCode = Stuff (lcSourceCode, At (lcText, lcSourceCode), Len (lcText), lcNewText) -Enddo && while .T. - -lcSourceCode = Strtran (lcSourceCode, 'Procs_For_Thor', 'Procs') -StrTofile (lcSourceCode, Forceext (lcToPRG, 'PRG')) - - diff --git a/Thor/Source/tmplockwindow.prg b/Thor/Source/tmplockwindow.prg deleted file mode 100644 index 667b14c9..00000000 --- a/Thor/Source/tmplockwindow.prg +++ /dev/null @@ -1,18 +0,0 @@ -* From Doug Hennig's Win32API session at SW Fox 2012 - -Lparameters tlLock, ; - tnHWnd -Local lnHWnd -Declare Integer LockWindowUpdate In Win32API ; - Integer nHandle -Do Case - Case Not tlLock - lnHWnd = 0 - Case Pcount() = 1 - Declare Integer GetDesktopWindow In Win32API - lnHWnd = GetDesktopWindow() - Otherwise - lnHWnd = tnHWnd -Endcase -LockWindowUpdate(lnHWnd) -Return \ No newline at end of file diff --git a/Thor/Source/tmpmenus.ico b/Thor/Source/tmpmenus.ico deleted file mode 100644 index bca88b9f..00000000 Binary files a/Thor/Source/tmpmenus.ico and /dev/null differ diff --git a/Thor/Source/tmppeme_foxresource.vct b/Thor/Source/tmppeme_foxresource.vct deleted file mode 100644 index 0eaea249..00000000 Binary files a/Thor/Source/tmppeme_foxresource.vct and /dev/null differ diff --git a/Thor/Source/tmppeme_foxresource.vcx b/Thor/Source/tmppeme_foxresource.vcx deleted file mode 100644 index 5b6fe0bc..00000000 Binary files a/Thor/Source/tmppeme_foxresource.vcx and /dev/null differ diff --git a/Thor/Source/tmppeme_winapisupport.prg b/Thor/Source/tmppeme_winapisupport.prg deleted file mode 100644 index de74a266..00000000 --- a/Thor/Source/tmppeme_winapisupport.prg +++ /dev/null @@ -1,90 +0,0 @@ -DEFINE CLASS WinApiSupport AS Custom - - && Converts VFP number to the Long integer - FUNCTION Num2Long(tnNum) - LOCAL lcString - lcString = SPACE(4) - =RtlPL2PS(@lcString, BITOR(tnNum,0), 4) - RETURN lcString - ENDFUNC - - && Convert Long integer into VFP numeric variable - FUNCTION Long2Num(tcLong) - LOCAL lnNum - lnNum = 0 - = RtlS2PL(@lnNum, tcLong, 4) - RETURN lnNum - ENDFUNC - - && Return Number from a pointer to DWORD - FUNCTION Long2NumFromBuffer(tnPointer) - LOCAL lnNum - lnNum = 0 - = RtlP2PL(@lnNum, tnPointer, 4) - RETURN lnNum - ENDFUNC - - && Convert Short integer into VFP numeric variable - FUNCTION Short2Num(tcLong) - LOCAL lnNum - lnNum = 0 - = RtlS2PL(@lnNum, tcLong, 2) - RETURN lnNum - ENDFUNC - - && Retrieve zero-terminated string from a buffer into VFP variable - FUNCTION StrZFromBuffer(tnPointer) - LOCAL lcStr, lnStrPointer - lcStr = SPACE(4096) - lnStrPointer = 0 - = RtlP2PL(@lnStrPointer, tnPointer, 4) - lstrcpy(@lcStr, lnStrPointer) - RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1) - ENDFUNC - - && Return a string from a pointer to LPWString (Unicode string) - FUNCTION StrZFromBufferW(tnPointer) - Local lcResult, lnStrPointer, lnSen - lnStrPointer = This.Long2NumFromBuffer(tnPointer) - - lnSen = lstrlenW(lnStrPointer) * 2 - lcResult = Replicate(chr(0), lnSen) - = RtlP2PS(@lcResult, lnStrPointer, lnSen) - lcResult = StrConv(StrConv(lcResult, 6), 2) - - RETURN lcResult - ENDFUNC - - && Retrieve zero-terminated string - FUNCTION StrZCopy(tnPointer) - LOCAL lcStr, lnStrPointer - lcStr = SPACE(4096) - lstrcpy(@lcStr, tnPointer) - RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1) - ENDFUNC - -ENDDEFINE -&&------------------------------------------------------------------------ -FUNCTION RtlPL2PS(tcDest, tnSrc, tnLen) - DECLARE RtlMoveMemory IN WIN32API AS RtlPL2PS STRING @Dest, Long @Source, Long Length -RETURN RtlPL2PS(@tcDest, tnSrc, tnLen) - -FUNCTION RtlS2PL(tnDest, tcSrc, tnLen) - DECLARE RtlMoveMemory IN WIN32API AS RtlS2PL Long @Dest, String Source, Long Length -RETURN RtlS2PL(@tnDest, @tcSrc, tnLen) - -FUNCTION RtlP2PL(tnDest, tnSrc, tnLen) - DECLARE RtlMoveMemory IN WIN32API AS RtlP2PL Long @Dest, Long Source, Long Length -RETURN RtlP2PL(@tnDest, tnSrc, tnLen) - -FUNCTION RtlP2PS(tcDest, tnSrc, tnLen) - DECLARE RtlMoveMemory IN WIN32API AS RtlP2PS STRING @Dest, Long Source, Long Length -RETURN RtlP2PS(@tcDest, tnSrc, tnLen) - -FUNCTION lstrcpy (tcDest, tnSrc) - DECLARE lstrcpy IN WIN32API STRING @lpstring1, INTEGER lpstring2 -RETURN lstrcpy (@tcDest, tnSrc) - -FUNCTION lstrlenW(tnSrc) - DECLARE Long lstrlenW IN WIN32API Long src -RETURN lstrlenW(tnSrc) diff --git a/Thor/Source/tmppopup.ico b/Thor/Source/tmppopup.ico deleted file mode 100644 index 80cfacbe..00000000 Binary files a/Thor/Source/tmppopup.ico and /dev/null differ diff --git a/Thor/Source/tmpprograms.ico b/Thor/Source/tmpprograms.ico deleted file mode 100644 index a1fd3ab2..00000000 Binary files a/Thor/Source/tmpprograms.ico and /dev/null differ diff --git a/Thor/Source/tmpquotesaroundlongtext.prg b/Thor/Source/tmpquotesaroundlongtext.prg deleted file mode 100644 index 74d974be..00000000 --- a/Thor/Source/tmpquotesaroundlongtext.prg +++ /dev/null @@ -1,16 +0,0 @@ -#Define CR Chr(13) - -Lparameters lcText - -If 250 < Len(lcText) - lcText = QuotesAroundLongText(Left(lcText, 250)) + ';' + Chr(13) + Space(8) + '+' + QuotesAroundLongText(substr(lcText, 251)) - Return lcText -EndIf - -lcText = Strtran(lcText, ['], [' + "'" + ']) -lcText = Strtran(lcText, CR, [' + Chr(13) + ']) -Return ['] + lcText + ['] - - - - \ No newline at end of file diff --git a/Thor/Source/tmprefhelp.bmp b/Thor/Source/tmprefhelp.bmp deleted file mode 100644 index 88ba1394..00000000 Binary files a/Thor/Source/tmprefhelp.bmp and /dev/null differ diff --git a/Thor/Source/tmprefresh2.bmp b/Thor/Source/tmprefresh2.bmp deleted file mode 100644 index ebb91a4b..00000000 Binary files a/Thor/Source/tmprefresh2.bmp and /dev/null differ diff --git a/Thor/Source/tmpspelldate.prg b/Thor/Source/tmpspelldate.prg deleted file mode 100644 index ef85f444..00000000 --- a/Thor/Source/tmpspelldate.prg +++ /dev/null @@ -1,10 +0,0 @@ -Lparameters tdDate, tlAbbreviate - -Local lcMonth, ldDate -ldDate = Evl (tdDate, Date()) -lcMonth = Cmonth (ldDate) -If tlAbbreviate And Len (lcMonth) > 4 - lcMonth = Left (lcMonth, 3) + '.' -Endif - -Return lcMonth + ' ' + Transform (Day (ldDate)) + ', ' + Transform (Year (ldDate)) diff --git a/Thor/Source/tmpt1.prg b/Thor/Source/tmpt1.prg deleted file mode 100644 index 647d038a..00000000 --- a/Thor/Source/tmpt1.prg +++ /dev/null @@ -1,249 +0,0 @@ -LParameters lcPRGName, lxParam1, lxParam2, lxParam3, lxParam4, lxParam5 - -Local loGetThor As 'GetThorRun' -Local lcFile, lcSys16, lcThorApp, lcThorFolder, llFirst, llThorInkey, lnI, lnInkey, lnPopUpID -Local loLink, loPEME_Tools, loResult, loThorEngine, loThorInfo, loThorRun - -lcThorApp = 'C:\VISUAL FOXPRO\PROGRAMS\9.0\COMMON\Thor.APP' -lcThorFolder = 'C:\VISUAL FOXPRO\PROGRAMS\9.0\COMMON\Thor\' - -llThorInkey = .F. -If Empty (lcPRGName) - llThorInkey = .T. - lcPRGName = '' - Do While Chrsaw() - lnInkey = Inkey() - If lnInkey = 13 - Exit - Endif - lcPRGName = lcPRGName + Chr (lnInkey) - Enddo -Endif - -Do Case - Case Atc('Thor_', lcPrgName) = 1 - Return ExecuteThorProc(lcPRGName, lcThorFolder, llThorInkey, .F., Pcount(), lxParam1, lxParam2, lxParam3, lxParam4, lxParam5) - - * Return Full Path - Case Atc([Full Path=], lcPrgName) = 1 - lcFile = GetFullFileName (Alltrim (Substr (lcPRGName, At ('=', lcPRGName) + 1)), lcThorFolder) - Return lcFile - - Case Atc([Class=], lcPrgName) = 1 - Return ExecScript(_Screen.cThorDispatcherClasses, lcPRGName, lcThorAPP, Pcount(), lxParam1, lxParam2, lxParam3, lxParam4, lxParam5) - - Case Atc([PopupID=], lcPrgName) = 1 - loGetThor = Createobject ('GetThorRun') - loThorRun = loGetThor.GetThorRun (lcThorApp, lcThorFolder) - lnPopUpID = Val (Substr (lcPRGName, 1 + At ('=', lcPRGName))) - loThorRun.ExecutePopup (lnPopUpID, lcThorFolder, Set ('DataSession')) - - Case Atc([Result=], lcPrgName) = 1 - _Screen.xThorResult = lxParam1 - Return lxParam1 - - *************** - - Case Empty (lcPRGName) - Do (lcThorApp) With 'Edit' - - Case Atc([?], lcPrgName) = 1 - Return ExecScript(_Screen.cThorDispatcherHelp) - - Case Atc([Run], lcPrgName) = 1 - loGetThor = Createobject ('GetThorRun') - loThorRun = loGetThor.GetThorRun (lcThorApp, lcThorFolder) - loThorRun.Run() - - Case Atc([Tool Folder=], lcPrgName) = 1 - Return lcThorFolder + 'Tools\' - - Case Atc([Version=], lcPrgName) = 1 - Return [Thor - 1.22.06.01 - May 30, 2012] - - Case Atc([Thor Engine=], lcPrgName) = 1 - loGetThor = Createobject ('GetThorEngine') - loThorEngine = loGetThor.GetThorEngine (lcThorApp, lcThorFolder) - Return loThorEngine - - Case Atc([Thor Register=], lcPrgName) = 1 - loGetThor = Createobject ('Getthorinfo') - loThorInfo = loGetThor.Getthorinfo (lcThorApp) - Return loThorInfo - - Case Atc([Thor Template Code=], lcPrgName) = 1 - loGetThor = Createobject ('Getthorinfo') - loThorInfo = loGetThor.Getthorinfo (lcThorApp) - Return loThorInfo.GetSampleToolCode() - - Case Atc([Clear HotKeys], lcPrgName) = 1 - Do (lcThorApp) With 'Clear HotKeys' - - Case Atc([Toggle Debug Mode], lcPrgName) = 1 - _Screen.lThorDebugMode = not _Screen.lThorDebugMode - Set Mark of Bar 31424 of Thor_Internal to _Screen.lThorDebugMode - If _Screen.lThorDebugMode - Set Asserts on - EndIf - - * Modify Tool - Case Atc([Edit=], lcPrgName) = 1 - lcFile = GetFullFileName (Alltrim (Substr (lcPRGName, At ('=', lcPRGName) + 1)), lcThorFolder) - If Empty (lcFile) - Return .Null. - Endif - - Return ExecuteThorProc('Thor_Proc_EditProc', lcThorFolder, llThorInkey, .F., 2, lcFile) - - * Show home page for tool - Case Atc([Link=], lcPrgName) = 1 - lcFile = GetFullFileName (Alltrim (Substr (lcPRGName, At ('=', lcPRGName) + 1)), lcThorFolder) - If Empty (lcFile) - Return .Null. - Endif - - loThorInfo = Newobject ('ThorInfo', 'Thor_Utils.vcx', lcThorApp) - Do (lcFile) With loThorInfo - loThorInfo.PrgName = Justfname (lcFile) - loThorInfo.FullFileName = lcFile - If Empty (loThorInfo.Link) - loGetThor = Createobject ('GetThorEngine') - loThorEngine = loGetThor.GetThorEngine (lcThorApp, lcThorFolder) - Messagebox (loThorEngine.GetToolDescription (loThorInfo)) - Else - loLink = Newobject ('_ShellExecute', Home() + 'FFC\_Environ.vcx') - loLink.ShellExecute (loThorInfo.Link) - Endif - - * Get ToolInfo for tool - Case Atc([ToolInfo=], lcPrgName) = 1 - loResult = .Null. - If Empty (lxParam1) Or 'C' # Vartype (lxParam1) - Return loResult - Endif - - lcFile = GetFullFileName (lxParam1, lcThorFolder) - If Empty (lcFile) - Return loResult - Endif - - Try - loThorInfo = Newobject ('ThorInfo', 'Thor_Utils.vcx', lcThorApp) - Do (lcFile) With loThorInfo - loThorInfo.PrgName = Justfname (lcFile) - loThorInfo.FullFileName = lcFile - loResult = loThorInfo - Catch - - Endtry - Return loResult - - * DoDefault - Case Atc([DoDefault()], lcPrgName) = 1 - lcPRGName = '' - llFirst = .F. - For lnI = Program (-1) To 1 Step - 1 - lcSys16 = Sys(16, lnI) - Do Case - Case Upper (Getwordnum (lcSys16, 1)) = 'PROCEDURE' - Case Not llFirst - llFirst = .T. - Otherwise - lcPRGName = Justfname (lcSys16) - Exit - Endcase - Endfor - - Return ExecuteThorProc (lcPRGName, lcThorFolder, llThorInkey, .T., Pcount(), lxParam1, lxParam2, lxParam3, lxParam4, lxParam5) - - Otherwise - Return ExecuteThorProc(lcPRGName, lcThorFolder, llThorInkey, .F., Pcount(), lxParam1, lxParam2, lxParam3, lxParam4, lxParam5) - -Endcase - -Return - - -Procedure ExecuteThorProc - Lparameters lcPRGName, lcThorFolder, llThorInkey, llDoDefault, lnPCount, lxParam1, lxParam2, lxParam3, lxParam4, lxParam5, lcFileText - - Local lcFullPRGName - lcFullPRGName = GetFullFileName (lcPRGName, lcThorFolder, llDoDefault) - If Empty (lcFullPRGName) - Return .Null. - Endif - - _Screen.lThorInkey = _Screen.lThorInkey Or llThorInkey - _Screen.xThorResult = .T. - Assert Not _Screen.lThorDebugMode Message 'Debug: ' + Juststem(lcFullPRGName) - ExecScript(_Screen.cThorSavelog, lcPRGName, lcThorFolder) - Do Case - Case lnPCount < 2 - Do (lcFullPRGName) - Case lnPCount = 2 - Do (lcFullPRGName) With lxParam1 - Case lnPCount = 3 - Do (lcFullPRGName) With lxParam1, lxParam2 - Case lnPCount = 4 - Do (lcFullPRGName) With lxParam1, lxParam2, lxParam3 - Case lnPCount = 5 - Do (lcFullPRGName) With lxParam1, lxParam2, lxParam3, lxParam4 - Case lnPCount = 6 - Do (lcFullPRGName) With lxParam1, lxParam2, lxParam3, lxParam4, lxParam5 - Otherwise - EndCase - - _Screen.lThorInkey = _Screen.lThorInkey And Type('llThorInkey') = 'L' And Not llThorInkey - Return _Screen.xThorResult -Endproc - - -Function GetFullFileName (lcPRGName, lcThorFolder, llDoDefault) - Local lcFile, lcFullPRGName1, lcFullPRGName2 - - If Empty(JustExt(lcPRGName)) - lcFile = Forceext (lcPRGName, 'prg') - Else - lcFile = lcPRGName - EndIf - lcFullPRGName1 = Forcepath (lcFile, lcThorFolder + 'Tools\' + 'My Tools') - lcFullPRGName2 = Forcepath (lcFile, lcThorFolder + 'Tools\' + 'Procs') - lcFullPRGName3 = Forcepath (lcFile, lcThorFolder + 'Tools\') - Do Case - Case File (lcFile) and not llDoDefault - lcFile = Fullpath (lcFile) - Case File (lcFullPRGName1) and not llDoDefault - lcFile = lcFullPRGName1 - Case File (lcFullPRGName2) - lcFile = lcFullPRGName2 - Case File (lcFullPRGName3) - lcFile = lcFullPRGName3 - Otherwise - lcFile = '' - Endcase - Return lcFile -Endfunc - -Define Class GetThorRun As Session - - Procedure GetThorRun (lcThorApp, lcThorFolder) - Return Newobject ('Thor_Run', 'thor_run.vcx', lcThorApp, lcThorApp, lcThorFolder) - Endproc - -Enddefine - -Define Class GetThorEngine As Session - - Procedure GetThorEngine (lcThorApp, lcThorFolder) - Return Newobject ('Thor_Engine', 'Thor.vcx', lcThorApp, lcThorFolder) - Endproc - -Enddefine - -Define Class GetThorInfo As Session - - Procedure GetThorInfo (lcThorApp) - Return Newobject ('ThorInfo', 'Thor_Utils.vcx', lcThorApp) - Endproc - -Enddefine diff --git a/Thor/Source/tmpthor.h b/Thor/Source/tmpthor.h deleted file mode 100644 index c6c2e839..00000000 --- a/Thor/Source/tmpthor.h +++ /dev/null @@ -1,58 +0,0 @@ -#include FOXPRO.H - -* Virtual key codes. - -#define VK_SHIFT 0x10 -#define VK_CONTROL 0x11 -#define VK_MENU 0x12 - -* Modifier key values. - -#define cnNO_MODIFIER 0 -#define cnSHIFT 1 -#define cnCTRL 2 -#define cnALT 4 - -#define ccCR chr(13) -#define ccLF chr(10) -#define ccCRLF chr(13) + chr(10) -#define ccTAB chr(9) - -#Define ccTOOLNAMEPREFIX 'Thor_Tool_' - -#define ccINTERNALEDITPRG ccTOOLNAMEPREFIX + 'ThorInternalEdit.PRG' -#define ccINTERNALHELPPRG ccTOOLNAMEPREFIX + 'ThorInternalHelp.PRG' -#define ccINTERNALALLTOOLSPRG ccTOOLNAMEPREFIX + 'ThorInternalAllTools.PRG' -#define ccINTERNALFRAMEWORK ccTOOLNAMEPREFIX + 'ThorInternalFrameWork.PRG' -#define ccCHECKFORUPDATES ccTOOLNAMEPREFIX + 'Thor_CheckForUpdates.PRG' -#define ccCOMMUNITY ccTOOLNAMEPREFIX + 'Thor_Community.PRG' -#define ccThorNews ccTOOLNAMEPREFIX + 'ThorInternalThorNews.PRG' -#define ccThorTWEeTs ccTOOLNAMEPREFIX + 'ThorInternalTWEeTs.PRG' -#define ccINTERNALRepostitory ccTOOLNAMEPREFIX + 'ThorInternalRepositoryHomePage.PRG' -#define ccINTERNALMODIFY ccTOOLNAMEPREFIX + 'ThorInternalModifyTool.PRG' -#define ccINTERNALTOOLLINK ccTOOLNAMEPREFIX + 'ThorInternalToolLink.PRG' -#define ccOPENFOLDERS ccTOOLNAMEPREFIX + 'ThorInternalOpenFolders.PRG' -#define ccSOURCEFILES ccTOOLNAMEPREFIX + 'ThorInternalSourceFiles.PRG' -#define ccUSAGESUMMARY ccTOOLNAMEPREFIX + 'ThorInternalUsageSummary.PRG' -#define ccDEBUGMODE ccTOOLNAMEPREFIX + 'ThorInternalDebugMode.PRG' -#Define ccMANAGEPLUGINS ccTOOLNAMEPREFIX + 'ThorInternalManagePlugIns.PRG' -#Define ccTOGGLEDEBUGMODE 'Toggle Debug Mode' - -#define ccMyTools 'My Tools' -#define ccProcs 'Procs' -#define ccUpdates 'Updates' -#define ccApps 'Apps' -#define ccComponents 'Components' -#define ccMySettings ccMyTools + '\Settings' -#define ccMyTemplates ccMyTools + '\Templates' -#define ccMyStartThorUI ccMyTools + '\StartThorUI' - -#Define ccThorDefaultTemplate 'Thor Default' - -#Define ccTemplatePrefix 'Thor_Tool_Template_' - -#Define ccOnKeyLabelPrefix 'ExecScript(_Screen.cThorDispatcher, "' - -#Define ccOnKeyLabelSuffix '")' - -#Define ccPEMEditor 'IDE Tools' \ No newline at end of file diff --git a/Thor/Source/tmpthor.ico b/Thor/Source/tmpthor.ico deleted file mode 100644 index 3cf6f2ae..00000000 Binary files a/Thor/Source/tmpthor.ico and /dev/null differ diff --git a/Thor/Source/tmpthor.pjt b/Thor/Source/tmpthor.pjt deleted file mode 100644 index c3a9017a..00000000 Binary files a/Thor/Source/tmpthor.pjt and /dev/null differ diff --git a/Thor/Source/tmpthor.pjx b/Thor/Source/tmpthor.pjx deleted file mode 100644 index ced3ede0..00000000 Binary files a/Thor/Source/tmpthor.pjx and /dev/null differ diff --git a/Thor/Source/tmpthor.vct b/Thor/Source/tmpthor.vct deleted file mode 100644 index 2e33c66c..00000000 Binary files a/Thor/Source/tmpthor.vct and /dev/null differ diff --git a/Thor/Source/tmpthor.vcx b/Thor/Source/tmpthor.vcx deleted file mode 100644 index 31d559b2..00000000 Binary files a/Thor/Source/tmpthor.vcx and /dev/null differ diff --git a/Thor/Source/tmpthor16.ico b/Thor/Source/tmpthor16.ico deleted file mode 100644 index 24f81248..00000000 Binary files a/Thor/Source/tmpthor16.ico and /dev/null differ diff --git a/Thor/Source/tmpthor16.png b/Thor/Source/tmpthor16.png deleted file mode 100644 index c2d9d2d6..00000000 Binary files a/Thor/Source/tmpthor16.png and /dev/null differ diff --git a/Thor/Source/tmpthor_english.h b/Thor/Source/tmpthor_english.h deleted file mode 100644 index bb7a8d4f..00000000 --- a/Thor/Source/tmpthor_english.h +++ /dev/null @@ -1,108 +0,0 @@ -#include ThorVersion.h - -* Key captions. - -#define ccSHIFT 'Shift-' -#define ccCTRL 'Ctrl-' -#define ccALT 'Alt-' - -* Menu categories. - -#define ccVFP_SYSTEM_MENU 'VFP System Menu' -#define ccPOPUP_MENUS 'Popup Menus (Key Chords)' - -* Control and form captions. - -#define ccTHOR_CAPTION 'Thor Configuration' -#define ccHOTKEY '\' -#define ccSelectFromTreeView '
- <> -
- <> - - <> -