//********************************************************************* //* Do_FootnoteNew 2021-10-24 * //* >> OnBeforeSendingMessage << * //* * //* Dieses Script setzt Fußnoten unterhalb des eigentlichen Artikels. * //* * //* Funktionalitaet: [x] neutral * //* [ ] nur Basis_Modul * //* [ ] nur Pathfinder * //* * //* Datum : überarbeitet am 24.10.2021 * //* Autoren : Thomas Barghahn (2004/11/05) * //* * //* DateiName : _i_OBSendM_do_FootnoteNew.ds * //* Einbindung: {$I _i_OBSendM_do_FootnoteNew.ds} * //* Aufruf : Result := doFootNoteNew ( Result, Message, * //* Error_Func ); * //********************************************************************* procedure Init_doFootNoteNew ( var ConstFootnoteHead : boolean; var ConstFootnoteHeadTxt : String; var ConstFootnoteHeadUnderline : String; var ConstEmptyLine : Boolean; var ConstEmptyLineBeforeFootnote : Boolean; var ConstStartupFootnote : String; var ConstEndFootnote : String; var ConstSuperscript : Boolean; var ConstReWrapEdge : Integer; var ConstMultiLine : String; var ConstRewrapToLine : String; var ConstComments : String ); begin //{-------------------------------------------------------------------} //{ Anwenderspezifische Einstellungen } //{-------------------------------------------------------------------} // Example: Text with Footnotes in your box // Box: // Wolfgang testet // - // Wolfgang Bauer #FN# Wolfgang muss eigentlich nur richtig lesen, dann // klappt sein Vorhaben auch! $# versucht sich gleich an den schwierigsten // Dingen, welche Fussnoten #FN# solch ein Dingens hier $# und Boxen #FN# // sind Rahmen um einen Text $# bieten koennen. << // - // Set this to true, if you want a footnote-header like this: // Footnotes: // ========== ConstFootnoteHead := true; // Define the text, you want to see in your footnote-header. ConstFootnoteHeadTxt := 'Fußnote(n):'; // Here you can define the character which should underline the // footnote-header. If there should be no underline, just set // ConstFootnoteHeadUnderline = ''; ConstFootnoteHeadUnderline := '='; // If there should be a blank line between footnote-header // and footnotes,set this to "true". Otherwhise (false) there // is no empty line between. ConstEmptyLine := false; // By default this script adds a blank line before the footnote block. // Set this to false if you do not want the blank line. ConstEmptyLineBeforeFootnote := true; // Defines start-tag for footnote recognition. // Everything after that (and between end-tag) is recogniced as footnote. ConstStartupFootnote := '#FN#'; // Defines end-tag of footnote recognation. // Please use chars, you normaly not type inside your text. ConstEndFootnote := '$#'; // ** WARNING ** // This parameter only works with the "UTF7_to_UTF8 converter" // Should the numbers be displayed in superscript? ConstSuperscript := True; // For longer footnotes its important to reformat the footnote. // This number defines the column-number (should always be 1 char higher // than inside Dialog). You will find this option in Settings -> General // settings... -> Posting -> Wrap lines after xx chars ConstReWrapEdge := 72; // Defines a control character to expand the footnote to a blank line. // Change it as your own wish. ConstMultiLine := '%%'; // Define char(s) till which the paragraph will be reformated by the // footnote-logic. Its very important if you want to use footnotes // inside boxquotes, to put this at the end of your footnote! ConstRewrapToLine := '<<'; // Useful if you want to talk about this footnote-skript inside 40tude // Dialog, just comment them out. Note that the comment-chars will not // be deleted in the article. ConstComments := '//'; //{-------------------------------------------------------------------} //{ Ende der Einstellungen } //{-------------------------------------------------------------------} end; //{===================================================================} //{ !!! Ab hier bitte nichts mehr ändern !!! } //{===================================================================} //--[ START Function doFootNoteNew ]--------------------------------- function IsSpaceLine( Input_Str : String ) : Boolean; var i : integer; begin Trim (Input_Str); Result := true; if length(Input_Str) >= 1 then for i := 1 to length(Input_Str) do begin if Input_Str[i] <> ' ' then begin Result := false; Break; end; //if end; // for end; // function function GetText( var Txt : TStringlist; var FoundLine : Integer; var FoundPosi : Integer; var CurrLine : Integer; var CurrPosi : Integer; var ConstMultiL : String ) : String; // Function by Mirko D. Walter var res : String; i : Integer; bposi : Integer; MaxInt : Integer; begin MaxInt := 2147483647; result :=''; res := ''; if FoundLine = CurrLine then begin res := Copy( txt.strings[foundline], FoundPosi, CurrPosi - FoundPosi ); end else begin BPosi := FoundPosi; for i := FoundLine to CurrLine do begin if i < CurrLine then begin res := Res + Trim( Copy(txt.strings[i], BPosi, MaxInt) ) + ' '; BPosi := 0; end else begin res := res + Copy( txt.strings[i], 1, CurrPosi-1 ); end; end; end; // // Multine-Special-Character? // BPosi := AnsiPos( ConstMultiL, res ); if BPosi > 0 then begin repeat // // if the following characters are #13#10 // then do no linebreak, simply remove // 1234567890123 // ABCDEF%%gaga# // if Copy( res, BPosi + Length(ConstMultiL), 2 ) = #13#10 then res := Copy( res, 1, BPosi - 1 ) + #13#10 + Trim( Copy(res, BPosi + Length(ConstMultiL), MaxInt) ) else res := Copy( res, 1, BPosi - 1 ) + #13#10 + #13#10 + Trim( Copy(res, BPosi + Length(ConstMultiL), MaxInt) ); BPosi := AnsiPos( ConstMultiL, res ); until BPosi <= 0; res := Trim( res ); end; result := Trim( res ); end; // function GetText() function Rewrap_Str( StrL : String; WEdge : Integer; FootNote : Boolean; ConstRewrap : String ) : String; var Space_Old : Integer; Space_New : Integer; i : Integer; Space_Pos : Integer; Break_L : Boolean; begin Space_Old := 1; Space_New := 1; Space_Pos := WEdge; if Copy( StrL, Length(StrL), 1 ) <> ' ' then StrL := StrL + ' '; if AnsiPos( ConstRewrap, StrL ) > 0 then Delete( StrL, AnsiPos(ConstRewrap, StrL), 2 ); for i:=1 to Length( StrL ) do begin if (StrL[i] = ' ') and (i > 1) and (i < Length(StrL)) then begin if StrL[i+1] = ' ' then begin // found double blank if (StrL[i-1] <> '.') // it's perfectly fine to and (StrL[i-1] <> '?') // have double blanks after and (StrL[i-1] <> '!') // punctuation marks (at and (StrL[i-1] <> ':') // least beyond sentence and (StrL[i-1] <> ';') // delimiters). and (StrL[i-1] <> ' ') then begin // but otherwise not! Delete( StrL, i, 1 ); end; end; end; end; i := 0; while i <= Length( StrL ) do begin i := i + 1; if (Copy(StrL, i, 1) = ' ') or (Copy(StrL, i, 4) = (#13#10 + #13#10)) then begin Break_L := false; Space_Old := Space_New; Space_New := i; if Copy( StrL, i , 4 ) = (#13#10 + #13#10) then begin Insert( ' ', StrL, i + 4 ); Break_L := true; if Space_New < Space_Pos then begin Space_Pos := i + 4 + WEdge; Space_Old := i + 4; Space_New := i + 4; i := i + 4; end; end; if (Space_New >= Space_Pos) and (Space_old <= Space_Pos) then begin if (Space_New = Space_Pos) and (Length(StrL) > Space_Pos) then begin if Footnote = false then begin Delete( StrL, Space_New, 1 ); Insert( #13#10, StrL, Space_New ); Space_Pos := Space_New + WEdge + 1; end else begin Insert( #13#10 + ' ', StrL, Space_New ); if Break_L then begin Space_Pos := i + 4 + WEdge; Space_Old := i + 4; Space_New := i + 4; i := i + 4; end else Space_Pos := Space_New + WEdge + 1; i := i + 3; end; end else begin if Footnote = false then begin if Length( StrL ) > Space_Pos then begin Delete( StrL, Space_Old, 1 ); Insert( #13#10, StrL, Space_Old ); end; Space_Pos := Space_Old + WEdge + 1; if (Space_New >= Space_Pos) and (Length(StrL) > Space_Pos) then begin Delete( StrL, Space_New + 1, 1 ); Insert( #13#10, StrL, Space_New + 1 ); Space_Pos := Space_New + WEdge + 2; i := i + 1; end; end else begin if Space_Old > 5 then begin if Length( StrL ) > Space_Pos then Insert( #13#10 + ' ', StrL, Space_Old ); if Break_L then begin Space_Pos := i + 4 + WEdge; Space_Old := i + 4; Space_New := i + 4; i := i + 4; end else begin Space_Pos := Space_Old + WEdge + 1; if Space_New >= Space_Pos then begin Insert( #13#10 + ' ', StrL, Space_New + 5 ); Space_Pos := Space_New + WEdge + 6; end; end; i := i + 3; end else begin Insert( #13#10 + ' ', StrL, Space_New ); Space_Pos := Space_New + WEdge + 1; i := i + 3; end; end; end; i := i + 1; end; end; end; // while result := TrimRight( StrL ); end; // function Rewrap_Str() Function My_BinaryToDec(Str_Bin_In : String) : LongInt; var Inti : LongInt; var Inthelp : LongInt; var Len_Str_Bin_In : LongInt; begin Result := 0; Len_Str_Bin_In := length(Str_Bin_In); Inti := 0; For IntHelp := Len_Str_Bin_In downto 1 do begin Result := Result + StrToInt(Str_Bin_In[Inthelp]) * Power(2,Inti); Inti := Inti + 1; end; // For End; // Function function My_Bin_To_UTF7 (Bin_In : String) : String; var Inti : Integer; Bin_Temp : string; Dec_Temp : LongInt; begin Dec_Temp := 0; Bin_Temp := ''; Inti := 1; Result := ''; If length (Bin_In) > 0 then begin while Inti < length (Bin_In) do begin Bin_Temp := copy (Bin_In, Inti, 6); Dec_Temp := My_BinaryToDec (Bin_Temp); // WriteToLog ('Dec_Temp : ' + IntToStr(Dec_Temp), 4); If Dec_Temp <= 25 then Result := Result + chr(Dec_Temp + 65); If (Dec_Temp >= 26) and (Dec_Temp <= 51) then Result := Result + chr(Dec_Temp + 71); If (Dec_Temp >= 52) and (Dec_Temp <= 61) then Result := Result + chr(Dec_Temp - 4); If Dec_Temp = 63 then Result := Result + chr(Dec_Temp - 16); Inti := Inti + 6; // WriteToLog ('Result : ' + Result, 4); end; // while end; // If Result := '+' + Result + '-'; end; function doFootNoteNew ( fbkResult : Boolean; Message : TStringlist; var Error_Func : String ) : Boolean; var ConstFootnoteHead : boolean; ConstFootnoteHeadTxt : String; ConstFootnoteHeadUnderline : String; ConstEmptyLine : boolean; ConstEmptyLineBeforeFootnote : Boolean; ConstStartupFootnote : String; ConstEndFootnote : String; ConstSuperscript : Boolean; ConstReWrapEdge : Integer; ConstMultiLine : String; ConstRewrapToLine : String; ConstComments : String; i : Integer; k : Integer; Posi : Integer; Mult_Posi : Integer; FoundLine : Integer; FoundPosi : Integer; OLength : Integer; RFoundPosi : Integer; Rest : String; FN_Temp : String; FN : String; FNR : Integer; Str_FNR : String; Str_FNR_Temp : String; Open_Bracket : String; Closed_Bracket : String; Skip : Boolean; Sig : Boolean; txt2 : String; txt3 : String; Temp_Str : String; Add_txt3 : Boolean; FootnoteStr : String; zw : Integer; MaxInt : Integer; Str_Bin : String; Len_Str_Bin : Integer; First_BodyLine : Integer; Only_Quoted : Boolean; Len_CFHT : Integer; begin // Rückgabewert entsprechend vorheriger Scriptprobleme setzen Result := fbkResult; // Wenn bereits irgendein Script einen Fehler verursacht hat, // dann braucht dieses hier nicht mehr ausgeführt werden If Not Result Then begin WriteToLog ('==== ANFANG =======================================' ,4); WriteToLog ('Script *** Do_FootnoteNew *** wurde nicht mehr ausgefuehrt' ,4); WriteToLog ('Script ' + Error_Func + ' hat diesen Fehler verursacht!' ,4); WriteToLog ('==== ENDE =========================================' ,4); Exit; end; Only_Quoted := True; First_BodyLine := Message.IndexOf('') + 2; For i := First_BodyLine to Message.Count - 1 do begin If (copy (Message[i], 1, 1) <> '>') and (length(Message[i]) > 0) then begin Only_Quoted := False; end; // If end; // For If Only_Quoted = True Then Exit; Init_doFootNoteNew ( ConstFootnoteHead, ConstFootnoteHeadTxt, ConstFootnoteHeadUnderline, ConstEmptyLine, ConstEmptyLineBeforeFootnote, ConstStartupFootnote, ConstEndFootnote, ConstSuperscript, ConstReWrapEdge, ConstMultiLine, ConstRewrapToLine, ConstComments ); i := 0; while i<= (message.count - 1) do begin Temp_Str := message.strings[i] if copy (Temp_Str, 1, 15) = '> *[(full)quote' then begin Delete (Temp_Str, 1, 2); // Insert ('|', Temp_Str, 1); message.strings[i] := Temp_Str; end; i := i + 1; end; if ConstFootnoteHead then begin Len_CFHT := Length (ConstFootnoteHeadTxt); ConstFootnoteHeadTxt := check_charset ('do_FootNoteNew',ConstFootnoteHeadTxt, Message); if Length( ConstFootnoteHeadUnderline ) = 1 then begin for i := 1 to Len_CFHT do begin FootnoteStr := FootnoteStr + ConstFootnoteHeadUnderline; end; end else FootnoteStr := ''; end else FootnoteStr := ''; i := -1; posi := -1; foundposi := -1; rest := ''; fn := ''; sig := false; FNR := 0; Str_FNR := ''; Str_FNR_Temp := ''; txt2 := ''; txt3 := ''; Mult_Posi := -1; Add_Txt3 := false; FN_Temp := ''; Temp_Str := ''; MaxInt := 2147483647; while (i <= message.count-1) and (sig = false) do begin if Rest = '' then begin i := i + 1; // ignore quotes and empty lines Skip := true; while Skip and (i <= message.count - 1) do begin Skip := false; if Sig then begin txt2 := txt2 + message.strings[i] + #13#10; i := i + 1; Skip := true; end else begin if Length( message.strings[i] ) > 0 then begin if Copy( message.strings[i], 1, 1 ) = '>' then begin txt2 := txt2 + message.strings[i] + #13#10; i := i + 1; Skip := true; end; if Length( message.strings[i] ) > 2 then begin if Copy( message.strings[i], 1, 3 ) = '-- ' then begin if Length( FN ) > 0 then begin // WriteToLog('FN: >' + FN + '<', 7); if ConstEmptyLineBeforeFootnote = true then begin txt2 := txt2 + #13#10 + FN; end else begin txt2 := txt2 + FN; end; end; Sig := true; Skip := true; end; end; end else begin txt2 := txt2 + message.strings[i] + #13#10; i := i + 1; Skip := true; end; end; end; if i > message.count-1 then break; // fix added by MM (Oct. 30th, 2003) Rest := message.strings[i]; OLength := Length(Rest); end; if not Sig then begin if FoundPosi > 0 then begin Posi := AnsiPos( ConstEndFootNote, Rest ); if Posi > 0 then begin Mult_Posi := AnsiPos( ConstStartupFootnote, Rest ); if (i + 1) = message.count then Temp_Str := '' else begin Temp_Str := message.strings[i + 1]; If IsSpaceLine(Temp_Str) = true then Temp_Str := ''; end; if (AnsiPos(ConstRewrapToLine, Rest) > 0) or (Temp_Str = '') or (Temp_Str = '-- ') then begin Add_Txt3 := false; if Mult_Posi = 0 then begin if AnsiPos( ConstRewrapToLine, Rest ) > 0 then txt3 := txt3 + Copy( Rest, posi+Length(ConstEndFootnote), AnsiPos(ConstRewrapToLine, Rest)+1 ) else txt3 := txt3 + Copy( Rest, posi+Length(ConstEndFootnote), MaxInt ); end; end else Add_Txt3 := true; zw := posi + olength - Length( rest ); FN_Temp := Open_Bracket + Str_FNR + Closed_Bracket + ' ' + GetText( message, FoundLine, FoundPosi, i, zw, ConstMultiLine); FN_Temp := Rewrap_Str( FN_Temp, ConstReWrapEdge, true, ConstRewrapToLine ); if (FN = '') and (FN_Temp <> '') and (ConstFootnoteHead = true) then begin if FootnoteStr <> '' then FN := ConstFootnoteHeadTxt + #13#10 + FootnoteStr + #13#10 else FN := ConstFootnoteHeadTxt + #13#10; if ConstEmptyLine = true then FN := FN + #13#10; end; FN := FN + FN_Temp + #13#10; // FN := FN // + Open_Bracket + Str_FNR + Closed_Bracket + ' ' // + GetText(message, FoundLine, FoundPosi, i, zw) + #13#10; Rest := Copy( Rest,posi+Length(ConstEndFootnote), MaxInt ); If Rest = '' then Rest := ' '; //08.10.2004 !! FoundPosi := -1; Mult_Posi := -1; end else begin Rest:=''; end; end else begin // WriteToLog('R: ' + Rest, 7); // 1. char = #, ignore this, could be a control character if Copy( Rest + ' ', 1, Length(ConstComments) ) <> ConstComments then begin Posi := AnsiPos(ConstStartupFootnote, Rest); if Posi > 0 then begin // WriteToLog('FN: ' + IntToStr(Posi), 7); RFoundPosi := Posi + Length( ConstStartupFootnote ); FoundPosi := RFoundPosi + OLength - Length( Rest ); FoundLine := i; FNR := FNR + 1; If ConstSuperscript = True then begin Str_FNR_Temp := IntToStr (FNR); k := 1; Str_FNR := ''; Str_Bin := ''; while k <= Length (Str_FNR_Temp) do begin Case Str_FNR_Temp[k] of '0' : begin Str_Bin := Str_Bin + Math_DecToBin (8304, 16); end; '1' : begin Str_Bin := Str_Bin + Math_DecToBin (185, 16); end; '2' : begin Str_Bin := Str_Bin + Math_DecToBin (178, 16); end; '3' : begin Str_Bin := Str_Bin + Math_DecToBin (179, 16); end; '4' : begin Str_Bin := Str_Bin + Math_DecToBin (8308, 16); end; '5' : begin Str_Bin := Str_Bin + Math_DecToBin (8309, 16); end; '6' : begin Str_Bin := Str_Bin + Math_DecToBin (8310, 16); end; '7' : begin Str_Bin := Str_Bin + Math_DecToBin (8311, 16); end; '8' : begin Str_Bin := Str_Bin + Math_DecToBin (8312, 16); end; '9' : begin Str_Bin := Str_Bin + Math_DecToBin (8313, 16); end; end; // case k := k + 1; end; // while Open_Bracket := ''; // "(" chr($E2)+chr($81)+chr($BD); Closed_Bracket := Math_DecToBin (8318, 16); Str_Bin := Str_Bin + Closed_Bracket; Len_Str_Bin := Trunc((length(Str_Bin) - 1) / 6 + 1) * 6; While Length(Str_Bin) < Len_Str_Bin do begin Str_Bin := Str_Bin + '0';; end; // while Closed_Bracket := ''; Str_FNR := My_Bin_To_UTF7 (Str_Bin); // WriteToLog (Str_Bin, 4); // WriteToLog (Str_FNR, 4); end else begin Str_FNR := IntToStr (FNR); Open_Bracket := '['; Closed_Bracket := ']'; end; // if // txt2 := txt2 + Copy( Rest, 1, Posi - 1 ) + Open_Bracket + Str_FNR + Closed_Bracket; txt3 := txt3 + Copy( Rest, 1, Posi - 1 ) + Open_Bracket + Str_FNR + Closed_Bracket; Rest := Copy( Rest, RFoundPosi, MaxInt ); // 08.10.2004 Trim entfernt end else begin if FoundPosi = -1 then begin if Add_Txt3 then txt3 := txt3 + Rest + ' '; if (i + 1) = message.count then Temp_Str := '' else begin Temp_Str := message.strings[i + 1]; If IsSpaceLine(Temp_Str) = true then Temp_Str := ''; end; if ( (AnsiPos(ConstRewrapToLine, Rest) > 0) or (Temp_Str = '') or (Temp_Str = '-- ')) and (txt3 <> '') then begin Add_Txt3 := false; txt3 := Rewrap_Str( txt3, ConstReWrapEdge, false, ConstRewrapToLine ); txt2 := txt2 + txt3; txt3 := ''; Rest := ''; end; if Add_Txt3 = false then txt2 := txt2 + Rest + #13#10; Rest := ''; end; end; end else begin txt2 := txt2 + Rest + #13#10; Rest := ''; end; end; end; end; if txt3 = '' then begin if Sig = false then begin if Length( FN ) > 0 then begin message.text := txt2 + #13#10 + FN; end; end else message.text := txt2; end else begin WriteToLog ('FEHLER im Script *** Do_FootNoteNew ***' ,5); Error_Func := '*** Do_FootNoteNew ***'; message.text := message.text; Result := false; MsgBox( 0, 'End-Tag ''' + ConstEndFootnote + ''' of footnote not found!', 'Abort sending!', MB_OK or MB_IconExclamation ); end; end; // function doFootNoteNew() //--[ ENDE Function doFootNoteNew ]----------------------------------