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

Aus OBS Wiki
Zur Navigation springen Zur Suche springen
(Die Seite wurde neu angelegt: „The title regarding the journalist is Shaunna Blair but it's perhaps not the most feminine name around. in my own professional life i will be a postal solution…“)
 
 
(12 dazwischenliegende Versionen von 3 Benutzern werden nicht angezeigt)
Zeile 1: Zeile 1:
The title regarding the journalist is Shaunna Blair but it's perhaps not the most feminine name around. in my own professional life i will be a postal solution worker. New [http://Www.thefreedictionary.com/Hampshire Hampshire] is her delivery destination but now she is considering additional options. The favorite hobby for him and their children is do [http://Www.Thefreedictionary.com/origami origami] but he cannot allow it to be his career. i have been taking care of my internet site for some time now. Check it out right here: http://www.sandvimprovements.com.au/UserProfile/tabid/57/userId/91137/Default.aspx<br><br>Also visit my web site ... [http://www.sandvimprovements.com.au/UserProfile/tabid/57/userId/91137/Default.aspx Naked U Season 2 Review]
{{Makros und Scripting}}
=Allgemeine Beispiele=
==Erstellung einer E-Mail==
:<source lang="delphi">
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;
</source>
==Automatische DMS Zuordnung==
:<source lang="delphi">
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;
</source>
 
:<source lang="delphi">
procedure Erkennung();
var nPos      : integer;
    cEKRechNr : String;
    cEKLiefNr : String;
    cEKNr    : String;
    cZeile    : String;
begin
    OCR_Text := Upper(OCR_Text);
 
    //DebugLine('Check Amazon Dokument '+OCR_Nr); 
 
    if (InStr('VERKAUFT VON AMAZON',OCR_Text)) then begin
   
      DebugLine('Verkauft von Amazon'); 
   
        if (InStr('RECHNUNGSNUMMER ',OCR_Text)) then begin
       
            nPos := Pos('RECHNUNGSNUMMER ',OCR_Text);
           
            if (nPos > 0) then begin
           
                cZeile    := Substr(OCR_Text,nPos,100);
                cZeile    := StrTran(cZeile,CRLF,' ');
                cEKRechNr := Token(cZeile,' ',2);
               
                DebugLine('Rechnungsnummer '+cEKRechNr); 
               
                if (not Empty(cEKRechNr)) then begin
               
                    cEKNr := DB_ReadSqlValue(oDB, 'EINKAUF',  'a_nr', 'a_aufnrku='+DB_SqlVal(cEKRechNr));
                     
                    if (not Empty(cEKNr)) then begin
                   
                        if (not Empty(cEKNr)) then begin
                            OCR_RefNr  := cEKRechNr;
                            OCR_RefTyp := DMS_TYP_EINKAUF;
                            OCR_Titel  := 'Amazon Einkauf';
                            OCR_PsNr  := '700969';
                            //Automatische Zuweisung über simulierte EAN
                            DMS_EAN_21(oDB,'OBS' + OCR_RefTyp + cEKNr,OCR_Nr);
                            DebugLine('Einkauf '+cEKLiefNr); 
                        end;
                       
                    end else begin
                   
                        cEKLiefNr := DB_ReadSqlValue(oDB, 'EINKLIEF', 'a_nr', 'a_aufnrku='+DB_SqlVal(cEKRechNr)); 
                           
                        if (not Empty(cEKLiefNr)) then begin
                            OCR_RefNr  := cEKRechNr;
                            OCR_RefTyp := DMS_TYP_EINKAUFSLIEFERSCHEIN;
                            OCR_Titel  := 'Amazon Einkaufslieferschein';
                            OCR_PsNr  := '700969';
                           
                            //Automatische Zuweisung über simulierte EAN
                            DMS_EAN_21(oDB,'OBS' + OCR_RefTyp + cEKNr,OCR_Nr);
                            DebugLine('Einkaufslieferschein '+cEKLiefNr); 
                        end;
                    end;
                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;
</source>
==Excel Export==
<source lang="delphi">
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;
</source>
==Liste Material Stable==
<source lang="delphi">
//---------------------------------------------------------------------
//  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;
</source>
==E-Mail Maske Platzhalter==
:<source lang="delphi">
Function GetAnsprechPartner(    cVonAdr    : String;
                            var cAPName    : String;
                            var cAPVorname : String;
                            var cAPAnrede    : String ):Boolean;
var cSQL        : String;
    FrmGauge    : TFrmGauge;
    qSQL        : TqSQL;
    qPers      : TxFQuery;
begin
  Result    := False;
  cAPName    := '';
  cAPVorname := '';
  cAPAnrede  := '';
 
  if (not(empty(cVonAdr))) then begin
      cSQL := 'SELECT * FROM ' +
              //PERSSTA
              '  (SELECT ps_nr, ps_mailzuord, "" AS ap_anrede, "" AS ap_email, "" AS ap_name, "" AS ap_vorname' +
              '  FROM PERSSTA' +
              '  WHERE TRIM(ps_email) = ' + DB_SqlVal(cVonAdr, 'C') +
              '  UNION '  +
              //ANSP
              '  SELECT ps_nr, ps_mailzuord AS ps_mailzuord,  ap_anrede, ap_email, ap_name, ap_vorname' +
              '  FROM ANSP' +
              '  LEFT JOIN PERSSTA ON ANSP.ap_pnr = PERSSTA.ps_nr' +
              '  WHERE TRIM(ap_email) = ' + DB_SqlVal(cVonAdr, 'C') +
              '  ) a' +
              ' GROUP BY ps_nr' +
              ' ORDER BY ps_mailzuord DESC, ps_nr' +
              ' LIMIT 1';
     
      if (DB_SOpen(oDB, cSQL, qPers)) then begin
          cAPName    := qPers.A2C('ap_name');
          cAPVorname := qPers.A2C('ap_vorname');
          cAPAnrede  := DB_ReadSQLValue(oDB,'s_anred','ar_brief','ar_nr = ' + DB_SQLVal(qPers.A2C('ap_anrede'),'C'));
          Result := True;
      end;
  end;
end;
 
procedure ReplaceRTFKuerzel(oRich      : TTextRichEdit;
                            cKuerzel  : String;
                            cErsetzung : String);
var oFrmEdit  : TFrmEdit;
    cAn        : String;
    oAn        : TStringEdit;
    cAPName    : String;
    cAPVorname : String;
    cAPAnrede    : String;
begin
    oFrmEdit := TFrmEdit(Screen.ActiveForm);
   
    if (Assigned(oFrmEdit)) then begin
   
        If (Upper(oFrmEdit.Classname) = 'TFRMEDITEMAIL') and
            oFrmEdit.lEditMode                          then begin   
           
            oAn := TStringEdit(oFrmEdit.FindComponent('stred_db_e_an'));
         
            if (Assigned(oAn)) then begin
           
                cAn := AllTrim(Token(Alltrim(oAn.Text), ',', 1));
             
                if (GetAnsprechPartner(cAn, cAPName, cAPVorname, cAPAnrede))  then begin
                   
                    ReplaceRTFAll(oRich,
                                  '#ANREDE',
                                  cAPAnrede);
                               
                    ReplaceRTFAll(oRich,
                                  '#VORNAME',
                                  cAPVorname);
                               
                    ReplaceRTFAll(oRich,
                                  '#NACHNAME',
                                  cAPName);
                                 
                    ReplaceRTFAll(oRich,
                                  '#NAME',
                                  cAPName);                                                                 
                end;
            end;             
        end; 
    end;
end;
</source>
=Vorgänge=
==Positionen von Verkaufsvorgängen neu nummerieren==
:<source lang="delphi">
// Neunummerierung aller Positionen eines Vorgangs am Beispiel Angebot (TAngebot)
// Geht auch mit anderen VK-Vorgängen.
// Bei Bedarf daher TAngebot mit dem benötigten Typ ersetzen
// Auftrag      -> TAuftrag
// Lieferschein -> TLieferschein
// Rechnung    -> TRechnung
//
// Format der Vorgangsnummer und Intervall für Positionnummern sind in diesem
// Beispiel als Funktionsparameter enthalten. Sie können auch auf die Parameter
// verzichten und tragen die gewünschten Werte direkt in der Funktion PosNeuNum
// statt der Variablen in die Wertezuweisungen ein.
//------------------------------------------------------------------------------
 
// Funktion zur Neunummerierung der Positionen eines Vorgang
procedure PosNeuNum(const cNr: string; const cPosNrFormat: string; const nPosNrIntervall: integer);
var oVG : TAngebot;
    i  : integer;
begin
    //bestimmtes Angebot mit Positionen aus Datenbank auslesen
    //Parameter 1: Datenbankverbindung; Hier kann "oDB" verwendet werden,
    //            welches in allen OBS-Makros standardmäßig zur Verfügung steht.
    //Parameter 2: Vorgangsnummer
    //Parameter 3: Positionen auslesen Ja oder Nein (Boolean True/False)
    oVG := TAngebot.Read(oDB, cNr, True);
 
    //Bei Bedarf hier Nummerierungsmaske setzen
    //G = Gewerk
    //T = Titel
    //P = Position
    //Beispiel: 'TTPPP'
    //Falls auf Default aus PMode gestellt werden soll hier den Wert aus PMode 455 auslesen.
    //Alternativ kann eine Maske auch direkt als String vorgegeben werden.
    //Es ist aber darauf zu achten, dass Großbuchstaben verwendet werden!
    oVG.cPosFormat := cPosNrFormat;
 
    //Nummerierungsintervall für Positionen setzen
    //Standardwert ist 1
    //Bei einem Wert kleiner 1 wird automatisch 1 verwendet
    oVG.nPosInc    := nPosNrIntervall;
 
    //Positionen durchlaufen
    for i := 1 to oVG.PnPosCnt do begin
        //Neunummerierung für Position aktivieren
        //Nur für Postionen vom Typ Artikel- oder Leistungsposition, Titel oder Gewerk
        oVG.PaPositionen[i].lNeuNum := (oVG.PaPositionen[i].cTyp = POSTYP_POS) or
                                      (oVG.PaPositionen[i].cTyp = POSTYP_TIT) or
                                      (oVG.PaPositionen[i].cTyp = POSTYP_GEW);
    end;
 
    //Vorgang Kalkulieren und Speichern
    //Die Kalkulation führt die Neu-Nummerierung durch!
    oVG.KalkAll();
    oVG.SaveRecord(oVG.cSysUID); //eigene System-UID des Vorgangs hier mitgeben, da sonst eine Kopie des Vorgangs erstellt wird!
    MyFreeAndNil(oVG);
end;
 
//------------------------------------------------------------------------------
// Start-Funktion für OBS-Makros
Procedure StartProc();
begin
    //Hier die Funktion zur Neunummerierung der Positionen eines Vorgangs pro Vorgang mit Vorgangsnummer aufrufen.
    //Bei Bedarf kann hier auch mit Schleife und sogar SQL-Query gearbeitet werden.
    PosNeuNum('2400001' , 'TTPPP'              ,  1);
    PosNeuNum('2400002' , 'TPPPP'              , 10);
    PosNeuNum('2400003' , 'PPP'                ,  1);
    PosNeuNum('2400004' , Upper(Pmode_Var(455)),  1);
end;
 
</source>

Aktuelle Version vom 25. Juni 2024, 14:06 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;

procedure Erkennung();
var nPos      : integer;
    cEKRechNr : String;
    cEKLiefNr : String;
    cEKNr     : String;
    cZeile    : String;
begin
    OCR_Text := Upper(OCR_Text);

    //DebugLine('Check Amazon Dokument '+OCR_Nr);  

    if (InStr('VERKAUFT VON AMAZON',OCR_Text)) then begin
    
       DebugLine('Verkauft von Amazon');  
    
        if (InStr('RECHNUNGSNUMMER ',OCR_Text)) then begin
        
            nPos := Pos('RECHNUNGSNUMMER ',OCR_Text);
            
            if (nPos > 0) then begin
            
                cZeile    := Substr(OCR_Text,nPos,100);
                cZeile    := StrTran(cZeile,CRLF,' ');
                cEKRechNr := Token(cZeile,' ',2);
                
                DebugLine('Rechnungsnummer '+cEKRechNr);  
                
                if (not Empty(cEKRechNr)) then begin
                
                    cEKNr := DB_ReadSqlValue(oDB, 'EINKAUF',  'a_nr', 'a_aufnrku='+DB_SqlVal(cEKRechNr)); 
                      
                    if (not Empty(cEKNr)) then begin
                    
                        if (not Empty(cEKNr)) then begin
                            OCR_RefNr  := cEKRechNr;
                            OCR_RefTyp := DMS_TYP_EINKAUF;
                            OCR_Titel  := 'Amazon Einkauf';
                            OCR_PsNr   := '700969';
                            //Automatische Zuweisung über simulierte EAN
                            DMS_EAN_21(oDB,'OBS' + OCR_RefTyp + cEKNr,OCR_Nr);
                            DebugLine('Einkauf '+cEKLiefNr);  
                        end;
                        
                    end else begin
                    
                        cEKLiefNr := DB_ReadSqlValue(oDB, 'EINKLIEF', 'a_nr', 'a_aufnrku='+DB_SqlVal(cEKRechNr));   
                            
                        if (not Empty(cEKLiefNr)) then begin
                            OCR_RefNr  := cEKRechNr;
                            OCR_RefTyp := DMS_TYP_EINKAUFSLIEFERSCHEIN;
                            OCR_Titel  := 'Amazon Einkaufslieferschein';
                            OCR_PsNr   := '700969';
                            
                            //Automatische Zuweisung über simulierte EAN
                            DMS_EAN_21(oDB,'OBS' + OCR_RefTyp + cEKNr,OCR_Nr);
                            DebugLine('Einkaufslieferschein '+cEKLiefNr);  
                        end;
                    end;
                end;    
            end;
        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;

E-Mail Maske Platzhalter

Function GetAnsprechPartner(    cVonAdr    : String; 
                            var cAPName    : String;
                            var cAPVorname : String;
                            var cAPAnrede    : String ):Boolean;
var cSQL        : String;
    FrmGauge    : TFrmGauge;
    qSQL        : TqSQL;
    qPers       : TxFQuery;
begin
   Result     := False;
   cAPName    := '';
   cAPVorname := '';
   cAPAnrede  := '';
   
   if (not(empty(cVonAdr))) then begin
       cSQL := 'SELECT * FROM ' +
               //PERSSTA
               '   (SELECT ps_nr, ps_mailzuord, "" AS ap_anrede, "" AS ap_email, "" AS ap_name, "" AS ap_vorname' +
               '   FROM PERSSTA' +
               '   WHERE TRIM(ps_email) = ' + DB_SqlVal(cVonAdr, 'C') +
               '   UNION '  +
               //ANSP
               '   SELECT ps_nr, ps_mailzuord AS ps_mailzuord,  ap_anrede, ap_email, ap_name, ap_vorname' +
               '   FROM ANSP' +
               '   LEFT JOIN PERSSTA ON ANSP.ap_pnr = PERSSTA.ps_nr' +
               '   WHERE TRIM(ap_email) = ' + DB_SqlVal(cVonAdr, 'C') +
               '   ) a' +
               ' GROUP BY ps_nr' +
               ' ORDER BY ps_mailzuord DESC, ps_nr' +
               ' LIMIT 1';
       
       if (DB_SOpen(oDB, cSQL, qPers)) then begin
           cAPName    := qPers.A2C('ap_name');
           cAPVorname := qPers.A2C('ap_vorname');
           cAPAnrede  := DB_ReadSQLValue(oDB,'s_anred','ar_brief','ar_nr = ' + DB_SQLVal(qPers.A2C('ap_anrede'),'C'));
           Result := True;
       end;
   end;
end;

procedure ReplaceRTFKuerzel(oRich      : TTextRichEdit;
                            cKuerzel   : String;
                            cErsetzung : String);
var oFrmEdit   : TFrmEdit;
    cAn        : String; 
    oAn        : TStringEdit;
    cAPName    : String;
    cAPVorname : String;
    cAPAnrede    : String;
begin
    oFrmEdit := TFrmEdit(Screen.ActiveForm);
    
    if (Assigned(oFrmEdit)) then begin
    
        If (Upper(oFrmEdit.Classname) = 'TFRMEDITEMAIL') and 
            oFrmEdit.lEditMode                           then begin    
            
            oAn := TStringEdit(oFrmEdit.FindComponent('stred_db_e_an'));
           
            if (Assigned(oAn)) then begin
            
                cAn := AllTrim(Token(Alltrim(oAn.Text), ',', 1));
               
                if (GetAnsprechPartner(cAn, cAPName, cAPVorname, cAPAnrede))  then begin
                    
                    ReplaceRTFAll(oRich,
                                  '#ANREDE',
                                  cAPAnrede);
                                 
                    ReplaceRTFAll(oRich,
                                  '#VORNAME',
                                  cAPVorname);
                                 
                    ReplaceRTFAll(oRich,
                                  '#NACHNAME',
                                  cAPName);
                                  
                    ReplaceRTFAll(oRich,
                                  '#NAME',
                                  cAPName);                                                                  
                end;
            end;               
        end;  
    end;
end;

Vorgänge

Positionen von Verkaufsvorgängen neu nummerieren

// Neunummerierung aller Positionen eines Vorgangs am Beispiel Angebot (TAngebot)
// Geht auch mit anderen VK-Vorgängen.
// Bei Bedarf daher TAngebot mit dem benötigten Typ ersetzen
// Auftrag      -> TAuftrag
// Lieferschein -> TLieferschein
// Rechnung     -> TRechnung
//
// Format der Vorgangsnummer und Intervall für Positionnummern sind in diesem 
// Beispiel als Funktionsparameter enthalten. Sie können auch auf die Parameter
// verzichten und tragen die gewünschten Werte direkt in der Funktion PosNeuNum
// statt der Variablen in die Wertezuweisungen ein.
//------------------------------------------------------------------------------

// Funktion zur Neunummerierung der Positionen eines Vorgang
procedure PosNeuNum(const cNr: string; const cPosNrFormat: string; const nPosNrIntervall: integer);
var oVG : TAngebot;
    i   : integer;
begin
    //bestimmtes Angebot mit Positionen aus Datenbank auslesen
    //Parameter 1: Datenbankverbindung; Hier kann "oDB" verwendet werden, 
    //             welches in allen OBS-Makros standardmäßig zur Verfügung steht.
    //Parameter 2: Vorgangsnummer
    //Parameter 3: Positionen auslesen Ja oder Nein (Boolean True/False)
    oVG := TAngebot.Read(oDB, cNr, True);

    //Bei Bedarf hier Nummerierungsmaske setzen
    //G = Gewerk
    //T = Titel
    //P = Position
    //Beispiel: 'TTPPP'
    //Falls auf Default aus PMode gestellt werden soll hier den Wert aus PMode 455 auslesen.
    //Alternativ kann eine Maske auch direkt als String vorgegeben werden.
    //Es ist aber darauf zu achten, dass Großbuchstaben verwendet werden!
    oVG.cPosFormat := cPosNrFormat;

    //Nummerierungsintervall für Positionen setzen
    //Standardwert ist 1
    //Bei einem Wert kleiner 1 wird automatisch 1 verwendet
    oVG.nPosInc    := nPosNrIntervall;

    //Positionen durchlaufen
    for i := 1 to oVG.PnPosCnt do begin
        //Neunummerierung für Position aktivieren
        //Nur für Postionen vom Typ Artikel- oder Leistungsposition, Titel oder Gewerk
        oVG.PaPositionen[i].lNeuNum := (oVG.PaPositionen[i].cTyp = POSTYP_POS) or
                                       (oVG.PaPositionen[i].cTyp = POSTYP_TIT) or
                                       (oVG.PaPositionen[i].cTyp = POSTYP_GEW);
    end;

    //Vorgang Kalkulieren und Speichern
    //Die Kalkulation führt die Neu-Nummerierung durch!
    oVG.KalkAll();
    oVG.SaveRecord(oVG.cSysUID); //eigene System-UID des Vorgangs hier mitgeben, da sonst eine Kopie des Vorgangs erstellt wird!
    MyFreeAndNil(oVG);
end;

//------------------------------------------------------------------------------
// Start-Funktion für OBS-Makros
Procedure StartProc();
begin
    //Hier die Funktion zur Neunummerierung der Positionen eines Vorgangs pro Vorgang mit Vorgangsnummer aufrufen.
    //Bei Bedarf kann hier auch mit Schleife und sogar SQL-Query gearbeitet werden.
    PosNeuNum('2400001' , 'TTPPP'              ,  1);
    PosNeuNum('2400002' , 'TPPPP'              , 10);
    PosNeuNum('2400003' , 'PPP'                ,  1);
    PosNeuNum('2400004' , Upper(Pmode_Var(455)),  1);
end;
Abgerufen von „http:///index.php?title=OBS/Makros_und_Scripting/Anwendungsbereiche/Beispiele_Sammlung&oldid=63061“