Lotus Notes / Domino Sonstiges > Projekt Bereich

Standard bei der Scriptprogrammierung

<< < (18/21) > >>

ata:
... ich möchte was beisteuern, zwei Funktionen zur Ermittlung von Feiertagen in Deutschland. Die zweite Funktion benötigt die erste zur Ermittlung von Ostersonntag...


--- Code: ---Function Ostersonntag(Jahr As Long)As String
%REM
Ostersonntag ist am ersten Sonntag nach dem ersten Vollmond im Frühling.
Die Gauss'sche Berechnung ist gültig für die Jahre 1583 - 2299
... Die Funktion benötigt das Jahr (vierstellig) als Übergabewert.
... Die Funktion gibt als Rückgabewert Ostersonntag als Datum zurück.
... Für den Fall eines nicht berechenbaren Jahres ist der Rückgabestring leer
    nach dem Aufruf der Funktion muß dieser Fall extra abgefangen werden...
    ... If Ostersonntag(Jahr) = "" Then Exit Sub ... ansonsten Type mismatch
ata - Ohne Declarations - implizite Declaration
%END REM   
   Dim J As Integer
   Dim m As Integer
   Dim n As Integer
   Dim a As Integer
   Dim b As Integer
   Dim c As Integer
   Dim d As Integer
   Dim e As Integer
   Dim z As Integer
   Dim Mnt As String
   Dim Tg As String
   Dim GO As String
   
   J = Jahr   
   If J < 100 Then J = 1900 + J
   Select Case J
   Case Is < 1583
      Msgbox Cstr(J) + " kann nicht berechnet werden", 0 , "Berechnung Ostersonntag"
      Exit Function
   Case Is < 1700
      m = 22
      n = 2
   Case Is < 1800
      m = 23
      n = 3
   Case Is < 1900
      m = 23
      n = 4
   Case Is < 2100
      m = 24
      n = 5
   Case Is < 2200
      m = 24
      n = 6
   Case Is < 2300
      m = 25
      n = 0
   Case Else
      Msgbox Cstr(J) + " kann nicht berechnet werden", 0 , "Berechnung Ostersonntag"
      Exit Function
   End Select
   
   a = J Mod 19
   b = J Mod 4
   c = J Mod 7
   d = (19 * a + m) Mod 30
   e = (2 * b + 4 * c + 6 * d + n) Mod 7
   z = 22 + d + e
   Mnt = "03"
   
   If z > 31 Then z = d + e - 9: Mnt = "04"
   Select Case Mnt
   Case "04"
      If z = 26 Then z = 19
      If z = 25 Then
         If D = 28 Then
            If e = 6 Then
               If a > 10 Then z = 18
            End If
         End If
      End If
   End Select
   
   Tg = Ltrim$(Cstr(z))
   If Len(Tg) = 1 Then Tg = "0" + Tg
   
   GO = Tg + "." + Mnt + "." + Ltrim$(Cstr(J))
   Ostersonntag=GO
End Function

Function Feiertag(CheckDate As String) As String
' # Ermittelt, ob das Datum CheckDate ein Feiertag ist...
' # Die Nicht-Feiertage können auskommentiert werden
' # => Rückgabe = "Feiertagsname" für Feiertag, Leerstring für Nicht-Feiertag
   Dim FTag(21) As String
   Dim FName(21) As String
   Dim Jahr As String
   Dim f As Integer
   Dim cd As Integer
   Dim OsterDatum As String
   
   f=0
   Jahr = Cstr(Year(CheckDate))
   Feiertag = ""
   ' Die festen Feiertage
   FTag(1)= "01.01." + Jahr                       ' Neujahr
   FName(1) = "Neujahr"
   FTag(2)= "06.01." + Jahr                        ' Heilige Drei Könige        - BaWü, Bay
   FName(2) = "Heilige Drei Könige"
   FTag(3)= "01.01." + Cstr(Year(CheckDate) )     ' Neujahr
   FName(3) = "Neujahr"
   FTag(4)= "01.05." + Cstr(Year(CheckDate) )     ' Tag der Arbeit
   FName(4) = "Tag der Arbeit"
   FTag(5)= "15.08." + Cstr(Year(CheckDate) )     ' Mariä Himmelfahrt      - Saar, teilweise in Bay und Thür.
   FName(5) = "Mariä Himmelfahrt"
   FTag(6)= "03.10." + Cstr(Year(CheckDate) )     ' Tag der deutschen Einheit
   FName(6) = "Tag der deutschen Einheit"
   FTag(7)= "31.10." + Cstr(Year(CheckDate) )     ' Reformationstag         - Brand., MeVo. , Sa, SaAn. , teilweise in Thür.
   FName(7) = "Reformationstag"
   FTag(8)= "01.11." + Cstr(Year(CheckDate) )     ' Allerheiligen            - BAWü. , Bay, NRW , RhPf. , Saar. und teilweise in Thür.
   FName(8) = "Allerheiligen"
   FTag(9)= "24.12." + Cstr(Year(CheckDate) )    ' Heiligabend - kein offizieller Feiertag
   FName(9) = "Heiliger Abend"
   FTag(10)= "25.12." + Cstr(Year(CheckDate) )    ' 1. Weihnachtsfeiertag
   FName(10) = "1. Weihnachtsfeiertag"
   FTag(11)= "26.12." + Cstr(Year(CheckDate) )  ' 2. Weihnachtsfeiertag
   FName(11) = "2. Weihnachtsfeiertag"
   FTag(12)= "31.12." + Cstr(Year(CheckDate) ) ' Sylvester - kein offizieller Feiertag
   FName(12) = "Sylvester"
   ' Die beweglichen Feiertage
   OsterDatum = Ostersonntag(Cint(Jahr))
   ' Rosenmontag
   FTag(13)= Str(Datevalue(OsterDatum)-48)   ' kein offizieller Feiertag
   FName(13) = "Rosenmontag"
   ' Faschingsdienstag
   FTag(14)= Str(Datevalue(OsterDatum)-47)   ' kein offizieller Feiertag
   FName(14) = "Faschingsdienstag"
   ' Karfreitag
   FTag(15)= Str(Datevalue(OsterDatum)-2)
   FName(15) = "Karfreitag"
   ' Ostersonntag
   FTag(16)= Str(Datevalue(OsterDatum)-0)
   FName(16) = "Ostersonntag"
   ' Ostermontag
   FTag(17)= Str(Datevalue(OsterDatum)+1)
   FName(17) = "Ostermontag"
   ' Himmelfahrt
   FTag(18)= Str(Datevalue(OsterDatum)+39)
   FName(18) = "Christi Himmelfahrt"
   ' Pfingstsonntag
   FTag(19)= Str(Datevalue(OsterDatum)+49)
   FName(19) = "Pfingstsonntag"
   ' Pfingstmontag
   FTag(20)= Str(Datevalue(OsterDatum)+50)
   FName(20) = "Pfingstmontag"
   ' Fronleichnam
   FTag(21)= Str(Datevalue(OsterDatum)+60)   ' - BaWü. , Bay, Hes, NRW. , RhPf. , Saar.  und teilweise Thür.
   FName(21) = "Fronleichnam"
   
   'Msgbox FTag(14)
   For cd = 1 To Ubound(FTag)
      If CheckDate = FTag(cd) Then
         ' Feiertag="F" ' # als Flag verwendbar
         Feiertag = FName(cd)
      End If
   Next   
   
End Function


--- Ende Code ---

Ich habe noch weitere Funktionen und Klassen zum Datums-Handling, die auf diesen Funktionen aufsetzen, falls Interesse besteht...

ata

harkpabst_meliantrop:

--- Zitat von: Rob Green am 20.11.02 - 16:16:38 ---ich weiß nicht, ob Du das vermisst mit "wieviel Text max. zurückgegeben wird": ...

--- Ende Zitat ---

Das meinte ich nicht, das geht mit .Text auch bzw. man kann das Ergebnis ja nachträglich abschneiden.

Ich meinte, es ist nicht dokumentiert, wieviel Text höchstens zurückgegeben wird. Die Hilfe merkt lediglich lappidar an, dass lange Texte evtl. gekürzt sein könnten. Aber mit den Grenzen wirst du schon recht haben.

Ursprünglich hatte ich mein PostSave auch in Formelsprache, aber auch bei @Abstract muss man die Größe des Rückgabewerts ja in Byte angeben. Wenn jetzt aber im Text Sonderzeichen, wie z.B. Zeilenumbrüche enthalten sind, dann ist nicht mehr jedes Zeichen ein Byte groß. Im konkreten Fall wollte ich nach 150 Zeichen abschneiden (bzw. dem ersten Leerzeichen davor) und  dann 3 Punkte setzen, falls der vollständige Text länge als 150 Zeichen ist. Ich habe mich zuerst mächtig gewundert, warum das manchmal gegen die Wand lief. Das waren dann alles Texte mit Zeilenumbrüchen im Bereich der ersten 150 Zeichen.


Axel:
@harkpabst_meliantrop, @ata

Vielen Dank für eure Beiträge. Ich kam leider erst heute dazu wieder ins Forum zu gehen, denn letzte Woche hatte mich eine Erkältung "dahingerafft".

Ich werde die Beiträge erstmal so wie sie sind, in die Datenbank aufnehmen. Teilweise sind ja schon Scriptäquivalente für Formelbefehle vorhanden. Ich werde dann mal versuchen, diese und auch andere Funktionen in Scriptbibliotheken zusammenzufassen.


Axel


Myron:
Hallo
Hatte mir mal das programmiert.
Um von einen zusammengesetzten String mit einem bestimmten Trennzeichen gewisse Teile herauszunehmen.
Habe versucht die Funktion die in MSM nutzbar ist nachzubilden.

Public Function mPiece(ByVal strStr As String, ByVal strDel As String, ByVal intPos As Integer) As String
   
    Dim lauf, i As Integer
    Dim tmp_strStr As String

    lauf = 1
    strStr = strStr + strDel
    i = InStr(1, strStr, strDel)
    While i > 0
        tmp_strStr = Left(strStr, i - 1)
        If lauf = intPos Then
            mPiece = tmp_strStr
            Exit Function
        End If
        strStr = Mid(strStr, i + 1, Len(strStr))
        i = InStr(1, strStr, strDel)
        lauf = lauf + 1
    Wend
End Function

Ist das eine solche Art von Routine in Frage kommen könnte?
Grüße

Axel:
Hi,

solche Routinen sind auf jeden Fall gefragt. Diese Routine gibt es allerdings schon in der Datenbank mit Namen Word.

Die erste kleine Bibliothek gibt es inzwischen, allerdings noch ohne große Kommentare und Hilfen.

http://www.free.dominoserver.de/computer/noteslibrary.nsf/d2d59a3d7fc73a2bc1256a6900638352/4b72e8439c418c6080256c9300736699?OpenDocument

Axel


Navigation

[0] Themen-Index

[#] Nächste Seite

[*] Vorherige Sete

Zur normalen Ansicht wechseln