//********************************************************************* //* Box-Quote 2020-07-21 * //* >> OnBeforeSendingMessage << * //* * //* Dieses Script setzt verschiedene Boxen um einen Text * //* * //* Funktionalitaet: [x] neutral * //* [ ] nur Basis_Modul * //* [ ] nur Pathfinder * //* * //* Datum : 05.04.2004 * //* Autoren : Marcus Mönnig * //* Erweiterungen : Dietmar Vollmeier * //* Überarbeitung : 21.07.2020 Thomas Barhhahn * //* * //* DateiName : _i_OBSendM_Boxquote.ds * //* Einbindung: {$I _i_OBSendM_Boxquote.ds} * //* Aufruf : * //* Result := Result := boxquote ( Result, Message, Error_Func ); * //********************************************************************* procedure Init_Boxquote ( var StartLine_close_box : String; var StartLine_open_box : String; var StartLine_code_box : String; var Separator : char; var Top_Left : char; var Top_Center : char; var Top_Right : char; var Middle_Left : char; var Middle_Right : char; var Down_Left : char; var Down_Center : char; var Down_Right : char; var LineWidthTop : integer; var LineWidthBottom : integer; var s_no_Box_Quote : integer; var s_Box_Quote_title : integer; var s_Box_Quote_content : integer; var Box_Quote_title_code : String ); begin //{-------------------------------------------------------------------} //{ Anwenderspezifische Einstellungen } //{-------------------------------------------------------------------} StartLine_close_box := 'Box:'; // geschlossener Rahmen StartLine_open_box := 'Zitat:'; // offener Rahmen StartLine_code_box := 'Code:'; // Code-Box Separator := '-'; // Example: // Box: <--- Startline - create a box // - <--- your Separator // Text <--- your Text // - <--- your Separator (Endtag) // // Box: // Head of Box // - // Text // - // 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. << // - //{-------------------------------------------------------------------} //{ Ende der Einstellungen } //{-------------------------------------------------------------------} //{===================================================================} //{ !!! Ab hier bitte nichts mehr ändern !!! } //{===================================================================} Top_Left := ','; Top_Center := '-'; Top_Right := '.'; Middle_Left := '|'; Middle_Right := '|'; //Down_Left := ''+#39+''; Down_Left := '`'; Down_Center := '-'; //Down_Right := ''+#39+''; Down_Right := ''''; LineWidthTop := 2; LineWidthBottom := 4; s_no_Box_Quote := 0; s_Box_Quote_title := 1; s_Box_Quote_content := 2; Box_Quote_title_code := 'Code'; end; //--[ START Function BoxQuote ]--------------------------------------- function StringReplaceM( S : String; OldPattern : String; NewPattern : String; replaceall : Boolean; ignorecase : Boolean ) : String; var SearchStr : String; Patt : String; NewStr : String; Offset : Integer; MaxInt : Integer; begin MaxInt := 2147483647; if IgnoreCase then begin SearchStr := AnsiUpperCase( S ); Patt := AnsiUpperCase( OldPattern ); end else begin SearchStr := S; Patt := OldPattern; end; NewStr := S; Result := ''; while SearchStr <> '' do begin Offset := AnsiPos(Patt, SearchStr); if Offset = 0 then begin result := result + NewStr; break; end; result := result + Copy( NewStr, 1, Offset - 1 ) + NewPattern; NewStr := Copy( NewStr, Offset + Length(OldPattern), MaxInt ); if not ReplaceAll then begin Result := Result + NewStr; break; end; SearchStr := Copy( SearchStr, Offset + Length(Patt), MaxInt ); end; end; // function StringReplaceM() function RepeatChar( c : Char; count : Integer ) : String; var i : Integer; begin if count < 0 then count := 0; SetLength( result, count ); for i:=1 to count do result[i] := c; end; // function RepeatChar() function CountChars( s : String; c : Char ) : Integer; var i : Integer; begin result := 0; for i := 1 to Length( s ) do if s[i] = c then result := result + 1; end; // function CountChars() Function BoxQuote ( fbkResult : Boolean; Message : TStringlist; Error_Func : String ) : Boolean; var i, j, k, Inti : Integer; state : Word; Box_Quote_startline : Integer; Box_Quote_title : String; Box_Quote_content : String; maxwidth : Integer; sl : Tstringlist; CloseBox : Boolean; CodeBox : Boolean; StartLine_close_box : String; StartLine_open_box : String; StartLine_code_box : String; Separator : Char; Top_Left : char; Top_Center : char; Top_Right : char; Middle_Left : char; Middle_Right : char; Down_Left : char; Down_Center : char; Down_Right : char; LineWidthTop : integer; LineWidthBottom : integer; s_no_Box_Quote : integer; s_Box_Quote_title : integer; s_Box_Quote_content : integer; Box_Quote_title_code : String; 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 *** Box-Quote *** wurde nicht mehr ausgefuehrt' ,4); WriteToLog ('Script ' + Error_Func + ' hat diesen Fehler verursacht!' ,4); WriteToLog ('==== ENDE =========================================' ,4); Exit; end; Try Init_Boxquote ( StartLine_close_box, StartLine_open_box, StartLine_code_box, Separator, Top_Left, Top_Center, Top_Right, Middle_Left, Middle_Right, Down_Left, Down_Center, Down_Right, LineWidthTop, LineWidthBottom, s_no_Box_Quote, s_Box_Quote_title, s_Box_Quote_content, Box_Quote_title_code ); state := s_no_Box_Quote; i := 0; Box_Quote_startline := -1; while i <= message.count-1 do begin case state of s_no_Box_Quote: begin if (message.strings[i] = StartLine_close_box) or (message.strings[i] = StartLine_open_box) or (message.strings[i] = StartLine_code_box) then begin if message.strings[i] = StartLine_close_box then CloseBox := true else CloseBox := false; if message.strings[i] = StartLine_code_box then CodeBox := true else CodeBox := false; Box_Quote_startline := i; Box_Quote_title := ''; Box_Quote_content := ''; maxwidth := 1; state := s_Box_Quote_title; end end; s_Box_Quote_title: begin if message.strings[i] = Separator then begin if CodeBox and (Box_Quote_title = '') then Box_Quote_title := Box_Quote_title_code; state := s_Box_Quote_content; end else Box_Quote_title := trim( Box_Quote_title + ' ' + message.strings[i] ); end; s_Box_Quote_content: begin if message.strings[i] = Separator then begin state:=s_no_Box_Quote; if Length( '[ ' + Box_Quote_title + ' ]' ) > maxwidth then maxwidth := Length( '[ ' + Box_Quote_title + ' ]' ) + 6; // // delete the raw BoxQuote // for j := Box_Quote_startline to i do message.delete( Box_Quote_startline ); // // middle part // if not CodeBox then begin Box_Quote_content := stringreplacem( #13#10 + Box_Quote_content, #13#10, #13#10 + Middle_Left + ' ', true, false ); delete( Box_Quote_content, 1, 2 ); end; // // first line // if (Box_Quote_title <> '') and not CodeBox then Box_Quote_content := Top_Left + RepeatChar( Top_Center, LineWidthTop ) + '[ ' + Box_Quote_title + ' ]' + #13#10 + Box_Quote_content else if (Box_Quote_title = '') and not CodeBox then Box_Quote_content := Top_Left + RepeatChar( Top_Center, LineWidthTop ) + #13#10 + Box_Quote_content else if (Box_Quote_title <> '') and CodeBox then Box_Quote_content := '8<' + RepeatChar( Top_Center, LineWidthTop ) + '[ ' + Box_Quote_title + ' ]' + #13#10 + Box_Quote_content else if (Box_Quote_title = '') and CodeBox then Box_Quote_content := '8<' + RepeatChar( Top_Center, LineWidthTop ) + #13#10 + Box_Quote_content; // // last line // if Codebox then Box_Quote_content := Box_Quote_content + #13#10 + '8<' + RepeatChar( Down_Center, LineWidthBottom ) else Box_Quote_content := Box_Quote_content + #13#10 + Down_Left + RepeatChar( Down_Center, LineWidthBottom ); sl := Tstringlist.create; try sl.text := Box_Quote_content; // // close the box // if CloseBox or CodeBox then begin for j := 0 to sl.count-1 do begin k := maxwidth - length( sl.strings[j] ); if j = 0 then if CodeBox then sl.strings[j] := sl.strings[j] + repeatchar( Top_Center, k ) + '>8' else sl.strings[j] := sl.strings[j] + repeatchar( Top_Center, k+3 ) + Top_Right else if j = sl.count-1 then if CodeBox then sl.strings[j] := sl.strings[j] + repeatchar( Down_Center, k ) + '>8' else sl.strings[j] := sl.strings[j] + repeatchar( Down_Center, k+3 ) + Down_Right else if not Codebox then sl.strings[j] := sl.strings[j] + repeatchar(' ', k+3) + Middle_Right; end; end; For Inti := (sl.count - 1) downto 0 do begin // WriteToLog ('I'm here! ***' + IntToStr(sl.count), 4); // message.insert( Box_Quote_startline, trim(sl.text) ); message.insert( Box_Quote_startline, trimright(sl[Inti])); end; // For i := Box_Quote_startline + sl.count - 1; finally sl.free; end; end else begin if Box_Quote_content = '' then Box_Quote_content := message.strings[i] else Box_Quote_content := Box_Quote_content + #13#10 + message.strings[i]; if Length( message.strings[i] ) > maxwidth then maxwidth := length( message.strings[i] ); end; end; end; // case i := i + 1; end; // While Except // Bei Problemen das Senden der Nachricht unterbinden begin WriteToLog ('FEHLER im Script *** BoxQuote ***' ,5); Error_Func := '*** BoxQuote ***'; Result := False; end; // Except end; // Try ... Except end; // Function BoxQuote //--[ ENDE Function BoxQuote ]----------------------------------------