OBS/Makros und Scripting/Anwendungsbereiche/Beispiele Sammlung
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;
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;