OBS/Makros und Scripting/Anwendungsbereiche/Beispiele Sammlung: Unterschied zwischen den Versionen
Zur Navigation springen
Zur Suche springen
Nimz (Diskussion | Beiträge) |
|||
Zeile 525: | Zeile 525: | ||
end; | end; | ||
end; | end; | ||
</source> | |||
=Vorgänge= | |||
==Positionen von Verkaufsvorgängen neu nummerieren== | |||
:<source lang="delphi"> | |||
//Neunummerierung aller Positionen eines Vorgangs am Beispiel Angebot | |||
//Geht auch mit anderen VK-Vorgängen. Bei Bedarf daher TAngebot mit dem benötigten Typ ersetzen | |||
//Auftrag -> TAuftrag | |||
//Lieferschein -> TLieferschein | |||
//Rechnung -> TRechnung | |||
procedure NeuNumAngebot(const cNr: string; const cPosNrFormat: string; const nPosNrIntervall: integer); | |||
var oAN : 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) | |||
oAN := 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! | |||
oAN.cPosFormat := cPosNrFormat; | |||
//Nummerierungsintervall für Positionen setzen | |||
//Standardwert ist 1 | |||
//Bei einem Wert kleiner 1 wird automatisch 1 verwendet | |||
oAN.nPosInc := nPosNrIntervall; | |||
//Positionen durchlaufen | |||
for i := 1 to oAN.PnPosCnt do begin | |||
//Neunummerierung für Position aktivieren | |||
//Nur für Postionen vom Typ Artikel- oder Leistungsposition, Titel oder Gewerk | |||
oAN.PaPositionen[i].lNeuNum := (oAN.PaPositionen[i].cTyp = POSTYP_POS) or | |||
(oAN.PaPositionen[i].cTyp = POSTYP_TIT) or | |||
(oAN.PaPositionen[i].cTyp = POSTYP_GEW); | |||
end; | |||
//Vorgang Kalkulieren und Speichern | |||
//Die Kalkulation führt die Neu-Nummerierung durch! | |||
oAN.KalkAll(); | |||
oAN.SaveRecord(oAN.cSysUID); //eigene System-UID des Vorgangs hier mitgeben, da sonst eine Kopie des Vorgangs erstellt wird! | |||
MyFreeAndNil(oAN); | |||
end; | |||
//------------------------------------------------------------------------------ | |||
Procedure StartProc(); | |||
begin | |||
NeuNumAngebot('2400001' , 'TTPPP' , 1); | |||
NeuNumAngebot('2400002' , 'TPPPP' , 10); | |||
NeuNumAngebot('2400003' , 'PPP' , 1); | |||
NeuNumAngebot('2400004' , Upper(Pmode_Var(455)), 1); | |||
end; | |||
</source> | </source> |
Version vom 25. Juni 2024, 13:50 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 //Geht auch mit anderen VK-Vorgängen. Bei Bedarf daher TAngebot mit dem benötigten Typ ersetzen //Auftrag -> TAuftrag //Lieferschein -> TLieferschein //Rechnung -> TRechnung procedure NeuNumAngebot(const cNr: string; const cPosNrFormat: string; const nPosNrIntervall: integer); var oAN : 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) oAN := 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! oAN.cPosFormat := cPosNrFormat; //Nummerierungsintervall für Positionen setzen //Standardwert ist 1 //Bei einem Wert kleiner 1 wird automatisch 1 verwendet oAN.nPosInc := nPosNrIntervall; //Positionen durchlaufen for i := 1 to oAN.PnPosCnt do begin //Neunummerierung für Position aktivieren //Nur für Postionen vom Typ Artikel- oder Leistungsposition, Titel oder Gewerk oAN.PaPositionen[i].lNeuNum := (oAN.PaPositionen[i].cTyp = POSTYP_POS) or (oAN.PaPositionen[i].cTyp = POSTYP_TIT) or (oAN.PaPositionen[i].cTyp = POSTYP_GEW); end; //Vorgang Kalkulieren und Speichern //Die Kalkulation führt die Neu-Nummerierung durch! oAN.KalkAll(); oAN.SaveRecord(oAN.cSysUID); //eigene System-UID des Vorgangs hier mitgeben, da sonst eine Kopie des Vorgangs erstellt wird! MyFreeAndNil(oAN); end; //------------------------------------------------------------------------------ Procedure StartProc(); begin NeuNumAngebot('2400001' , 'TTPPP' , 1); NeuNumAngebot('2400002' , 'TPPPP' , 10); NeuNumAngebot('2400003' , 'PPP' , 1); NeuNumAngebot('2400004' , Upper(Pmode_Var(455)), 1); end;