//TH-Header //***************************************************************************************** // Copyright (c) 2014 KURANT Project // All rights reserved. // // $FileName : setclass.dg // $ProjectName : The Hammer 2.0 // $Authors : Wil van Antwerpen, Michael Kurz, Sergey V. Natarov, Bernhard Ponemayr // $Created : 01.25.2014 01:08 // $Type : LGPL // // Contents: Setup Class // //***************************************************************************************** //TH-RevisionStart //TH-RevisionEnd // Project Object Structure // oSetupClass is a dbModalPanel // oTabs is a TabDialog // oTP_Class is a TabPage // oClassLayer is a RadioGroup // oRadio1 is a Radio // oRadio2 is a Radio // oClass_gr is a Group // oClassName is a Form // oSuperClassName is a Form // oPackage is a Form // oTabPageClass is a Form // oInherit is a CheckBox // oIde_gr is a Group // oImage is a Form // oOpenFile is a OpenDialog // oPage is a ComboForm // oFile is a Form // oOpenFile is a SaveAsDialog // oTP_Properties is a TabPage // oPropgrid is a Grid // oTP_Advanced is a TabPage // oControlType is a ComboForm // oFloatMenuId is a ComboForm // oDropAllowed is a ComboForm // oTypeDrag is a ComboForm // oClassVer is a Form // oClassVendor is a Form // oBandAllowed is a cTrueFalseComboForm // oMoveAllowed is a cTrueFalseComboForm // oMoveSizeAllowed is a cTrueFalseComboForm // oRowbased is a cTrueFalseComboForm // oEntryItem is a cTrueFalseComboForm // oItemBased is a cTrueFalseComboForm // oOK_btn is a Button // oCancel_btn is a Button // oInfo is a Textbox // Register all objects Register_Object oBandAllowed Register_Object oCancel_btn Register_Object oClass_gr Register_Object oClassLayer Register_Object oClassName Register_Object oClassVendor Register_Object oClassVer Register_Object oControlType Register_Object oDropAllowed Register_Object oEntryItem Register_Object oFile Register_Object oFloatMenuId Register_Object oIde_gr Register_Object oImage Register_Object oInfo Register_Object oInherit Register_Object oItemBased Register_Object oMoveAllowed Register_Object oMoveSizeAllowed Register_Object oOK_btn Register_Object oOpenFile Register_Object oPackage Register_Object oPage Register_Object oPropgrid Register_Object oRadio1 Register_Object oRadio2 Register_Object oRowbased Register_Object oSetupClass Register_Object oSuperClassName Register_Object oTabPageClass Register_Object oTabs Register_Object oTP_Advanced Register_Object oTP_Class Register_Object oTP_Properties Register_Object oTypeDrag Class cTrueFalseComboform Is a ComboForm Procedure construct_object Forward Send construct_object Set entry_state Item 0 To false Set combo_sort_state To false On_Key kCancel Send Close_Panel End_Procedure Procedure combo_fill_list Send Combo_Add_item '(Inherit)' Send Combo_Add_item 'True' Send Combo_Add_item 'False' End_Procedure End_Class Use seldrag.dg Use seldatat.dg Use selgent.dg Object oSetupClass Is a dbModalPanel Set Label To "Set Class Properties" Set Size To 228 396 Set Location To 4 3 Object oTabs Is a TabDialog Set Size To 182 372 Set Location To 7 9 Object oTP_Class Is a TabPage Set Label To "Class" Set Tab_ToolTip_Value To "General properties for IDE" Object oClassLayer Is a RadioGroup Set Size To 25 301 Set Location To 1 3 Object oRadio1 Is a Radio Set Label To "Global Class" Set Size To 10 55 Set Location To 10 5 End_Object // oRadio1 Object oRadio2 Is a Radio Set Label To "Workspace Class" Set Size To 10 72 Set Location To 9 74 End_Object // oRadio2 On_Key kCancel Send Close_Panel Procedure Notify_Select_State Integer iToItem Integer iFromItem Integer ho iActive Forward Send Notify_Select_State iToItem iFromItem Delegate Get Active_State To iActive If (iActive) Begin Move (oPage(oIde_gr(Self))) To ho Set piDFClocation To iToItem Send combo_delete_data To ho Send combo_initialize_list To ho End End_Procedure Procedure activating Forward Send activating Set Current_Radio To (piDFClocation(Self)) End_Procedure End_Object // oClassLayer Object oClass_gr Is a Group Set Size To 73 301 Set Location To 28 3 Set Label To "Class Properties" Object oClassName Is a Form Set Label To "Class Name:" Set Size To 13 159 Set Location To 10 86 Set Label_Col_Offset To 80 Set enabled_state To false End_Object // oClassName Object oSuperClassName Is a Form Set Label To "Super Class:" Set Size To 13 159 Set Location To 25 86 Set Status_Help To "The Class which this class inherits from" Set Label_Col_Offset To 80 On_Key kCancel Send Close_Panel End_Object // oSuperClassName Object oPackage Is a Form Set Label To "Class Package:" Set Size To 13 159 Set Location To 40 86 Set Label_Col_Offset To 80 On_Key kCancel Send Close_Panel End_Object // oPackage Object oTabPageClass Is a Form Set Label To "Tab Page Class Name:" Set Size To 13 159 Set Location To 55 86 Set Label_Col_Offset To 80 On_Key kCancel Send Close_Panel End_Object // oTabPageClass Object oInherit Is a CheckBox Set Label To "Inherit" Set Size To 10 36 Set Location To 10 255 On_Key kCancel Send Close_Panel End_Object // oInherit End_Object // oClass_gr Object oIde_gr Is a Group Set Size To 58 301 Set Location To 103 3 Set Label To "IDE Setup" Object oImage Is a Form Set Label To "Image:" Set Size To 13 159 Set Location To 9 86 Set Label_Col_Offset To 80 Set Prompt_Button_Mode To pb_PromptOn Procedure OnChange String sFile Integer iRet Get value Item 0 To sFile Get_File_Path sFile To sFile File_Exist sFile iRet If Not iRet Move "NoBmp.bmp" To sFile Set Bitmap Of (oBmpShow(Self)) To sFile End_Procedure Procedure prompt String sFileName sFolder Integer ho iRet Get IdeSrcPath (psVdfVersion(Self)) (If(piDFCLocation(Self),psCurrentWkspc(Self),'')) To sFolder Object oOpenFile Is an OpenDialog Set Dialog_Caption To 'Select Bitmap file' Set Filter_String To 'Bitmap Files (*.bmp)|*.bmp' Set Initial_Folder To sFolder Move Self To ho End_Object Get Show_Dialog Of ho To iRet If iRet Begin Get File_title Of ho To sFileName Set value Item 0 To sFileName End Send Request_Destroy_object To ho End_Procedure On_Key kCancel Send Close_Panel End_Object // oImage Object oBmpShow Is a TextBox Set auto_size_state To false Set Location To 9 247 Set Size To 13 13 Set Border_Style To Border_StaticEdge End_Object Object oPage Is a ComboForm Set Label To "Page:" Set Size To 13 159 Set Location To 24 86 Set Status_Help To "Page on Control Palette" Set Form_Border To 0 Set Label_Col_Offset To 80 Procedure activating Send combo_delete_data Forward Send activating End_Procedure Procedure combo_fill_list Integer iMax iIx String sWkspc sName sImage sPage sFile sVDFVer Get psVdfVersion To sVdfVer If (piDFClocation(Self)) Eq 1 Get psCurrentWkSpc To sWkspc Else Move '' To sWkspc Move (GetClassCountInList(sVdfVer,sWkspc)) To iMax For iIx From 1 To iMax Move (ZeroString(50)) To sName Move (ZeroString(255)) To sImage Move (ZeroString(30)) To sPage Move (ZeroString(255)) To sFile If (GetClassInList(sVdfVer, sWkspc, AddressOf(sName), AddressOf(sImage), AddressOf(sPage), Addressof(sFile), iIx)) Begin If (combo_item_matching(Self, sPage)) Eq -1 Send combo_add_item sPage End Loop End_Procedure End_Object // oPage Object oFile Is a Form Set Label To "File:" Set Size To 13 159 Set Location To 39 86 Set Label_Col_Offset To 80 Set Prompt_Button_Mode To pb_PromptOn On_Key kCancel Send Close_Panel Procedure prompt String sFileName sFolder Integer ho iRet Get IdeSrcPath (psVdfVersion(Self)) (If(piDFCLocation(Self),psCurrentWkspc(Self),'')) To sFolder Object oOpenFile Is an SaveAsDialog Set Dialog_Caption To 'Select IDE Class-File' Set Filter_String To 'Ide Class-Files|*.dfc' Set Initial_Folder To sFolder Move Self To ho End_Object Get Show_Dialog Of ho To iRet If iRet Begin Get File_title Of ho To sFileName Move (Left(sFileName, (Pos('.',sFileName)-1))) To sFilename Set value Item 0 To sFileName End Send Request_Destroy_object To ho End_Procedure End_Object // oFile End_Object // oIde_gr End_Object // oTP_Class Object oTP_Properties Is a TabPage Set Label To "Properties" Set Tab_ToolTip_Value To "Properties to be used in IDE for Class" Object oPropgrid Is a Grid Set Size To 139 358 Set Location To 6 5 Set Line_Width To 7 0 Set Form_Width Item 0 To 22 Set Header_Label Item 0 To "Use" Set Form_Width Item 1 To 55 Set Header_Label Item 1 To "Name" Set Form_Width Item 2 To 54 Set Header_Label Item 2 To "Data Type >>" Set Form_Width Item 3 To 54 Set Header_Label Item 3 To "Generate >>" Set Form_Width Item 4 To 64 Set Header_Label Item 4 To "Default Value" Set Form_Width Item 5 To 101 Set Header_Label Item 5 To "Comment" Set Form_Width Item 6 To 200 Set Header_Label Item 6 To "Mode Values" Set wrap_state To false Set select_mode To multi_select On_Key kprompt Send prompt On_Key kCancel Send Close_Panel Procedure prompt Integer iItem Get current_item To iItem Increment iItem If (mod(iItem,7)) Eq 3 Send popup To (oSelectdataType(Self)) If (mod(iItem,7)) Eq 4 Send popup To (oSelectGenerateType(Self)) End_Procedure Procedure Header_Mouse_Click Integer Item# Integer iRVal Get Msg_Activate_Column Item# To iRval If Not iRval Send Prompt End_Procedure End_Object // oPropgrid End_Object // oTP_Properties Object oTP_Advanced Is a TabPage Set Label To "Advanced" Set Tab_ToolTip_Value To "Advanced dfc Properties" Object oControlType Is a ComboForm Set Label To "Control Type:" Set Size To 13 169 Set Location To 6 63 Set Form_Border To 0 Set entry_state Item 0 To false Set combo_sort_state To false On_Key kCancel Send Close_Panel Procedure combo_fill_list Send combo_add_item '(Inherit)' Send Combo_Add_Item 'ctDataAware' Send Combo_Add_Item 'ctDataContainer' Send Combo_Add_Item 'ctBase' Send Combo_Add_Item 'ctBaseContainer' End_Procedure End_Object // oControlType Object oFloatMenuId Is a ComboForm Set Label To "Floating Menu Id:" Set Size To 13 169 Set Location To 21 63 Set Form_Border To 0 Set entry_state Item 0 To false Set combo_sort_state To false On_Key kCancel Send Close_Panel Procedure combo_fill_list Send combo_add_item '(Inherit)' Send Combo_Add_item 'ComponentFloater.obj' Send Combo_Add_Item 'ControlFloater.obj' Send Combo_Add_Item 'dbEditFloater.obj' Send Combo_Add_item 'EntryFormFloater.obj' Send Combo_Add_Item 'EVCFloater.obj' Send Combo_Add_Item 'ProjectFloater.obj' Send Combo_Add_Item 'TabFloater.obj' Send Combo_Add_Item 'TableFloater.Obj' Send Combo_Add_Item 'TextBoxFloater.obj' End_Procedure End_Object // oFloatMenuId Object oDropAllowed Is a Form Set Label To "Drop Allowed:" Set Size To 13 169 Set Location To 36 63 Set Prompt_Button_Mode To pb_PromptOn On_Key kCancel Send Close_Panel Set prompt_object Item 0 To (oSelectDrag(Self)) End_Object // oDropAllowed Object oTypeDrag Is a Form Set Label To "Type of Drag:" Set Size To 13 169 Set Location To 50 63 Set Prompt_Button_Mode To pb_PromptOn On_Key kCancel Send Close_Panel Set prompt_object Item 0 To (oSelectDrag(Self)) End_Object // oTypeDrag Object oClassVer Is a Form Set Label To "Class Version:" Set Size To 13 169 Set Location To 66 63 On_Key kCancel Send Close_Panel End_Object // oClassVer Object oClassVendor Is a Form Set Label To "Class Vendor:" Set Size To 13 169 Set Location To 81 63 On_Key kCancel Send Close_Panel End_Object // oClassVendor Object oBandAllowed Is a cTrueFalseComboForm Set Label To "Band Allowed:" Set Size To 13 57 Set Location To 6 301 Set Form_Border To 0 End_Object // oBandAllowed Object oMoveAllowed Is a cTrueFalseComboForm Set Label To "Move Allowed:" Set Size To 13 57 Set Location To 21 301 Set Form_Border To 0 End_Object // oMoveAllowed Object oMoveSizeAllowed Is a cTrueFalseComboForm Set Label To "Move/Size:" Set Size To 13 57 Set Location To 36 301 Set Form_Border To 0 End_Object // oMoveSizeAllowed Object oRowbased Is a cTrueFalseComboForm Set Label To "Row Based:" Set Size To 13 57 Set Location To 50 301 Set Form_Border To 0 End_Object // oRowbased Object oEntryItem Is a cTrueFalseComboForm Set Label To "Entry Item Based:" Set Size To 13 57 Set Location To 66 301 Set Form_Border To 0 End_Object // oEntryItem Object oItemBased Is a cTrueFalseComboForm Set Label To "Item based:" Set Size To 13 57 Set Location To 81 301 Set Form_Border To 0 End_Object // oItemBased End_Object // oTP_Advanced End_Object // oTabs Object oOK_btn Is a Button Set Label To "OK" Set Default_State To TRUE Set Location To 191 278 Procedure onClick Send pCreateClass End_Procedure End_Object // oOK_btn Object oCancel_btn Is a Button Set Label To "Cancel" Set Location To 191 332 On_Key kCancel Send Close_Panel Procedure onClick Send close_panel End_Procedure End_Object // oCancel_btn Object oInfo Is a Textbox Set Label To "Note: Class is already registered in workspace class layer" Set TextColor To clRed Set Location To 194 10 Set Size To 10 100 Set FontWeight To 600 Set TypeFace To "MS Sans Serif" End_Object // oInfo Procedure pShowSetClass String sClassname Integer ho hArr iMax iCount iItem iRet String sVal sPath String sVdfVer sWkspc sName sImage sPage sFile Get psVdfVersion To sVdfVer Set label To ('Set Class Properties for ' * sClassName) // If stand-alone dfcbldr we have already told if class is global or workspace #IFDEF DFCBLDR If (piDFClocation(Self)) Eq 1 Get psCurrentWkSpc To sWkspc Else Move '' To sWkspc #ELSE Get psCurrentWkSpc To sWkspc Get IDEDoesClassExist sVdfVer sWkspc sClassName To iRet // Is Global If (iRet <0) Begin Set piDfClocation To 0 Move '' To sWkspc End Else If (iRet>0) Set piDfcLocation To 1 Else Begin // Class is not registered. Let us try to guess where it belongs! // If package is found in appsrcpath it is probably a workspace class Move (Profile_StringVersion(sVdfVer,("WorkSpaces\"+sWkSpc),"AppSrcPath")) To sPath Set piDFClocation To ((uppercase(sPath)+';') Contains (uppercase(fDirectory_FileName(psCurrentFileName(Self)))+';')) End If (piDfclocation(Self)=0) Move '' To sWkspc // Global #ENDIF Get oClass_Array To hArr // Setup class tab page Move ((item_count(hArr)/2)-1) To iMax Move (oClass_gr(oTP_Class(otabs(Self)))) To ho Move 0 To iCount While (iCount <= iMax) Move (iCount*2) To iItem Get string_value Of hArr Item iItem To sVal If sVal Eq sClassName Begin Set value Of (oClassName(ho)) Item 0 To sVal Get string_value Of hArr Item (iItem+1) To sVal Set value Of (oSuperClassName(ho)) Item 0 To sVal Set value Of (oPackage(ho)) Item 0 To (fBase_File_Name(psCurrentFileName(Self))) Move iMax To iCount End Increment iCount Loop Set checked_state Of (oInherit(ho)) To true Move (oIde_gr(oTP_Class(otabs(Self)))) To ho // Check if Class exist in list and get value sfrom class list Move (ClassExistsInList(sVdfVer, sWkspc, trim(sClassName))) To iItem If iItem Begin Set label Of oInfo To (If(sWkspc <> '','Note: Class is already registered in workspace class layer','Note: Class is already registered in global class layer')) Move (ZeroString(50)) To sName Move (ZeroString(255)) To sImage Move (ZeroString(30)) To sPage Move (ZeroString(255)) To sFile If (GetClassInList(sVdfVer, sWkspc, AddressOf(sName), AddressOf(sImage), AddressOf(sPage), AddressOf(sFile), iItem)) Begin Set value Of (oPage(ho)) Item 0 To sPage Set value Of (oimage(ho)) Item 0 To sImage Set value Of (oFile(ho)) Item 0 To sFile End End Else Begin Set value Of (oPage(ho)) Item 0 To '' Set value Of (oimage(ho)) Item 0 To '' Set value Of (oFile(ho)) Item 0 To '' Set label Of oInfo To " " End // Setup properties tab page Get oProperty_Array To hArr Move ((item_count(hArr)/6)-1) To iMax Move (oPropGrid(oTP_properties(otabs(Self)))) To ho Send delete_data To ho Move 0 To iCount While (iCount <= iMax) Move (iCount*6) To iItem Get string_value Of hArr Item iItem To sVal If (uppercase(sVal)=uppercase(sClassName)) Begin Send add_item To ho 0 false Set checkbox_item_state Of ho Item (item_count(ho)-1) To true // Property Name Get string_value Of hArr Item (iItem+1) To sVal Send add_item To ho 0 sVal // Data type Get string_value Of hArr Item (iItem+2) To sVal Send add_item To ho 0 sVal // Generate type Get string_value Of hArr Item (iItem+3) To sVal Send add_item To ho 0 sVal // Values Get string_value Of hArr Item (iItem+4) To sVal Send add_item To ho 0 sVal // Comment Get string_value Of hArr Item (iItem+5) To sVal Send add_item To ho 0 sVal // Mode Values Send add_item To ho 0 '' End Increment icount End Send popup_modal End_Procedure Procedure pCreateClass Integer ho iMax iItem iRow iRet String sVdfVer sClassName sFile sVal sPropName sDataType sGenType sDefvalue sComm sModeValues spage sImage sPackage sWkspc // I do this to force the advanced page to fill combos with default values Move (oTabs(Self)) To ho Get psVdfVersion To sVdfVer If (piDFClocation(Self)) Eq 1 Get psCurrentWkSpc To sWkspc Else Move '' To sWkspc Get current_tab Of ho To iItem Send request_tab_display To ho 2 Send request_tab_display To ho iItem Move (oIde_gr(oTP_Class(otabs(Self)))) To ho Get value Of (oPage(ho)) Item 0 To sPage Get value Of (oImage(ho)) Item 0 To sImage Get value Of (oFile(ho)) Item 0 To sFile Move (oClass_gr(oTP_Class(otabs(Self)))) To ho Get value Of (oClassName(ho)) Item 0 To sClassName Move (Trim(sClassName)) To sClassName Direct_Output (IdeSrcPath(sVdfVer,sWkspc)+'\'+(If(sFile <> '', (sFile-'.dfc'), (sClassName-'.dfc')))) If '.' In sFile Move (Left(sFile, (Pos('.',sFile)-1))) To sFile Writeln ('/' +'/AB/ CLASSDEF') Writeln ('Class ' * sClassName * 'Is a ' * (value(oSuperClassName(ho),0))) // Advanced Properties Move (oTP_Advanced(otabs(Self))) To ho Get value Of (oControlType(ho)) Item 0 To sVal If sVal Ne '(Inherit)' Writeln (' Set Control_Type to ' * sVal) Get value Of (oDropAllowed(ho)) Item 0 To sVal If sVal Ne '' Writeln (' Set Drop_Allowed to ' * sVal) Get value Of (oTypeDrag(ho)) Item 0 To sVal If sVal Ne '' Writeln (' Set Type_Of_Drag to ' * sVal) Get value Of (oFloatMenuId(ho)) Item 0 To sVal If sVal Ne '(Inherit)' Writeln (' Set Floating_Menu_Id to ' * sVal) Get value Of (oBandAllowed(ho)) Item 0 To sVal If sVal Ne '(Inherit)' Writeln (' Set Band_Allowed to ' * sVal) Get value Of (oMoveAllowed(ho)) Item 0 To sVal If sVal Ne '(Inherit)' Writeln (' Set Move_Allowed to ' * sVal) Get value Of (oMoveSizeAllowed(ho)) Item 0 To sVal If sVal Ne '(Inherit)' Writeln (' Set MoveSize_Allowed to ' * sVal) Get value Of (oRowBased(ho)) Item 0 To sVal If sVal Ne '(Inherit)' Writeln (' Set Row_Based_Object to ' * sVal) Get value Of (oItemBased(ho)) Item 0 To sVal If sVal Ne '(Inherit)' Writeln (' Set Item_Based_Object to ' * sVal) Get value Of (oEntryItem(ho)) Item 0 To sVal If sVal Ne '(Inherit)' Writeln (' Set Entry_Item_Object to ' * sVal) Get value Of (oClassVer(ho)) Item 0 To sVal If sVal Ne '' Writeln (' Set ClassVersion to ' * '"' + sVal +'"') Get value Of (oClassVendor(ho)) Item 0 To sVal If sVal Ne '' Writeln (' Set ClassVendor to ' * '"' + sVal +'"') Move (oClass_gr(oTP_Class(otabs(Self)))) To ho Get value Of (oPackage(ho)) Item 0 To sVal If sVal Ne '' Writeln (' Set ClassPackage to ' * sVal ) Get value Of (oTabpageClass(ho)) Item 0 To sVal If sVal Ne '' Writeln (' Set TabPageClassName to ' * sVal ) If (checked_state(oInherit(ho))) ; Writeln ' Inherit' // Define properties Move (oPropGrid(oTP_properties(otabs(Self)))) To ho Move ((item_count(ho)/7)-1) To iMax For iRow From 0 To iMax Move (iRow*7) To iItem If (select_state(ho,iItem)) Begin Get value Of ho Item (iItem+1) To sPropName Get value Of ho Item (iItem+2) To sDataType Get value Of ho Item (iItem+3) To sGenType Get value Of ho Item (iItem+4) To sDefvalue Get value Of ho Item (iItem+5) To sComm Get value Of ho Item (iItem+6) To sModeValues Writeln (' Property' * sGenType * sDataType * sPropname * sDefvalue * sModevalues * (If(sComm <> '', ('/'+'/' * sComm), '')) ) End Loop Writeln 'End_Class' Close_Output // Register Class in IDE // Check if ClassList exist If (ClassListExists(sVdfVer,sWkspc)) Eq 0 Begin // if not create it Move (CreateClassList(sVdfVer,sWkspc)) To iRet If Not iRet Begin error 999 'Could not create Class List!' Procedure_Return End End // Check if Class already exist Move (ClassExistsInList(sVdfVer,sWkspc, sClassName)) To iItem If iItem Move (DeleteClassInList(sVdfVer,sWkspc, iItem)) To iRet // Add Class to List If (AddClassinList(sVdfVer,sWkspc, sClassname, sImage, sPage, sFile)) Eq 0 Begin error 999 'Could not add Class to List!' Procedure_Return End Send close_panel End_Procedure End_Object // oSetupClass