OBS/Makros und Scripting/Anwendungsbereiche/Beispiele Sammlung: Unterschied zwischen den Versionen

Aus OBS Wiki
Zur Navigation springen Zur Suche springen
KKeine Bearbeitungszusammenfassung
Zeile 1: Zeile 1:
{{Makros und Scripting}}
{{Makros und Scripting}}
=Beispiele Sammlung=
=Allgemeine Beispiele=
==Erstellung einer E-Mail==
==Erstellung einer E-Mail==
:<source lang="delphi">
:<source lang="delphi">
Zeile 60: Zeile 60:
         end;
         end;
     end;
     end;
end;
</source>
=Autoersetzung Beispiele=
==DB_Sopen mit While Schleife==
:<source lang="delphi">
//-----------------------------------------------
//        Demo Beispiel Ersezungen Pax
//
//        Mögliche oPax  Methoden
//
//        procedure ReplacePaxAll(const cKuerzel:String; const cErsetzen:String);
//        function  IsSourceChanged():Boolean;
//        function  CurLine():Integer;
//        function  CurPos(): Integer;
//        function  LineCount(): Integer;
//        procedure SetCurrentLine(nIndex:Integer);
//        function  GetLine(nIndex: Integer): String;
//        procedure SetLine(nIndex: Integer; cLine:String);
//
//-----------------------------------------------
procedure ReplacePaxKuerzel(oPax      : TOBS_GetPax;
                            cKuerzel  : String;
                            cErsetzung : String);
var //oLines : TStringList;
    //cSQL  : String;
    //qTmp  : TxFQuery;
    nX    : integer;
    i      : integer;
    //cText  : String;
begin
    if (not InStr(cKuerzel,oPax.Text)) then begin
        exit; 
    end;
    //DebugLine('Parameter Kürzel '+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);
    //Variante 1 
    //oLines      := TStringList.Create();
    //oLines.Text := oPax.Text;
    //oLines.Text := StrTran(oLines.Text,cKuerzel, cErsetzung); 
    //oPax.Text  := oLines.Text;
    //MyFreeAndNil(oLines);
 
    for i:= 0 to oPax.LineCount()-1 do begin
        if (InStr(cKuerzel,oPax.GetLine(i))) then begin
          nX := Pos(cKuerzel,oPax.GetLine(i))-1;
          break;       
        end;
    end;
   
    cErsetzung := CRLF +
                  '//'+Space(nX)+'if (DB_SOpen(oDB, cSQL, qTmp)) then begin' + CRLF +
                  '//'+Space(nX)+'  While (not qTmp.Eof()) do begin'+CRLF+
                  '//'+Space(nX)+'      qTmp.Next;'+CRLF+
                  '//'+Space(nX)+'  End;'+CRLF+
                  '//'+Space(nX)+'End;'+CRLF+
                  '//'+Space(nX)+'DB_Close(qTmp);'+CRLF+
                  CRLF;   
   
    oPax.ReplacePaxAll(cKuerzel, cErsetzung);
   
end;
</source>
==Function Header==
:<source lang="delphi">
//------------------------------------------------------------------------------
//        Demo Beispiel Ersezungen Pax Function Header
//
//        Mögliche oPax  Methoden
//
//        procedure ReplacePaxAll(const cKuerzel:String; const cErsetzen:String);
//        function  IsSourceChanged():Boolean;
//        function  CurLine():Integer;
//        function  CurPos(): Integer;
//        function  LineCount(): Integer;
//        procedure SetCurrentLine(nIndex:Integer);
//        function  GetLine(nIndex: Integer): String;
//        procedure SetLine(nIndex: Integer; cLine:String);
//
//------------------------------------------------------------------------------
procedure ReplacePaxKuerzel(oPax      : TOBS_GetPax;
                            cKuerzel  : String;
                            cErsetzung : String);
var nX        : integer;
    i,y      : integer;
    cAuthor  : String;
    cFunction : String;
    cLine    : String;
    cText    : String;
    nPos      : integer;
begin
    if (not InStr(cKuerzel,oPax.Text)) then begin
        exit; 
    end;
    //DebugLine('Parameter Kürzel '+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);
   
    nPos      := -1;
    cText      := '';
    cFunction  := '';
    cErsetzung := CRLF +
                  '//' + Replicate('-',60) + CRLF +
                  '// Procedure: $3'      + CRLF +
                  '// Author:    $1'      + CRLF +
                  '// Date:      $2'      + CRLF +
                  '// Comment:'            + CRLF +
                  '//' + Replicate('-',60) + CRLF +
                  CRLF;   
   
    //Function oder Procedure enthalten
    //Achtung es werden nur Header oberhalb des Kürzels berücksichtigt
    for i:= 0 to oPax.LineCount()-1 do begin
   
        if (InStr(cKuerzel,oPax.GetLine(i))) then begin
          //DebugLine('Kürzel Found '+cKuerzel);
          y := i;
         
            While (y >= 0) do begin
           
              cLine := AllTrim(Upper(oPax.GetLine(y)));
             
              if ((LeftStr(cLine,10) = 'PROCEDURE ') or
                  (LeftStr(cLine,9)  = 'FUNCTION ')) then begin
                   
                  //Name Function ermitteln
                  cFunction := Token(cLine,' ',2);
                  cFunction := Token(cFunction,'(',1);
                  nPos      := y; 
                  //DebugLine('Function Found '+cFunction+' '+IntToStr(nPos));
                  break; 
                end;
               
                Dec(y);
            end;
                 
        end;
       
        if (nPos >= 0) then begin
            break;
        end;
    end;   
 
    //Header erzeugen
    cAuthor    := DB_ReadSqlValue(oDB, 'BENUTZ', 'b_vollname', 'b_nummer='+DB_SqlVal(oApplication.UserNr));
    cErsetzung := StrTran(cErsetzung, '$1', cAuthor);
    cErsetzung := StrTran(cErsetzung, '$2', DToC(Date()));
    cErsetzung := StrTran(cErsetzung, '$3', cFunction);
    // Header an Position einfügen
    if (nPos >= 0) then begin
        for i:= 0 to oPax.LineCount()-1 do begin
            if (i = nPos) then begin
                cText := cText + cErsetzung;
            end;
          cText := cText + oPax.GetLine(i) + CRLF;     
        end;
        oPax.Text := cText;
        //DebugLine('Ersetzt');
    end;
   
    oPax.ReplacePaxAll(cKuerzel, '');
   
end;
//------------------------------------------------------------------------------
</source>
==Meeting Aufgabe==
:<source lang="delphi">
//-----------------------------------------------
//        Demo Beispiel Ersezungen Pax
//-----------------------------------------------
procedure ReplacePaxKuerzel(oPax      : TOBS_GetPax;
                            cKuerzel  : String;
                            cErsetzung : String);
begin
    //DebugLine('Parameter Kürzel'+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);
    oPax.ReplacePaxAll(cKuerzel, cErsetzung);
end;
</source>
==Rich Kommentarzeile in Courier==
:<source lang="delphi">
//-----------------------------------------------
//        Demo Beispiel Ersezungen Rich
//
//        Beispiel mit Font Änderung
//-----------------------------------------------
procedure ReplaceRTFKuerzel(oRich      : TTextRichEdit;
                            cKuerzel  : String;
                            cErsetzung : String);
begin
    //DebugLine('Parameter Kürzel'+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);
   
    //Variante 1
    //ReplaceRTFAll(oRich,
    //              cKuerzel,
    //              Append2RTF(cErsetzung, CRLF+'Datum:'+DToC(Date())));   
   
    //Variante 2
    cErsetzung := CRLF + '//'+Replicate('-',55);
    cErsetzung := ChangeRTFFont(cErsetzung, 'Courier New');
    ReplaceRTFAll(oRich, cKuerzel, Append2RTF(cErsetzung,CRLF));
end;
</source>
==Unit Header==
:<source lang="delphi">
//------------------------------------------------------------------------------
//        Demo Beispiel Ersezungen Pax Unit Header
//
//        Mögliche oPax  Methoden
//
//        procedure ReplacePaxAll(const cKuerzel:String; const cErsetzen:String);
//        function  IsSourceChanged():Boolean;
//        function  CurLine():Integer;
//        function  CurPos(): Integer;
//        function  LineCount(): Integer;
//        procedure SetCurrentLine(nIndex:Integer);
//        function  GetLine(nIndex: Integer): String;
//        procedure SetLine(nIndex: Integer; cLine:String);
//
//------------------------------------------------------------------------------
procedure ReplacePaxKuerzel(oPax      : TOBS_GetPax;
                            cKuerzel  : String;
                            cErsetzung : String);
var nX      : integer;
    i      : integer;
    cAuthor : String;
begin
    if (not InStr(cKuerzel,oPax.Text)) then begin
        exit; 
    end;
    //DebugLine('Parameter Kürzel '+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);
   
    cErsetzung := CRLF +
                  '//' + Replicate('-',60) + CRLF +
                  '// Unit Name: Pax'      + CRLF +
                  '// Author:    $1'      + CRLF +
                  '// Date:      $2'      + CRLF +
                  '// Purpose:'            + CRLF +
                  '// History:'            + CRLF +
                  '//' + Replicate('-',60) + CRLF +
                  CRLF;   
   
    cAuthor    := DB_ReadSqlValue(oDB, 'BENUTZ', 'b_vollname', 'b_nummer='+DB_SqlVal(oApplication.UserNr));
    cErsetzung := StrTran(cErsetzung, '$1', cAuthor);
    cErsetzung := StrTran(cErsetzung, '$2', DToC(Date()));
   
    oPax.Text := cErsetzung +
                oPax.Text;
   
    oPax.ReplacePaxAll(cKuerzel, '');
   
end;
end;
</source>
</source>

Version vom 12. November 2020, 15:51 Uhr


Allgemeine Beispiele

Erstellung einer E-Mail

function StartProc():Boolean;
var oEmail: TEmail;
begin
    oEmail                 := TEmail.Create();

    try
        //E-mail wird direkt freigegeben (Aktiv = Ja)
        oEmail.lSofortSenden  := True;
        //Signatur aus Konto Laden
        oEmail.lSignature      := True;
        oEmail.cPersNr         := '000111';
        oEmail.cAn             := 'obs@bergau.de';
        //Anhand der von Andresse wird das Konto ermittelt von dem gesendet wird
        oEmail.cVon            := 'info@bergau.de';

        oEmail.cBetreff        := 'Betreff';
        oEmail.cMessage        := 'TEST';

        //Tabelle im HTML Format
        oEmail.cHTMLMessage    := '<html>' +
                                  '<table>' +
                                  '  <tr>' +
                                  '    <th>Vorname</th>' +
                                  '    <th>Nachname</th>' +
                                  '    <th>Alter</th>' +
                                  '  </tr>' +
                                  '  <tr>' +
                                  '    <td>Max</td>' +
                                  '    <td>Mustermann</td>' +
                                  '     <td>50</td>' +
                                  '  </tr>' +
                                  '</table>' +
                                  '</html>';

        oEmail.cAttachment     := 'c:\Temp\test.pdf' + CRLF + 'c:\temp\test2.txt';

        oEmail.Generate_Email();
        oEmail.Generate_Email_Personen_Projekt();
        oEmail.Generate_Email_Personen_Document();
    finally
        MyFreeAndNil(oEmail);
    end;
end;

Automatische DMS Zuordnung

procedure Erkennung();
begin
    OCR_Text := Upper(OCR_Text);

    if (InStr('BURORING EG',OCR_Text)) then begin
        if (InStr('LIEFERSCHEIN ',OCR_Text)) then begin
            OCR_RefNr  := '700001'; //Kundennummer OBS Büroring
            OCR_RefTyp := 'LI';
            OCR_Titel  := 'Büroring Lieferschein '+ OCR_RefNr;
        end;
    end;
end;

Autoersetzung Beispiele

DB_Sopen mit While Schleife

//-----------------------------------------------
//        Demo Beispiel Ersezungen Pax
//
//        Mögliche oPax  Methoden
//
//        procedure ReplacePaxAll(const cKuerzel:String; const cErsetzen:String);
//        function  IsSourceChanged():Boolean;
//        function  CurLine():Integer;
//        function  CurPos(): Integer;
//        function  LineCount(): Integer;
//        procedure SetCurrentLine(nIndex:Integer);
//        function  GetLine(nIndex: Integer): String;
//        procedure SetLine(nIndex: Integer; cLine:String);
//
//-----------------------------------------------

procedure ReplacePaxKuerzel(oPax       : TOBS_GetPax;
                            cKuerzel   : String;
                            cErsetzung : String);
var //oLines : TStringList; 
    //cSQL   : String;
    //qTmp   : TxFQuery;
    nX     : integer;
    i      : integer;
    //cText  : String;
begin

    if (not InStr(cKuerzel,oPax.Text)) then begin
        exit;   
    end;

    //DebugLine('Parameter Kürzel '+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);

    //Variante 1   
    //oLines      := TStringList.Create();
    //oLines.Text := oPax.Text; 
    //oLines.Text := StrTran(oLines.Text,cKuerzel, cErsetzung);  
    //oPax.Text   := oLines.Text;
    //MyFreeAndNil(oLines);
   

    for i:= 0 to oPax.LineCount()-1 do begin
        if (InStr(cKuerzel,oPax.GetLine(i))) then begin
           nX := Pos(cKuerzel,oPax.GetLine(i))-1;
           break;        
        end;
    end;
    
    cErsetzung := CRLF +
                  '//'+Space(nX)+'if (DB_SOpen(oDB, cSQL, qTmp)) then begin' + CRLF +
                  '//'+Space(nX)+'   While (not qTmp.Eof()) do begin'+CRLF+
                  '//'+Space(nX)+'       qTmp.Next;'+CRLF+
                  '//'+Space(nX)+'   End;'+CRLF+
                  '//'+Space(nX)+'End;'+CRLF+
                  '//'+Space(nX)+'DB_Close(qTmp);'+CRLF+
                  CRLF;    
    
    oPax.ReplacePaxAll(cKuerzel, cErsetzung);
    
end;

Function Header

//------------------------------------------------------------------------------
//        Demo Beispiel Ersezungen Pax Function Header
//
//        Mögliche oPax  Methoden
//
//        procedure ReplacePaxAll(const cKuerzel:String; const cErsetzen:String);
//        function  IsSourceChanged():Boolean;
//        function  CurLine():Integer;
//        function  CurPos(): Integer;
//        function  LineCount(): Integer;
//        procedure SetCurrentLine(nIndex:Integer);
//        function  GetLine(nIndex: Integer): String;
//        procedure SetLine(nIndex: Integer; cLine:String);
//
//------------------------------------------------------------------------------

procedure ReplacePaxKuerzel(oPax       : TOBS_GetPax;
                            cKuerzel   : String;
                            cErsetzung : String);
var nX        : integer;
    i,y       : integer;
    cAuthor   : String;
    cFunction : String;
    cLine     : String;
    cText     : String;
    nPos      : integer;
begin

    if (not InStr(cKuerzel,oPax.Text)) then begin
        exit;   
    end;

    //DebugLine('Parameter Kürzel '+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);
    
    nPos       := -1;
    cText      := '';
    cFunction  := '';
    cErsetzung := CRLF +
                  '//' + Replicate('-',60) + CRLF +
                  '// Procedure: $3'       + CRLF +
                  '// Author:    $1'       + CRLF +
                  '// Date:      $2'       + CRLF +
                  '// Comment:'            + CRLF +
                  '//' + Replicate('-',60) + CRLF +
                  CRLF;    
    
    //Function oder Procedure enthalten
    //Achtung es werden nur Header oberhalb des Kürzels berücksichtigt
    for i:= 0 to oPax.LineCount()-1 do begin
    
        if (InStr(cKuerzel,oPax.GetLine(i))) then begin

           //DebugLine('Kürzel Found '+cKuerzel);
           y := i;
           
            While (y >= 0) do begin
            
               cLine := AllTrim(Upper(oPax.GetLine(y)));
               
               if ((LeftStr(cLine,10) = 'PROCEDURE ') or
                   (LeftStr(cLine,9)  = 'FUNCTION ')) then begin
                    
                   //Name Function ermitteln
                   cFunction := Token(cLine,' ',2);
                   cFunction := Token(cFunction,'(',1);
                   nPos      := y;  

                   //DebugLine('Function Found '+cFunction+' '+IntToStr(nPos));
                   break;   
                end;
                
                Dec(y);
            end;
                  
        end;
        
        if (nPos >= 0) then begin
            break;
        end;
    end;    
   
    //Header erzeugen
    cAuthor    := DB_ReadSqlValue(oDB, 'BENUTZ', 'b_vollname', 'b_nummer='+DB_SqlVal(oApplication.UserNr));
    cErsetzung := StrTran(cErsetzung, '$1', cAuthor);
    cErsetzung := StrTran(cErsetzung, '$2', DToC(Date()));
    cErsetzung := StrTran(cErsetzung, '$3', cFunction);

    // Header an Position einfügen
    if (nPos >= 0) then begin
        for i:= 0 to oPax.LineCount()-1 do begin
            if (i = nPos) then begin
                cText := cText + cErsetzung;
            end;
           cText := cText + oPax.GetLine(i) + CRLF;      
        end;
        oPax.Text := cText;
        //DebugLine('Ersetzt');
    end; 
    
    oPax.ReplacePaxAll(cKuerzel, '');
    
end;

//------------------------------------------------------------------------------

Meeting Aufgabe

//-----------------------------------------------
//         Demo Beispiel Ersezungen Pax
//-----------------------------------------------
procedure ReplacePaxKuerzel(oPax       : TOBS_GetPax;
                            cKuerzel   : String;
                            cErsetzung : String);
begin

    //DebugLine('Parameter Kürzel'+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);

    oPax.ReplacePaxAll(cKuerzel, cErsetzung);
end;

Rich Kommentarzeile in Courier

//-----------------------------------------------
//         Demo Beispiel Ersezungen Rich
//
//         Beispiel mit Font Änderung
//-----------------------------------------------

procedure ReplaceRTFKuerzel(oRich      : TTextRichEdit;
                            cKuerzel   : String;
                            cErsetzung : String);
begin

    //DebugLine('Parameter Kürzel'+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);
    
    //Variante 1
    //ReplaceRTFAll(oRich,
    //              cKuerzel,
    //              Append2RTF(cErsetzung, CRLF+'Datum:'+DToC(Date())));    
    
    //Variante 2
    cErsetzung := CRLF + '//'+Replicate('-',55); 
    cErsetzung := ChangeRTFFont(cErsetzung, 'Courier New');

    ReplaceRTFAll(oRich, cKuerzel, Append2RTF(cErsetzung,CRLF));
end;

Unit Header

//------------------------------------------------------------------------------
//        Demo Beispiel Ersezungen Pax Unit Header
//
//        Mögliche oPax  Methoden
//
//        procedure ReplacePaxAll(const cKuerzel:String; const cErsetzen:String);
//        function  IsSourceChanged():Boolean;
//        function  CurLine():Integer;
//        function  CurPos(): Integer;
//        function  LineCount(): Integer;
//        procedure SetCurrentLine(nIndex:Integer);
//        function  GetLine(nIndex: Integer): String;
//        procedure SetLine(nIndex: Integer; cLine:String);
//
//------------------------------------------------------------------------------

procedure ReplacePaxKuerzel(oPax       : TOBS_GetPax;
                            cKuerzel   : String;
                            cErsetzung : String);
var nX      : integer;
    i       : integer;
    cAuthor : String;
begin

    if (not InStr(cKuerzel,oPax.Text)) then begin
        exit;   
    end;

    //DebugLine('Parameter Kürzel '+cKuerzel);
    //DebugLine('Parameter Ersetzung '+cErsetzung);
    
    cErsetzung := CRLF +
                  '//' + Replicate('-',60) + CRLF +
                  '// Unit Name: Pax'      + CRLF + 
                  '// Author:    $1'       + CRLF +
                  '// Date:      $2'       + CRLF +
                  '// Purpose:'            + CRLF +
                  '// History:'            + CRLF +
                  '//' + Replicate('-',60) + CRLF +
                  CRLF;    
    
    cAuthor    := DB_ReadSqlValue(oDB, 'BENUTZ', 'b_vollname', 'b_nummer='+DB_SqlVal(oApplication.UserNr));
    cErsetzung := StrTran(cErsetzung, '$1', cAuthor);
    cErsetzung := StrTran(cErsetzung, '$2', DToC(Date()));
    
    oPax.Text := cErsetzung +
                 oPax.Text;
    
    oPax.ReplacePaxAll(cKuerzel, '');
    
end;
Abgerufen von „http:///index.php?title=OBS/Makros_und_Scripting/Anwendungsbereiche/Beispiele_Sammlung&oldid=58676“