//TH-Header //***************************************************************************************** // Copyright (c) 2014 KURANT Project // All rights reserved. // // $FileName : pval.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: Property Values List // //***************************************************************************************** //TH-RevisionStart //TH-RevisionEnd // Project Object Structure // oPV is a dbModalPanel // Grid1 is a Grid // Register all objects Register_Object Grid1 Register_Object oPV Use For_All Object oPV is a dbModalPanel #IF (!@ >= 140) Set pbSizeToClientArea to False #ENDIF Property integer piInvoking_Object_ID public 0 Property integer piInvoking_Object_Item public 0 On_Key Key_Escape Send Close_Panel Set Locate_Mode to NO_LOCATE Set Border_Style to Border_Normal Set Caption_Bar to FALSE Set Label to "Change this 'Label' property..." Set Size to 66 123 Set Location to 14 101 Set Color to clWhite Object Grid1 is a Grid Set GridLine_Mode to GRID_VISIBLE_NONE Set Select_Mode to NO_SELECT Set Border_Style to Border_None On_Key Key_Enter Send Move_Value_Out Set Color to clWhite Set CurrentCellColor to clNavy Set CurrentCellTextColor to clWhite Set CurrentRowColor to clNavy Set CurrentRowTextColor to clWhite Set Size to 62 166 Set Location to 2 2 Set Header_Visible_State to FALSE Set Scroll_Bar_Visible_State to FALSE Set Highlight_Row_state to TRUE Set Line_Width to 1 0 Set Form_Width item 0 to 119 Set Header_Label item 0 to "Column 1" Procedure FillValueList integer iPType string sValStr string sProp string sVal sChr sMin integer iCnt iFor Number iFrom iTo Send Delete_Data While "_" in sProp Replace "_" in sProp with " " Loop Move (Left(sProp,1)) to sChr Replace sChr in sProp with (Uppercase(sChr)) If (iPType=1) Begin If ((sValStr="integer")or(sValStr="number")or(sValStr="real")) Send Add_Item 0 "0" // ("{"+Trim(sValStr)+"Variable}") If (sValStr="string") Send Add_Item 0 ('"'+sProp+'"') // ("{"+Trim(sValStr)+"Variable}") Set Entry_State item (Item_Count(self)-1) to False End If (iPType=2) Begin Send Add_Item 0 "(class(current_object))" End If (iPType=3) Begin Send Add_Item 0 ("{ObjectId}") Set Entry_State item (Item_Count(self)-1) to False End If (iPType=4) Begin If "|" in sValStr Begin While "|" in sValStr Pos "|" in sValStr Left sValStr to sVal Replace sVal in sValStr with "" Replace "|" in sVal with "" Send Add_Item 0 (Uppercase(Trim(sVal))) Set Entry_State item (Item_Count(self)-1) to False Loop If (sValStr<>"") Begin Send Add_Item 0 (Uppercase(Trim(sValStr))) Set Entry_State item (Item_Count(self)-1) to False End End Else Begin Send Add_Item 0 (Uppercase(Trim(sValStr))) Set Entry_State item (Item_Count(self)-1) to False End End If (iPType=5) Begin If "-" in sValStr Begin Move (left(sValStr,1)) to sMin If (sMin="-") Begin Replace sMin in sValStr with "" Move sMin to sChr Pos "-" in sValStr If (found) Begin Move (sChr+Left(sValStr,strMark)) to sChr Replace (Left(sValStr,strMark)) in sValStr with "" Replace "-" in sChr with "" Move (number(sChr)) to iFrom Move (number(sValStr)) to iTo For iFor from iFrom to iTo Send Add_Item 0 (String(iFor)) Set Entry_State item (Item_Count(self)-1) to False Loop End End Else Begin Pos "-" in sValStr If (found) Begin Move (Left(sValStr,strMark)) to sChr Replace sChr in sValStr with "" Replace "-" in sChr with "" Move (number(sChr)) to iFrom Move (number(sValStr)) to iTo For iFor from iFrom to iTo Send Add_Item 0 (String(iFor)) Set Entry_State item (Item_Count(self)-1) to False Loop End // if found End End End If ((iPType=6)or(iPType=7)) Begin Send Add_Item 0 ("{MessageID}") Set Entry_State item (Item_Count(self)-1) to False End If (iPType=9) Begin Send Add_Item 0 ("{WindowsMessageID}") Set Entry_State item (Item_Count(self)-1) to False End If (iPType=10) Begin Send Add_Item 0 ("{dbFILE}") Set Entry_State item (Item_Count(self)-1) to False End If (iPType=11) Begin Send Add_Item 0 ("{dbFIELD}") Set Entry_State item (Item_Count(self)-1) to False End If (iPType=12) Begin Send Add_Item 0 ("{DBFILE.DBFIELD}") Set Entry_State item (Item_Count(self)-1) to False End If (iPType=13) Begin Send Add_Item 0 ("{ImageNumber}") Set Entry_State item (Item_Count(self)-1) to False End If (Item_Count(Self)=0) Begin Send Add_Item 0 "" Set Entry_State item (Item_Count(self)-1) to False End End_Procedure Procedure Move_Value_Out Integer iItm iObj iObjItm Get Current_Item to iItm Get piInvoking_Object_ID of oPV to iObj Get piInvoking_Object_Item of oPV to iObjItm If (iObj) Set value of iObj item iObjItm to (value(self,iItm)) Send Close_panel End_Procedure Procedure Mouse_Click Send Move_Value_Out End_Procedure End_Object // Grid1 Procedure PopUp Integer iPType String sValStr Integer iObj Integer iItm string sProp integer iLoc integer cxy cy iFW If (iObj) Set piInvoking_Object_ID to iObj If (iItm) set piInvoking_Object_Item to iItm If (sValStr<>"") Send FillValueList to (Grid1(Self)) iPType sValStr sProp Get Absolute_GUIOrigin of iObj to cxy Set GUILocation to (Hi(iLoc)+Hi(cxy)) (Low(iLoc)+Low(cxy)) Send Adjust_Logicals Get Size to cxy Move (Hi(cxy)) to cy Get Form_Width of iObj item iItm to iFW Set Size to cy (iFW-2) Set Size of Grid1 to (Hi(Size(Grid1(Self)))) (Low(Size(Self))+25) Set Form_Width of Grid1 item 0 to (iFW-6) Forward Send PopUp End_Procedure End_Object // oPV