Lotus Notes / Domino Sonstiges > Projekt Bereich

@Formula-Befehle in Lotus Script abbilden

(1/21) > >>

TMC:
Hi,

immer mal wieder stoße ich auf die Frage, wie ich denn z.B. ein @Unique in Lotus Script abbilden kann.

Daher mache ich mal ein neues Projekt hier auf, in der Hoffnung, dass sich das ganze nach und nach füllt.

Ich fange mal an:

@ReplaceSubstring:


--- Code: ---Function strReplace(Byval target As String, Byval rfrom As String, Byval rto As String) As String
   Dim pos As Long, lastpos As Long
   pos = Instr(target, rfrom)
   lastpos = 1
   Do Until pos = 0
      strReplace = strReplace & Mid$(target, lastpos, pos-lastpos) & rto
      lastpos = pos + Len(rfrom)
      pos = Instr(lastpos, target, rfrom)
   Loop
   strReplace = strReplace & Mid$(target, lastpos)
End Function
--- Ende Code ---

@Unique:

Infos von der Quelle (Sandbox Tipp DB):

--- Zitat ---Suppose you have built an array that may have duplicate items, and now you want to "clean up" the array by eliminating the duplicates.  The obvious way to do this is to loop through the array and build another array without the duplicates.  
An alternative method is to build a list array where each listtag is the value for the desired array.  (Remember, since we only need the listtag from the list array the value that the elements of the array are set to is irrelevant - in the function we set them to 1.)  After building the list array, loop through the list and pull the listtag values out and write them to the final array.  This prevents dupes from getting into the array, and eliminates the need for any REDIMs.
Here is button demonstrating this concept.  This button uses a LotusScript function called "Unique" to perform the same operation that @Unique(list) performs, using the technique described above.
--- Ende Zitat ---

Button-Code:

--- Code: ---Sub Click(Source As Button)
     Dim newitem$, reslist$, ulist As Variant
     newitem = "Notes is kewl"
     x = 0
     
     REM prompt the user for items for the array till they quit
     Do While newitem <> ""
          If newitem <> "" Then
               Redim Preserve slist(x) As String
               REM InputBox[$] ( prompt [ , [ title ] [ , [ default ] [ , xpos , ypos ] ] ] )
                 newitem = Inputbox$("Enter another item to add to the list." & Chr$(10) & "Click Cancel when you are done.", "Enter Item", newitem)
               slist(x) = newitem
               x = x + 1
          End If
     Loop
     
     REM run the array through the unique function
     ulist = Unique(slist)
     
     REM Now set up the result so it can be displayed to the user
     Forall u In ulist
          reslist = reslist & Chr$(10) & u
     End Forall
     Msgbox "The unique list is:" & reslist,, "Unique Result"
End Sub
--- Ende Code ---

Function Code

--- Code: ---Function Unique(a)
     Dim data List As Integer
     Dim i%, n%
     
     REM test to see if a is an array; if not, return it
     If Not(IsArray(a)) Then
           Unique = a
           Exit Function
     End If

     For i=Lbound(a) To Ubound(a)
          data( Cstr(a(i)) ) = i
     Next
     
     REM This takes the new list and puts it back into an array
     n = 0
     Redim newarray(0 To Ubound(a)-Lbound(a))
     Forall z In data
          newarray(n) = a(z)
          n = n + 1
     End Forall
     Redim Preserve newarray(0 To n-1)
     
     REM This returns the new array
     Unique = newarray
End Function
--- Ende Code ---


TMC

P.S.: Sollte es schon eine Auflistung im World Wide Web geben, bitte um Info, dann schließe ich das wieder

TMC:
Damit nicht gleich die Frage aufkommt, "wie Formel in Script verwenden":

Syntax

variant = notesSession.Evaluate( formula$, doc )

variant: Das Rückgabewert. Ist ein "Skalar"-Wert.
formula$: String. Eben die Formel
doc: NotesDocument. Der Formelkontext. Darf nicht null sein.


TMC

TMC:
@RightBack

Text der Quelle:

--- Zitat ---Similar to the @RightBack function, RightBackArr takes a string scalar or array and a search string or numeric position, and returns everything to the right of the last occurrence of the search string. RightBack function is similar but only works on scalars. In R5, you can use StrRightBack instead of RightBack if your position argument is a string.
--- Ende Zitat ---

Für R5 und höher:

--- Code: ---Function RightBackArr(src, pos, Byval flags As Integer)
   If Isarray(src) Then
      Dim i As Integer
      Redim result(Lbound(src) To Ubound(src))
      For i = Lbound(src) To Ubound(src)
         result(i) = RightBackArr(src(i), pos)
      Next
      RightBackArr = result
   Elseif Datatype(pos) = 8 Then
      RightBackArr = StrRightBack(src, pos, flags)
   Else
      RightBackArr = Mid$(src, pos)
   End If
End Function
--- Ende Code ---

Für R4 und höher:

--- Code: ---Function RightBack(Byval src As String, pos) As String
   If Datatype(pos) = 8 Then
      ' position is a string.
      If pos = "" Then Exit Function
      Dim epos&, lpos&
      epos = Instr(src, pos)
      Do Until epos = 0
         lpos = epos
         epos = Instr(epos + Len(pos), src, pos)
      Loop
      If lpos > 0 Then
         RightBack = Mid$(src, lpos+Len(pos))
      End If
   Else
      RightBack = Mid$(src, pos)
   End If
End Function

Function RightBackArr(src, pos)
   If Isarray(src) Then
      Dim i As Integer
      Redim result(Lbound(src) To Ubound(src))
      For i = Lbound(src) To Ubound(src)
         result(i) = RightBack(src(i), pos)
      Next
      RightBackArr = result
   Else
      RightBackArr = RightBack(src, pos)
   End If
End Function
--- Ende Code ---

TMC:
@LeftBack

Text der Quelle:

--- Zitat ---Equivalent to @LeftBack except that it doesn't handle lists. Intended for use in R4 apps that can't use StrLeftBack.
Note: StrLeftBack can only search for strings. This function can take a string or a numeric position, like @LeftBack.
--- Ende Zitat ---

Script:


--- Code: ---Function LeftBack(Byval src As String, pos) As String
   If Datatype(pos) = 8 Then
      If pos = "" Then Exit Function
      Dim epos&, lpos&
      epos = Instr(src, pos)
      Do Until epos = 0
         lpos = epos
         epos = Instr(epos + Len(pos), src, pos)
      Loop
      If lpos > 0 Then
         LeftBack = Mid$(src,1, lpos-1)
      End If
   Else
      LeftBack = Mid$(src, pos)
   End If
End Function
--- Ende Code ---

TMC:
@Replace

--- Code: ---Function atReplace(src As Variant, from_list As Variant, to_list As Variant) As Variant
' Replace in src all occurrences of an item in from_list with the corresponding element of to_list.
   ' Resembles the macro language @Replace function.
   Dim i%
   If Isarray(src) Then
      Redim result(Lbound(src) To Ubound(src))
      For i = Lbound(result) To Ubound(result)
         result(i) = atReplace(src(i), from_list, to_list)
' Note: we expect the elements of Replace to be simple strings, but this will also work with an array of arrays.
      Next
      atReplace = result
   Elseif Isarray(from_list) Then
' The "from" argument is an array; compare each element of the array against the scalar value src.
      For i = Lbound(from_list) To Ubound(from_list)
         If src = from_list(i) Then
' If a match is found, get the corresponding element of the "to" list (null string if no corresponding element).
            If Isarray(to_list) Then
               If Ubound(to_list) < i Then
                  atReplace = ""
               Else
                  atReplace = to_list(i)
               End If
            Elseif i = 0 Then
               atReplace = to_list
            Else
               atReplace = ""
            End If
            Exit Function
         End If
      Next
      atReplace = src
   Elseif from_list = src Then
      If Isarray(to_list) Then
         atReplace = to_list(Lbound(to_list))
      Else
         atReplace = to_list
      End If
   Else
      atReplace = src
   End If
End Function

--- Ende Code ---

Navigation

[0] Themen-Index

[#] Nächste Seite