FlowFact - Entwicklungstools

zurück

Sub - cmd_Obj_FldArtOp_Click
Feldart-Option setzen

Bei einem Objekt wird ein Optionswert eingegeben.
  Sub cmd_Obj_FldArtOp_Click()  
 




Public Sub cmd_Obj_FldArtOp_Click()
    Dim rsObj As ADODB.Recordset
    Dim rsFldArt As ADODB.Recordset
    Dim rsFldArtOp As ADODB.Recordset
    Dim strInput As String
    Dim strFldArtKuerzel As String
    Dim strOpDsn As String
    Dim strFldArtDsn As String
    Dim strObjDsn As String
    Dim strOpList As String
    Dim intCount As Integer
    Dim colOpDsn As Collection
    Dim intInput As Long

    '** Objekt mit der internen Bezeichnung 'TestHaus' suchen.
    Set rsObj = m_oFFDeveloper.OBJ_Find("Intern like 'TestHaus%'", "Angelegt DESC")
    If rsObj.EOF = True Then
        MsgBox "Kein 'TestHaus' gefunden. Bitte zuerst Objekt-Create ausführen."
        Exit Sub
    End If

    '** Eingabe
    strInput = InputBox("Bitte geben sie eine Feldart vom Typ Option an", "Feldartoptionen", "Objektart")
    strFldArtKuerzel = strInput
    If strInput = "" Then
        Exit Sub
    End If

    '** DSN der Feldart bestimmen
    Set rsFldArt = m_oFFDeveloper.FldArt_FindByName(strFldArtKuerzel)
    If rsFldArt.EOF = True Then
        MsgBox "Feldart '" & strFldArtKuerzel & "' nicht gefunden."
        Exit Sub
    End If
    strFldArtDsn = rsFldArt("DSN")


    '** Optionen bestimmen
    Set rsFldArtOp = m_oFFDeveloper.FldArtOp_FindByFldArt(strFldArtDsn)
    If rsFldArtOp.EOF = True Then
        MsgBox "Keine Optionen gefunden. Bitte wählen Sie eine andere Feldart."
        Exit Sub
    End If

    Set colOpDsn = New Collection
    intCount = 1
    strOpList = ""
    While rsFldArtOp.EOF = False
        strOpList = strOpList & CStr(intCount) & ") " & m_oFFDeveloper.oUtil.k(rsFldArtOp("Bezeichnung")) & vbCrLf
        intCount = intCount + 1
        colOpDsn.Add m_oFFDeveloper.oUtil.k(rsFldArtOp("DSN"))
        rsFldArtOp.MoveNext
    Wend

    '** Option-Eingabe
    strInput = InputBox("Wählen Sie eine Nummer aus." & vbCrLf & strOpList, "Feldartoptionen", "1")
    If Trim(strInput) = "" Then
        Exit Sub
    End If

    intInput = Val(strInput)
    If intInput > 0 And intInput <= colOpDsn.Count Then
        strOpDsn = colOpDsn(intInput)
    Else
        MsgBox "Falsche Eingabe"
        Exit Sub
    End If


    '** Deatailwert setzen
    strObjDsn = rsObj("DSN")
    m_oFFDeveloper.OBJ_Detail_SetOptionDsn strObjDsn, strFldArtDsn, strOpDsn

    '** Objekt in FlowFact anzeigen
    m_oFFDeveloper.OBJ_ShowDSN strObjDsn

End Sub