OBS/Makros und Scripting/Anwendungsbereiche/Beispiele Sammlung

Aus OBS Wiki
Zur Navigation springen Zur Suche springen


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;

Excel Export

procedure StartProc();
var oXlsx: TXLSX;
begin
    oXlsx := TXLSX.Create();
    try
        oXlsx.WorkSheets.Clear;
        oXlsx.AddWorkSheet('Preisliste Original');
        oXlsx.nCurSheet := oXlsx.WorkSheets.Count -1;
        oXlsx.WorkSheets.Items[oXlsx.nCurSheet].PageSettings.PageOrientation := epoPortrait;
        oXlsx.WorkSheets.Items[oXlsx.nCurSheet].PageSettings.MarginLeft := 2; // cm
        oXlsx.WorkSheets.Items[oXlsx.nCurSheet].PageSettings.MarginTop  := 1; // cm

        oXlsx.SetCellT(0, 0, 'Zeile 1', I_USER);
        oXlsx.SetCellT(1, 0, 'Zeile 2', I_USER);

        oXlsx.SaveToFile('c:\temp\test.xlsx');
    finally
        MyFreeAndNil(oXlsx);
    end;
end;

Liste Material Stable

//---------------------------------------------------------------------
//  Procedure: Stable_Intern
//  Author:    jr
//  Date:      10-11-2021
//---------------------------------------------------------------------

function Stable_Intern(oDB:TxDB; cMater_SysUID:String):String;
begin
    Result := 'Dies ist ein Test';
end;
Abgerufen von „http:///index.php?title=OBS/Makros_und_Scripting/Anwendungsbereiche/Beispiele_Sammlung&oldid=60508“