//TH-Header //***************************************************************************************** // Copyright (c) 2014 KURANT Project // All rights reserved. // // $FileName : Class_Explorer.vw // $ProjectName : The Hammer 2.0 // $Authors : Wil van Antwerpen, Michael Kurz, Sergey V. Natarov // $Created : 01.25.2014 01:08 // $Type : LGPL // // Contents: Class Explorer // //***************************************************************************************** //TH-RevisionStart //TH-RevisionEnd // Project Object Structure // Class_Explorer is a dbView // Vdfcls_DD is a DataDictionary // Asdb_DD is a DataDictionary // dbContainer3d2 is a dbContainer3d // The_Table is a dbGrid // dbGrid1 is a dbGrid // Form1 is a Form // dbEdit1 is a dbEdit // dbEdit2 is a dbEdit // Button1 is a Button // Register all objects Register_Object Asdb_DD Register_Object Button1 Register_Object Class_Explorer Register_Object dbContainer3d2 Register_Object dbEdit1 Register_Object dbEdit2 Register_Object dbGrid1 Register_Object Form1 Register_Object The_Table Register_Object Vdfcls_DD Use proppage.dg Function Element_Type Global Integer itype Returns String If (iTYPE=0) Function_Return "Undefined" If (iTYPE=1) Function_Return "Property" If (iTYPE=2) Function_Return "Procedure" If (iTYPE=3) Function_Return "Function" If (iTYPE=4) Function_Return "Command" If (iTYPE=5) Function_Return "Both" If (iTYPE>5) Function_Return "Unknown" End_Function //#DEFINE IS$HAMMER$TOOL 1 Use vdfcls.dd Use ASDB.DD Activate_View Activate_Class_Explorer For Class_Explorer Object Class_Explorer Is a dbView #IF (!@ >= 140) Set pbSizeToClientArea to False #ENDIF Property Integer piEditView Public 0 Property Integer piEditLine Public 0 Property Integer piEditCol Public 0 Set Border_Style To Border_Thick Set Maximize_Icon To TRUE Set Label To "Class Explorer" Set Size To 218 323 Set Location To 1 22 Object Vdfcls_DD Is a Vdfcls_datadictionary Procedure onConstrain Constrain VDFCLS.BASE Eq "Y" End_Procedure End_Object // Vdfcls_DD Object Asdb_DD Is a Asdb_DataDictionary Set DDO_Server To (Vdfcls_DD(Self)) Set Constrain_File To Vdfcls.File_Number End_Object // Asdb_DD Set Main_DD To (Vdfcls_DD(Self)) Set Server To (Vdfcls_DD(Self)) Object dbContainer3d2 Is a dbContainer3d Set Size To 70 133 Set Location To 2 3 Set Color To clWhite Set Border_Style To Border_ClientEdge Object The_Table Is a dbGrid Set Read_Only_State To True Set allow_insert_add_state To FALSE Set allow_top_add_state To FALSE Set allow_bottom_add_state To FALSE Set GridLine_Mode To GRID_VISIBLE_NONE Set Border_Style To Border_None Set Header_Visible_State To False Set Scroll_Bar_Visible_State To False On_Key Key_Enter Send switch To dbGrid1 Use agt.dg On_Key Key_Alt+Key_T Send pCall Procedure pCall Send PopUp To oAGTD VDFCLS.FILE_NUMBER End_Procedure Set Main_File To Vdfcls.File_Number Set Ordering To 1 Set Size To 65 127 Set Location To 2 2 Set Color To clWhite Set CurrentRowColor To clLtGray Set CurrentRowTextColor To clWhite Set CurrentCellColor To clLtGray Set CurrentCellTextColor To clWhite Set Highlight_Row_state To FALSE Set Wrap_State To TRUE Begin_Row Entry_Item ("") Entry_Item Vdfcls.Name End_Row Set Form_Width Item 0 To 13 Set Header_Label Item 0 To "" Set Form_Width Item 1 To 106 Set Header_Label Item 1 To "Name" Procedure OnKillFocus Integer iItm Get Current_Item To iItm Set ItemColor Item iItm To clLtGray End_Procedure Procedure OnSetFocus Integer iItm Get Current_Item To iItm Set ItemColor Item iItm To clWhite End_Procedure Procedure Request_Delete Send Stop_Box "You can't delete records here." End_Procedure Procedure Entry_Display Integer iFile Integer iType Integer iClr iItem // Send Change_Row_Color Get Base_Item To iItem // first item of the current row Set Entry_State Item iItem To False Set Entry_State Item (iItem+1) To False If (VDFCLS.BITMAP<>"") Set Form_Bitmap Item iItem To (Trim(VDFCLS.BITMAP)) Forward Send Entry_Display iFile iType End_Procedure // Entry_Display Procedure Adjust_Row_Height Set Form_Height Item 0 To 12 End_Procedure Send Adjust_Row_Height End_Object // The_Table End_Object // dbContainer3d2 Object dbGrid1 Is a dbGrid Property Integer peResizeColumn Public 4 Property Integer piResizeColumn Public 1 Property Integer piLastResizedColumn Public 0 Set Select_Mode To No_Select Set Scroll_Bar_Visible_State To FALSE Set Highlight_Row_state To TRUE Set Allow_bottom_add_state To False Set Allow_insert_add_state To False Set Allow_top_add_state To False Set Read_Only_State To True Set Main_File To Asdb.File_Number Set Server To (Asdb_DD(Self)) Set Ordering To 3 Set Size To 80 312 Set Location To 74 3 Set Color To clWhite Set CurrentRowColor To clNavy Set CurrentRowTextColor To clWhite Set CurrentCellColor To clNavy Set CurrentCellTextColor To clWhite Set Wrap_State To TRUE Begin_Row Entry_Item (Element_Type(Asdb.Type)) Entry_Item Asdb.Name Entry_Item Asdb.Pclassname End_Row Set Form_Width Item 0 To 45 Set Header_Label Item 0 To "Type" Set Form_Width Item 1 To 136 Set Header_Label Item 1 To "Name" Set Form_Width Item 2 To 135 Set Header_Label Item 2 To "Inheritance" Procedure Entry_Display Integer iFile Integer iType Integer iCnt Get Item_Count To iCnt If (iCnt) Begin Get Base_Item To iCnt Set Item_Shadow_State Item (iCnt) To false If (ASDB.Type=1) Set ItemTextColor Item (iCnt) To clNavy If (ASDB.Type>1) Set ItemTextColor Item (iCnt) To clGreen If (ASDB.PCLASS=0) Set ItemColor Item (iCnt) To clWhite Else Set ItemColor Item (iCnt) To (rgb(230,230,230)) If (ASDB.Type=1) Set ItemTextColor Item (iCnt+1) To clNavy If (ASDB.Type>1) Set ItemTextColor Item (iCnt+1) To clGreen If (ASDB.PCLASS=0) Set ItemColor Item (iCnt+1) To clWhite Else Set ItemColor Item (iCnt+1) To (rgb(230,230,230)) If (ASDB.Type=1) Set ItemTextColor Item (iCnt+2) To clNavy If (ASDB.Type>1) Set ItemTextColor Item (iCnt+2) To clGreen If (ASDB.PCLASS=0) Set ItemColor Item (iCnt+2) To clWhite Else Set ItemColor Item (iCnt+2) To (rgb(230,230,230)) Set Entry_State Item (iCnt) To false Set Entry_State Item (iCnt+1) To false Set Entry_State Item (iCnt+2) To false End Send Update_Label To Class_Explorer (Trim(VDFCLS.NAME)) Send ShowCode To Form1 Forward Send Entry_Display iFile iType End_Procedure // Entry_Display Procedure OnResize Integer cyx cyxb cyxgb cyxga Get GUISize Of (Class_Explorer(Self)) To cyx Get GUISize To cyxb Get Size To cyxgb Set GUISize To (hi(cyx)-hi(GUILocation(Self))-100) (low(cyx)-low(GuiLocation(Self))-12) Send Adjust_Logicals Get Size To cyxga Send Resize_Columns (low(cyxga)-low(cyxgb)) End_Procedure Procedure Resize_Columns Integer iDelta Integer iResizeColumn eResizeColumn Integer iCols iCol iColWidth Integer i iWidth Integer iRemain Get peResizeColumn To eResizeColumn If (eResizeColumn=4) Begin Get line_size To iCols Get piResizeColumn To iResizeColumn If (iResizeColumn=0) ; Set form_width iResizeColumn To (form_width(Self,iResizeColumn)+iDelta) End // else if must be rcNone...do nothing End_Procedure Procedure Set line_width Integer iCols Integer iRows // This fixes the problem of resize lists and then displaying // the wrong Number Of lines... Forward Set line_width To iCols (displayable_rows(Self)) End_Procedure End_Object // dbGrid1 Object Form1 Is a Form Property Integer piLabelGuiLocationY Public 0 Property Integer piLabelGuiLocationX Public 0 Set Enabled_State To False Set Size To 13 257 Set Location To 186 3 Set Label_Col_Offset To 2 Set Label_Justification_Mode To jMode_Right Procedure ShowCode String sCode Number nPar Get fCodeSource To sCode Set Value Item 0 To (Trim(sCode)) End_Procedure Function fCodeSource Returns String String sCode sParam sRet If (Trim(ASDB.SETCODE)<>"") Begin Get Process_Template ASDB.SETCODE To sCode Function_Return sCode End Else Begin If ((ASDB.Type=1)And(Trim(ASDB.GETCODE)<>"")) Begin Get Process_Template ASDB.GETCODE To sCode Function_Return sCode End If (ASDB.Type=2) Begin Get Proc_Params To sParam Function_Return ("Send "+Trim(ASDB.NAME)+" "+sParam) End If (ASDB.Type=3) Begin Get Proc_Params To sParam Get Proc_Ret To sRet If (Trim(ASDB.GETCODE)="") Function_Return ("Get "+Trim(ASDB.NAME)+" "+sParam+" to "+sRet) Else Begin Get Process_Template ASDB.GETCODE To sCode Function_Return sCode End End End End_Procedure Function Process_Template String sTempl Returns String String sPT Get Parse_Param 1 To sPT Replace "{Par1}" In sTempl with sPT Get Parse_Param 2 To sPT Replace "{Par2}" In sTempl with sPT Get Parse_Param 3 To sPT Replace "{Par3}" In sTempl with sPT Get Parse_Param 4 To sPT Replace "{Par4}" In sTempl with sPT Get Parse_Param 5 To sPT Replace "{Par5}" In sTempl with sPT Function_Return sTempl End_Function Function Proc_Params Returns String String sParam sPT sPT1 sPT2 sPT3 sPT4 sPT5 Move "" To sParam Move "" To sPT If (ASDB.PAR1T<>0) Get Parse_Param 1 To sPT1 If (sPT1<>"") Move (sPT+sPT1) To sPT If (ASDB.PAR2T<>0) Get Parse_Param 2 To sPT2 If (sPT2<>"") Move (sPT+" "+sPT2) To sPT If (ASDB.PAR3T<>0) Get Parse_Param 3 To sPT3 If (sPT3<>"") Move (sPT+" "+sPT3) To sPT If (ASDB.PAR4T<>0) Get Parse_Param 4 To sPT4 If (sPT4<>"") Move (sPT+" "+sPT4) To sPT If (ASDB.PAR5T<>0) Get Parse_Param 5 To sPT5 If (sPT5<>"") Move (sPT+" "+sPT5) To sPT Function_Return sPT End_Function Function Proc_Ret Returns String String sRet sPrfx Move "SomeValue" To sRet If (ASDB.PAR1T=8) Begin If (Trim(ASDB.PAR1)<>"") Begin Move (Left(ASDB.PAR1,1)) To sPrfx Move (sPrfx+"Var1") To sRet End End If (ASDB.PAR2T=8) Begin If (Trim(ASDB.PAR2)<>"") Begin Move (Left(ASDB.PAR2,1)) To sPrfx Move (sPrfx+"Var2") To sRet End End If (ASDB.PAR3T=8) Begin If (Trim(ASDB.PAR3)<>"") Begin Move (Left(ASDB.PAR3,1)) To sPrfx Move (sPrfx+"Var3") To sRet End End If (ASDB.PAR4T=8) Begin If (Trim(ASDB.PAR4)<>"") Begin Move (Left(ASDB.PAR4,1)) To sPrfx Move (sPrfx+"Var4") To sRet End End If (ASDB.PAR5T=8) Begin If (Trim(ASDB.PAR5)<>"") Begin Move (Left(ASDB.PAR5,1)) To sPrfx Move (sPrfx+"Var5") To sRet End End Function_Return sRet End_Function Function Parse_Param Number nPar Returns String String sRet Move "" To sRet If (nPar=1) Begin If ((ASDB.PAR1T=1)And(ASDB.PAR1="integer")) Move "iVar1" To sRet If ((ASDB.PAR1T=1)And(ASDB.PAR1="string")) Move "sVar1" To sRet If ((ASDB.PAR1T=1)And(ASDB.PAR1="number")) Move "nVar1" To sRet If (ASDB.PAR1T=2) Move "iCls" To sRet If (ASDB.PAR1T=3) Move "iObj" To sRet If ((ASDB.PAR1T=4)And(length(Trim(ASDB.PAR1))<=10)) Move ("{"+Trim(ASDB.PAR1)+"}") To sRet If ((ASDB.PAR1T=4)And(length(Trim(ASDB.PAR1))>10)) Move "{Mode}" To sRet If (ASDB.PAR1T=5) Move ("{"+Trim(ASDB.PAR1)+"}") To sRet If (ASDB.PAR1T=6) Move "iMsg" To sRet If (ASDB.PAR1T=7) Move "iGet" To sRet If (ASDB.PAR1T=8) Move "" To sRet If (ASDB.PAR1T=9) Move "iWinMsg" To sRet If (ASDB.PAR1T=10) Move "iFile" To sRet If (ASDB.PAR1T=11) Move "iField" To sRet If (ASDB.PAR1T=12) Move "iFileField" To sRet If (ASDB.PAR1T=13) Move "ImageNum" To sRet End If (nPar=2) Begin If ((ASDB.PAR2T=1)And(ASDB.PAR2="integer")) Move "iVar2" To sRet If ((ASDB.PAR2T=1)And(ASDB.PAR2="string")) Move "sVar2" To sRet If ((ASDB.PAR2T=1)And(ASDB.PAR2="number")) Move "nVar2" To sRet If (ASDB.PAR2T=2) Move "iCls" To sRet If (ASDB.PAR2T=3) Move "iObj" To sRet If ((ASDB.PAR2T=4)And(length(Trim(ASDB.PAR2))<=10)) ; Move ("{"+Trim(ASDB.PAR2)+"}") To sRet If ((ASDB.PAR2T=4)And(length(Trim(ASDB.PAR2))>10)) Move "{Mode}" To sRet If (ASDB.PAR2T=5) Move ("{"+Trim(ASDB.PAR2)+"}") To sRet If (ASDB.PAR2T=6) Move "iMsg" To sRet If (ASDB.PAR2T=7) Move "iGet" To sRet If (ASDB.PAR2T=8) Move "" To sRet If (ASDB.PAR2T=9) Move "iWinMsg" To sRet If (ASDB.PAR2T=10) Move "iFile" To sRet If (ASDB.PAR2T=11) Move "iField" To sRet If (ASDB.PAR2T=12) Move "iFileField" To sRet If (ASDB.PAR2T=13) Move "ImageNum" To sRet End If (nPar=3) Begin If ((ASDB.PAR3T=1)And(ASDB.PAR3="integer")) Move "iVar3" To sRet If ((ASDB.PAR3T=1)And(ASDB.PAR3="string")) Move "sVar3" To sRet If ((ASDB.PAR3T=1)And(ASDB.PAR3="number")) Move "nVar3" To sRet If (ASDB.PAR3T=2) Move "iCls" To sRet If (ASDB.PAR3T=3) Move "iObj" To sRet If ((ASDB.PAR3T=4)And(length(Trim(ASDB.PAR3))<=10)) ; Move ("{"+Trim(ASDB.PAR3)+"}") To sRet If ((ASDB.PAR3T=4)And(length(Trim(ASDB.PAR3))>10)) Move "{Mode}" To sRet If (ASDB.PAR3T=5) Move ("{"+Trim(ASDB.PAR3)+"}") To sRet If (ASDB.PAR3T=6) Move "iMsg" To sRet If (ASDB.PAR3T=7) Move "iGet" To sRet If (ASDB.PAR3T=8) Move "" To sRet If (ASDB.PAR3T=9) Move "iWinMsg" To sRet If (ASDB.PAR3T=10) Move "iFile" To sRet If (ASDB.PAR3T=11) Move "iField" To sRet If (ASDB.PAR3T=12) Move "iFileField" To sRet If (ASDB.PAR3T=13) Move "ImageNum" To sRet End If (nPar=4) Begin If ((ASDB.PAR4T=1)And(ASDB.PAR4="integer")) Move "iVar4" To sRet If ((ASDB.PAR4T=1)And(ASDB.PAR4="string")) Move "sVar4" To sRet If ((ASDB.PAR4T=1)And(ASDB.PAR4="number")) Move "nVar4" To sRet If (ASDB.PAR4T=2) Move "iCls" To sRet If (ASDB.PAR4T=3) Move "iObj" To sRet If ((ASDB.PAR4T=4)And(length(Trim(ASDB.PAR4))<=10)) ; Move ("{"+Trim(ASDB.PAR4)+"}") To sRet If ((ASDB.PAR1T=4)And(length(Trim(ASDB.PAR4))>10)) Move "{Mode}" To sRet If (ASDB.PAR4T=5) Move ("{"+Trim(ASDB.PAR4)+"}") To sRet If (ASDB.PAR4T=6) Move "iMsg" To sRet If (ASDB.PAR4T=7) Move "iGet" To sRet If (ASDB.PAR4T=8) Move "" To sRet If (ASDB.PAR4T=9) Move "iWinMsg" To sRet If (ASDB.PAR4T=10) Move "iFile" To sRet If (ASDB.PAR4T=11) Move "iField" To sRet If (ASDB.PAR4T=12) Move "iFileField" To sRet If (ASDB.PAR4T=13) Move "ImageNum" To sRet End If (nPar=5) Begin If ((ASDB.PAR5T=1)And(ASDB.PAR5="integer")) Move "iVar5" To sRet If ((ASDB.PAR5T=1)And(ASDB.PAR5="string")) Move "sVar5" To sRet If ((ASDB.PAR5T=1)And(ASDB.PAR5="number")) Move "nVar5" To sRet If (ASDB.PAR5T=2) Move "iCls" To sRet If (ASDB.PAR5T=3) Move "iObj" To sRet If ((ASDB.PAR5T=4)And(length(Trim(ASDB.PAR5))<=10)) ; Move ("{"+Trim(ASDB.PAR5)+"}") To sRet If ((ASDB.PAR5T=4)And(length(Trim(ASDB.PAR5))>10)) Move "{Mode}" To sRet If (ASDB.PAR5T=5) Move ("{"+Trim(ASDB.PAR5)+"}") To sRet If (ASDB.PAR5T=6) Move "iMsg" To sRet If (ASDB.PAR5T=7) Move "iGet" To sRet If (ASDB.PAR5T=8) Move "" To sRet If (ASDB.PAR5T=9) Move "iWinMsg" To sRet If (ASDB.PAR5T=10) Move "iFile" To sRet If (ASDB.PAR5T=11) Move "iField" To sRet If (ASDB.PAR5T=12) Move "iFileField" To sRet If (ASDB.PAR5T=13) Move "ImageNum" To sRet End Function_Return sRet End_Function Function fNumOfParameters Returns Integer Integer iRet Move 0 To iRet If ((ASDB.PAR1T>0)And(ASDB.PAR1T<>8)) Increment iRet If ((ASDB.PAR2T>0)And(ASDB.PAR2T<>8)) Increment iRet If ((ASDB.PAR3T>0)And(ASDB.PAR3T<>8)) Increment iRet If ((ASDB.PAR4T>0)And(ASDB.PAR4T<>8)) Increment iRet If ((ASDB.PAR5T>0)And(ASDB.PAR5T<>8)) Increment iRet Function_Return iRet End_Function Procedure OnResize Integer cyx cyxb Get GUISize Of (Class_Explorer(Self)) To cyx Get GUISize To cyxb Set GUILocation To (hi(cyx)-hi(GUISize(Self)*2)-9) (low(GUILocation(Self))) Set GUISize To (hi(GUISize(Self))) (low(cyx)-100) End_Procedure End_Object // Form1 Object dbEdit1 Is a dbEdit Set Enabled_State To False Entry_Item Vdfcls.Descr Set Size To 70 177 Set Location To 2 138 Procedure OnResize Integer cyx cyxb Get GUISize Of (Class_Explorer(Self)) To cyx Get GUISize To cyxb Set GUISize To (hi(GUISize(Self))) (low(cyx)-(low(GUILocation(Self)))-12) End_Procedure End_Object // dbEdit1 Object dbEdit2 Is a dbEdit Set Enabled_State To False Entry_Item Asdb.Name Set Server To (Asdb_DD(Self)) Set Size To 25 313 Set Location To 158 3 Procedure OnResize Integer cyx cyxb Get GUISize Of (Class_Explorer(Self)) To cyx Get GUISize To cyxb Set GUISize To (hi(GUISize(Self))) (low(cyx)-low(GuiLocation(Self))-12) Set GUILocation To (hi(cyx)-(hi(cyxb)*2)-16) (low(GUILocation(Self))) End_Procedure End_Object // dbEdit2 #IFDEF Is$HAMMER$TOOL Object Button1 Is a Button Set Enabled_State To True Set Label To "&Add" Set Location To 186 265 Procedure OnClick Integer hoID iLine iCol String sSrc Delegate Get piEditView To hoID Send PopUp To (oPP(Self)) (Trim(VDFCLS.NAME)) VDFCLS.CODE Get psSource Of (oPP(Self)) To sSrc Delegate Get piEditLine To iLine Delegate Get piEditCol To iCol Send InsertTextAtPosition To (oEdit(hoID)) iLine iCol sSrc End_Procedure // OnClick Procedure OnResize Integer cyx cyxb Get GUISize Of (Class_Explorer(Self)) To cyx Get GUISize To cyxb Set GUILocation To (hi(cyx)-hi(GUISize(Self)*2)-8) (low(cyx)-(low(GUISize(Self)))-12) End_Procedure End_Object // Button1 #ENDIF // **WvA: 7-5-2002 // I had to disable this part of the code in order to compile the vdfcls program. // The code below only works if this view is part of the hammer itself, not if // the view is part of a standalone program. // Uncomment the constant in the top of this view to deactivate the compiler directive // below so that this code again activated. #IFDEF Is$HAMMER$TOOL Procedure Activate Integer hoID iEd iLine iCol iZ Get piEditView To iEd If (Not(iEd)) Begin Move (Focus(Desktop)) To hoID If (hoID) Begin Get GetEditViewID Of hoID To hoID Set piEditView To hoID // Cursor Position Get piSelEndLine Of (oEdit(hoID)) To iLine Get piSelEndCol Of (oEdit(hoID)) To iCol Set piEditLine To iLine Set piEditCol To iCol Delegate Get piViewsZoomed To iZ If iZ Set view_mode To viewmode_zoom End End Forward Send Activate End_Procedure #ENDIF Procedure Close_Panel Set piEditView To 0 Forward Send Close_Panel End_Procedure Procedure Update_Label String sCls Set Label To ("Class Explorer - ("+sCls+")") End_Procedure Procedure OnResize Send Adjust_Logicals Broadcast Send OnResize End_Procedure Procedure CloseFile End_Procedure Procedure CreateEditorEntry End_Procedure End_Object // Class_Explorer