|
|
Kontakt :: Impressum |
TurboDB Studio Tipps
20.03.2011 :: Autor: Robert W.B. Linn :: http://www.rwblinn.deTurboDB Studio Tipps zusammengestellt von Robert W.B. Linn. Der Autor übernimmt keine Haftung für den Inhalt. |
ToDo-Liste Stand: 20-03-2011 • TurboPL * FileNr weitere Beispiele • Updates aus dataWeb Foren • TurboDB VCL für Delphi Beispiele und Verweise • Alte VDP Einträge entfernen |
Kurzanleitung ============= 1.Compound File Viewer aufrufen 2.Tabellen mit dem Compound File Viewer aus dem SingleFile extrahieren 3.Neues Projekt anlegen 4.Datenbankverzeichnis hinzufügen 5.Formulare, Module, Berichte, etc hinzufügen Ausführlich ============= 1.Neuen Ordner anlegen, in den die Tabellendateien hinein kopiert werden sollen, 2.Compound File Viewer aus den Windows-Startmenü aufrufen (Programmgruppe "TurboDB Studio") 3.Die *.tdbd-Datei (SingleFile Datenbank) des Projektes öffnen, 4.In der Buttonleiste den rechten Button "Extract Directory" klicken und den eingangs angelegten Ordner (oder den Projektordner) wählen, 5.Den Compound File Viewer beenden. Nachdem die Tabellen aus dem SingleFile extrahiert wurden, dann a/ mit TurboDB Studio ein neues Projekt anlegen und dabei die unterste Option "Datenbank auswählen" aktivieren. b/ das Projektverzeichnis wählen und alle übrigen Dateien zum Projekt hinzufügen |
Die Anwendung liegt auf einem Server und die PROJEKT.EXE wird direkt von dort gestartet. Negativ auf die Startgeschwindigkeit: (-) Ein sehr großes Logo (-) Die Anzahl von Elementen in Formularen hat einen Einfluss darauf wie schnell das Formular geöffnet wird und wie sich damit arbeiten lässt. (=) Solange so ein Formular mir sehr vielen Feldern nicht gleich beim Start automatisch geöffnet wird, hat das keinen Einfluss. (=) Die Anzahl der Tabellen sollte keinen Einfluss haben. Analyse zur Startgeschwindigkeit • Startet die Anwendung auf dem betreffenden Rechner auch langsam wenn sie komplett lokal gestartet wird? • Starten andere, auf gleiche Weise übers Netzwerk gestartete Programme aus dem betreffenden Rechner auch langsamer als gewohnt? • Kommentieren Sie alle 'OnOpenProject' in Ihrem Code aus. Starten Sie die Anwendung, schliessen Sie alle Fenster und dann die Anwendung. Wenn Sie jetzt die Anwendung wieder starten, sollte beim Start weder ein Formular geöffnet noch ein Makro ausgeführt werden. Startet das Programm jetzt in der erwarteten Zeit, kann die Problemsuche auf sich auf Programmcode konzentrieren: Nacheinander alle auskommentierten Prozeduren wieder einkommentieren und dabei das Programm einmal beenden und neu starten. Ist der Programmstart immer noch zu langsam, sollten sich die Problemsuche auf Windows und dessen Netzwerkeinstellungen konzentrieren: • Besteht an dem Rechner schon eine Verbindung zum Server? • Ist der Rechner ordnungsgemäß in die Domäne eingebunden? • Ist der angemeldete Benutzer ein Mitglied der Domäne? • Wie sieht es mit der Netzwerkauslastung aus? |
TurboDB Studio Anwendungen als "portable Anwendungen" einsetzen, d.h. zum Beispiel direkt von einem USB-Stick startbar. Frage Wenn das Programm auf einem fremden PC gestartet wird, wird dann irgendwo auf der Festplatte etwas abgespeichert oder ein Eintrag in die Registry gemacht? Antwort Es wird nichts auf die Festplatte oder in die Registry geschrieben. Frage Was ist mit der CFG-Datei. Die befindet sich normalerweise nicht im Projekt-Verzeichnis sondern in einem Unterverzeichnis von "Dokumente und Einstellungen". Wenn das Projekt-Verzeichnis auf einem Stick abgespeichert wird, fehlt diese. Wird die CFG-Datei dann am Zielrechner neu erzeugt? Antwort: Die CFG und die INI der Anwendung werden neu angelegt. Somit können mit TurboDB Studio Datenbankanwendungen auf einem USB-Stick ausgeliefert werden oder in ein beliebiges Verzeichnis kopieren werden. Es sind keine Einträge in der Registry und keine weitere Installation nötig. |
Um das "eigene Verzeichnis" ermitteln zu können, wird eine DLLProc verwendet.
dllproc SHGetSpecialFolderPathW(owner: Integer; var path: String; csidl:
Integer; create: Integer): Integer Library 'shell32.dll';
Const CSIDL_PERSONAL = 5;
Procedure ZeigeEigeneDateienVerzeichnis;
Var CCRLF = Chr(13) + Chr(10);
Var CHDG = "TurboDb Studio Eigene Dateien Verzeichnis";
Var CINF = "Das TurboDB Studio Eigene Dateien Verzeichnis:";
Var CERR1 = "Fehler:";
Var CERR2 = "Das Eigene Dateien Verzeichnis konnte nicht ermittelt werden.";
Vardef sPath: string;
..#Pfad initialisieren
sPath := NTimes(' ', 1024);
..#DLLProc aufrufen
If SHGetSpecialFolderPathW(0, sPath, CSIDL_PERSONAL, 0) <> 0
Message(CINF + sPath);
Else
Message(CERR1 + CCRLF + CERR2, CHDG);
End;
Endproc;
|
procedure Übersicht_Systemsvariable; Var CCRLF = Chr(13) + Chr(10); Var sMsg = ""; sMsg := sMsg + "$heute: " + $heute+ CCRLF; sMsg := sMsg + "$jetzt: " + $jetzt+ CCRLF; sMsg := sMsg + "" + CCRLF; sMsg := sMsg + "$TDB-Pfad (Programmverzeichnis TS Bin Dateien): " + $TDB-Pfad + CCRLF; sMsg := sMsg + "$T-Eingabe (Globale Variable für Input): " + $T-Eingabe + CCRLF; sMsg := sMsg + "" + CCRLF; sMsg := sMsg + "$Seite (nur Datenbankjob): " + Str($Seite) + CCRLF; sMsg := sMsg + "$Zeile (nur Datenbankjob): " + Str($Zeile) + CCRLF; sMsg := sMsg + "G_alt (nur Datenbankjob): wird bei Gruppenwechsel (Steuerbefehl .GP) verwendet" + CCRLF; sMsg := sMsg + "G_neu (nur Datenbankjob): wird bei Gruppenwechsel (Steuerbefehl .GP) verwendet" + CCRLF; sMsg := sMsg + "" + CCRLF; sMsg := sMsg + "$Fehler: " + "nicht mehr verwenden, dafür Error" + CCRLF; sMsg := sMsg + "Error.Nummer: " + Str(Error.Nummer)+ CCRLF; sMsg := sMsg + "Error.Meldung: " + Error.Message+ CCRLF; sMsg := sMsg + "Error.Beschreibung: " + Error.Description+ CCRLF; Message(sMsg, "Übersicht der Systemvariablen - WICHTIG: Groß/Kleinschreibung beachten", 1); endproc; |
Wie kann mit der Unterscheidung von Null und Leer geprüft werden,
ob eine Null eingetragen ist oder noch keine Eintragung erfolgt ist.
Lösungen:
1) Tabellensicht mittels Suchen mit Bedingung GetField(...) = "".
GetField liefert einen Leerstring oder "0" zurück.
2) Index auf das Integer Feld definieren.
Dann in der Tabellensicht Suchen, Integer Feld aufrufen.
Eingabefeld leer lassen.
Es wird der erste Eintrag angezeigt. Mittels F3 zum Nächsten usw...
3) Als Makro
MoveBegin($TESTTAB);
While ReadNext($TESTTAB)
If GetField($TESTTAB, LabelNo($TESTTAB, "Testinteger")) = ""
Message("Feld " + $TESTTAB.Teststring + " hat kein Wert");
End;
End;
|
procedure WindowsFehlerCode(nCode : Integer) : String;
..#windows fehlercode mittels "net helpmsg" ermitteln
..#ablauf:
..#net help msg mit fehlercode als parameter aufrufen.
..#ergebnis in eine datei speichern
..#datei auslesen und text als string zurueckgeben
..#test mittels:
..# Message( WindowsFehlerCode(151));
..##
Var CWINCODEFILE = BaseDir + "wincode.txt"; .. oder "%TEMP%:\Test.txt"
Var CERR1 = "Fehlercode konnte nicht ermittelt werden.";
Vardef nRT : Integer; ..#rueckgabe code
Vardef nFH : Integer; ..#filehandle
Vardef sStr : String; ..#hilfstring
Vardef sCode : String; ..#fehlercode text
sStr := GetEnv('Comspec') + ' /C net helpmsg ' + Str(nCode) + ' > ' + CWINCODEFILE;
nRT := Execute(sStr, 1, -1);
If nRT <> 0
Return CERR1
End;
nFH := Reset(CWINCODEFILE);
If nFH = 0
Return CERR1
End;
While NOT EOT(nFH)
sStr := ReadLn(nFH);
If sStr <> ""
sCode := sCode + sStr;
End;
End;
Close(nFH);
..#und die datei wieder löschen
DelFile(CWINCODEFILE);
..#und den code wiedergeben
sCode := sCode + " (" + Str(nCode) + ")";
..#nicht vergessen code umwandlung
sCode := OEMToAnsi(sCode);
Return sCode;
endproc;
|
Die Datei LOGO.BMP im Programmverzeichnis durch eine eigene LOGO.BMP ersetzen. |
Der Standardtext erscheint erst nach Aufruf der kompilierten Anwendung. |
Menüpunkte und easy-Funktionen NUR VDP Für die meisten Menüpunkte gibt es entsprechende easy-Funktionen. Probleme gibt es bei den Menüpunkten: Bearbeiten|Einfügen Der Inhalt der Zwischenablage läßt sich mit Clip2Text auslesen. Ansicht|Alle Datensätze Mit Sortierung oder SetSortOder Menüpunkte in der generierte EXE-Datei NUR VDP Es können mehr als 10 Menüpunkte angelegt werden, allerdings werden diese abhängig vom verfügbaren Speicher aufgebaut. Der verfügbare Speicher ist wiederum abhängig von a/ Anzahl der Prozeduren in dem Modul woraus die Menüpunkte aufgebaut werden und b/ von der Länge der Prozedurnamen. Fazit: Prozeduren die nicht in Menüpunkte verwendet werden mit einem dummy Parameter versehen (Procedur myProc(nB : Real) und Prozedurnamen so kurz (aber noch verständlich) halten. Werden neue Prozeduren erstellt und danach die Menüstruktur im Formular angepasst, kann es sein, daß abhängig vom verfügbaren Speicher, Prozeduren "wegfallen" ohne einen Hinweis dass der Speicher nicht mehr ausreicht. Der Menüpunkt ist aber noch da, allerdings ohne Funktion. also vorsicht! |
Folgende Dateien bei Anwendungsupdates aktualisieren Formulare: Alle Formulare aktualisieren. Module: Bei TurboDB Studio werden alle Module und Jobs in eine Datei übersetzt. Die PRG-Datei aktualisieren. Berichte: Alle Berichte aktualisieren. Projekt geändert (Elemente hinzugefügt, gelöscht, umbenannt): Projektdatei aktualisieren. |
Aufrufe von TurboPL-Funktionen müssen (pro Aufruf) in eckigen Klammern [] gesetzt werden, sonst werden die intenen Funktionen der Bericht-Komponente benutzt: [Str( [SUM( [TESTTAB.Wert] )] , 1, 2)] |
Encode und Decode RGB ===================== Procedure EncodeRGBA(R, G, B, Alpha: integer): Integer; Return BitAnd(R, 255) + BitShl(BitAnd(G, 255), 8) + BitShl(BitAnd(B, 255), 16) + BitShl(BitAnd(Alpha, 255), 24); Endproc Procedure DecodeRGBA(Color: Integer; Var R, G, B, Alpha: Integer); R := BitAnd(Color, 255); G := BitAnd(BitShr(Color, 8), 255); B := BitAnd(BitShr(Color, 16), 255); Alpha := BitAnd(BitShr(Color, 24), 255); Endproc |
Ein Datenbankob ist nur in der Lage Bilder aus Tabellenfeldern auszugeben.
Dazu ein Blob-Feld zB. innerhalb einer Systemtabelle (SYSTEM) hinzufügen und
dieses Feld mit dem Bild belegen.
Procedure ImportGrafik;
..#importiert eine grafikdatei in einem systemfeld vom typ blob
..#die systemtabelle hat nur 1 datensatz.
..#diese muss vorhanden sein, befor diese prozedur ausgeführt wird.
T-Eingabe := "";
If ChoosePicture("Wählen Sie eine Grafikdatei aus", 127)
ModifyRec(SYSTEM);
EmbedBlob(SYSTEM.MeinBild, T-Eingabe);
PostRec(SYSTEM);
End;
Endproc;
Alternativ:
Erstellen eines Berichtes und ein Berichtfeld verwenden.
|
Externe Bilddatei an einem Image zuweisen.
Vardef sFileName : String; ..externe bilddatei
Vardef imgBild: Image; ..das bild
If ChooseFile('Bild laden...', 'Alle Dateien|*.*|JPG-Grafikdateien|*.jpg|JPEG-Grafikdateien|*.jpeg|Bitmap-Grafikdateien|*.bmp|PNG-Grafikdateien|*.png|GIF-Grafikdateien|*.gif|', sFileName)
imgBild := FindControl("Bildbetrachter") as Image;
imgBild.FileName := sFileName;
End;
|
procedure btnBlobKopierenBeimAnklicken;
..#kopiert inhalt eines blob feldes in ein andere blobfeld
..#idf: von feld blob1 zum feld blob2 der tabelle testblob
..##
Var CHDG = "Blob kopieren";
Var sTempFile = BaseDir + "\tempblob.bmp";
Vardef nRNo : Integer;
Vardef nRT : Integer;
If FileSize($TESTBLOB) = 0
Message("Fehler: Datensatz ist nicht vorhanden!", CHDG);
Return
End;
Try
nRNo := ReadRec($TESTBLOB, RecNo($TESTBLOB))
Except
Message(Error.Message, CHDG);
Return
End;
..#
If nRNo = 0
Message("Fehler: Datensatz kann nicht gelesen werden!", CHDG);
Return
End;
..#Blob1 in eine Datei kopieren
..#vorher erst die tempdatei löschen (falls vorhanden)
DelFile(sTempFile);
..#blob kopieren
nRT := CopyBlob($TESTBLOB.blob1, sTempFile);
If nRT <> 0
Message("Fehler: Temporäre Blobdatei kann nicht erstellt werden!", CHDG);
Return
End;
..#so kann auch geprüft werden ob die tempdate da ist
If Not IsFile(sTempFile)
Message("Fehler: Temporäre Blobdatei kann nicht erstellt werden!", CHDG);
Return
End;
..#blob jetzt aus der tempdatei in das zweite blobfeld laden
Try
ReadRec($TESTBLOB, nRNo);
EmbedBlob($TESTBLOB.blob2, sTempFile);
WriteRec($TESTBLOB, nRNo);
Except
Message(Error.Message, CHDG);
Return
End;
..#temp datei löschen
DelFile(sTempFile);
..#ansicht aktualisieren
Refresh;
..#und meldung Ok ausgeben
Message("Blob erfogreich kopiert!", CHDG);
endproc;
|
..#blob in eine datei speichern CopyBlob($TABELLE1.Blobfeld, Dateiname); ..#blob aus der datei in die andere tabelle einlesen EmbedBlob($TABELLE2.Blobfeld, Dateiname); ..#datei löschen DelFile(Dateiname); ..#anzeige im formular aktualisieren Refresh; |
Procedure btnTextBlobVerzeichnisEinlesenBeimAnklicken;
..##
Var CHDG = "Grafiken einlesen";
Vardef nRT : Integer; ..#return code operationen
Vardef nCnt : Integer; ..#return code operationen
Vardef sFolder : String;..#folder welches gelesen werden soll
Vardef FName, FAttributes, FFolder: string;
Vardef FSize: Integer;
Vardef FDate: Date;
Vardef FTime: Time;
..#init
nCnt := 0;
sFolder := BaseDir;
ClearDat($TESTBLOB);
..#verzeichnis wählen
nRT := ChooseFolder("Verzeichnis wählen", sFolder);
If nRT = 0
Message("Abbruch durch den Benutzer.", CHDG);
Return
End;
nRT := FindFirstFile(sFolder + "\*.*", "DHS", FName, FSize, FDate, FTime, FAttributes, FFolder);
While nRT = 0
If Pos(".jpg", Lower(FName)) > 0 Or Pos(".bmp", Lower(FName)) > 0
Try
ShowWait("Erstelle... " + Lower(sFolder + FName));
NewRec($TESTBLOB);
$TESTBLOB.blobname := Lower(sFolder + FName);
EmbedBlob($TESTBLOB.blobinhalt, sFolder + FName);
PostRec($TESTBLOB);
nCnt := nCnt + 1;
Except
Message(Error.Message, "Fehler - " + CHDG);
End;
End;
nRT := FindNextFile(FName, FSize, FDate, FTime, FAttributes, FFolder);
End;
CloseFindFile;
Hidewait;
Message(Str(nCnt) + " Grafiken aus dem Verzeichnis " + sFolder + " eingelesen." , "Info - " + CHDG);
EndProc;
|
..#Rahmen mit Text zentriert .HL $(VL "Mein Text zentriert in einem Rahmen" C_Form ToMargin VL) .HL .EVL |
Für TurboDB Studio Version 4: Die aktuelle Job-Engine und die Datenbank-Engine unterstützen dieses Feature nicht. Folgende Möglichkeiten zur Nachbildung: Möglichkeit 1: Definition einen neuen Index mit absteigender statt aufsteigender bzw. aufsteigender statt absteigender Reihenfolge und diese als Sortierung angeben. Das hat auch den positiven Nebeneffekt, daß Sie diese Sortierungen auch in Formularen nutzen können. Möglichkeit 2: Eine andere Möglichkeit wäre das Kommando "SortBy", mit dem eine Sortierung definieren können, bspw. .SortBy Name, Vorname um nach Name/Vorname in aufsteigender Reichenfolge zu sortieren oder .SortBy -Name, -Vorname um nach Name/Vorname in absteigender Reichenfolge zu sortieren. Dieses Kommando legt einen temporären Index an, der wieder gelöscht wird sobald das Projekt geschlossen wird. Die bessere Möglichkeit ist die Erste (solange die Anzahl von maximal 15 Indexen pro Tabelle nicht überschreiten), denn bei größeren Tabellen kann das Erzeugen eines (temporären) Index schon mal dauern - und das würde jedes mal erfolgen. |
Bei der Ausgabe muss die Bildbreite angegeben werden. Beispiel: $(MeinBild:50) |
..#G R U P P E .GP 1 ..#gruppenkopf ausgeben .GroupHeader $TABELLE.Titel $(@a10b "") .If G_Neu = "" $(@a10b "<Kein Thema>") .Else $(@a10b G_Neu) .End $(@a8n $TABELLE.Beschreibung) .HL ..die linien verwischen nach seitenumbruch. hier einen trick das zu beheben .If $SYSTEM.DruckenNotizenGruppiertMitCR = JA $(@a8n /) .End ..#gruppenfuß ausgeben. ..#eignet sich sehr gut für seitenumbruch nach gruppenwechsel .GroupFooter .If $SYSTEM.DruckenNotizenGruppiertMitCR = JA .PA |
Message(GetCompleteObjectName(Project.adressen.Adressenliste));
liefert
ADRESSEN.Adressenliste
Mittels Run könnte diesen Datenbankjob ausgeführt werden:
Run(GetCompleteObjectName(Project.adressen.Adressenliste));
In den Projekteigenschaften wurde diese Datenbankjob wie folgt definiert:
Tabelle: ADRESSEN
Pfad: D:\Daten\tdbstudio\projekte\ropav\ber\ADRESSEN-Bericht.ber
Titel: Adressenliste
Beispiel als Prozedur:
procedure Adressenliste_Drucken
vardef sJob : String;
sJob := GetCompleteObjectName(Project.ADRESSEN.Adressenliste));
If sJob <> ""
Drucken(sjobName);
Else
Message("Fehler: Jobname konnte nicht ermittelt werden!");
End;
Endproc
|
Voreinstellung In OnOpenProject mit SetNumberFormats als Dezimaltrennzeichen den Punkt eingestellen. Ausgabe im datenbankjob: SetNumberFormats bezieht sich auf die Funktion "Str". Das ist die einzige Möglichkeit, wie den Dezimalpunkt in DruckJobs beeinflussen werden kann: $(Str(Tabelle.FloatFeld, 1, 2, "", "", ".")) |
In nachfolgenden Programmfragment erscheint die Fehlermeldung: "Illegale Indexdefinition" Beispiel Anhand Datenbankjob .Sub Topic.Titel $(TOPICS.tTitel) .Do GotoXY(SYSTEM.sPrnPO...) .Endsub Titel Die Fehlerursache ist die Verwendung der Angabe SYSTEM.sPrnPO. Die Angabe der SYSTEM-Tabelle. Abhilfe .Var nTmp = $SYSTEM.sPrnPO .Sub Topic.Titel $(TOPICS.tTitel) .Do GotoXY(nTmp, ...) |
..#Fonts definieren .FONT a6n = Arial, 6, n .FONT a6b = Arial, 6, b .FONT a8b = Arial, 8, b .FONT a8i = Arial, 8, i .FONT a8n = Arial, 8, n .FONT a10n = Arial, 10, n .FONT a10i = Arial, 10, i .FONT a10b = Arial, 10, b .FONT a10u = Arial, 10, u .FONT a10bi = Arial, 10, bi .FONT a10bu = Arial, 10, bu .FONT a10ui = Arial, 10, ui .FONT a12n = Arial, 12, n .FONT a12b = Arial, 12, b .FONT a12i = Arial, 10, i .FONT a14n = Arial, 14, n .FONT a16b = Arial, 16, b .FONT a20b = Arial, 20, b .FONT a24b = Arial, 24, b ..#Beispiel Aufrufe $(@a8n "TurboPL Zusatzreferenz") $(@a12b "Makro Übersicht" C_Form ToMargin) |
..#Fonts .FONT a6n = Arial, 6, n .FONT a6b = Arial, 6, b .FONT a8b = Arial, 8, b .FONT a8i = Arial, 8, i .FONT a8n = Arial, 8, n .FONT a10n = Arial, 10, n .FONT a10i = Arial, 10, i .FONT a10b = Arial, 10, b .FONT a10u = Arial, 10, u .FONT a10bi = Arial, 10, bi .FONT a10bu = Arial, 10, bu .FONT a10ui = Arial, 10, ui .FONT a12n = Arial, 12, n .FONT a12b = Arial, 12, b .FONT a12i = Arial, 10, i .FONT a14n = Arial, 14, n .FONT a16b = Arial, 16, b .FONT a20b = Arial, 20, b .FONT a24b = Arial, 24, b |
In eine Fußzeile (Footer) $heute / $today, $jetzt / $Now und $Seite verwenden. ..#Fußzeile .Footer .HL $(@a8n "Ausgegeben am " + DateStr(ToDay) + " um " + TimeStr(Now)) $(@a8n "Seite " + $Seite R_Form ToMargin) |
..#Fußzeile .Footer .HL $(@a8n "Ausgegeben am " + DateStr(ToDay) + " um " + TimeStr(Now)) $(@a8n "Seite " + $Seite R_Form ToMargin) |
.HE 1
.Header
$("Text Links" "Text Rechts" R_Form ToMargin)
.HL
$(VL KOPFZEILE C_Form ToMargin VL)
.HL
.EVL
|
..#Seitenbreite Variabele (pagewidth)
.Var nPW = 0
..#Seitenbreite errechnen
..#volle seitenbreite - rand links - rand rechts
..#Pagewidth (W) - MarginRight(MR) - PageOverall(PO)
.Do nPW := GetPara("PW") - GetPara("MR") - GetPara("PO")
|
Es ist sinnvoll eine Tabelle mit Einstellungen für Ihr Projekt zudefinieren,
z.B. eine Tabelle SYSTEM.
Diese Tabelle kann dann u.a. Einstellungen für Berichte(Reports) enthalten.
Diese Einstellungen können innerhalb eines Datenbankjobs
wie folgt gesetzt werden:
.REPORT
.PROLOG
..#Systemtabelle lesen - enthält nur einen Datensatz
.DO ReadRec(SYSTEM, 1)
..#
..#Werte aus der Systemtabelle mittels SetPara zuweisen
..#PL und PO sind Datenbanlfelder vom Typ Integer
.DO SetPara(".PL"+STR($SYSTEM.PL)+", PO"+STR($SYSTEM.PO))
...
|
Anhand eines Beispiels zur Erstellung eine HTML-Datei
..#
..#HTMLFileCreate
..#
.Procedure HTMLFileCreate(sFile : String; sTitel : string);
..#legt eine html-datei an
.VarDef nFH : Real;
.If nFH :=Rewrite(sFile)
.Do WriteLn(nFH, "<HTML>")
.Do WriteLn(nFH,"<!-- Copyright: " + TABELLE.Copyright + " -->");
.Do WriteLn(nFH,"<!-- Datei: " + sFile + " -->");
.Do WriteLn(nFH,"<!-- Titel: " + ToHTML(sTitel) + " -->");
.Do WriteLn(nFH,"<!-- Datum: " + DateStr(Today)+" "+TimeStr(Now)+" -->");
.Do WriteLn(nFH,"<head>");
.Do WriteLn(nFH, "<meta name='Generator' content='" +
ToHTML(TABELLE.Version) + "'>");
.Do WriteLn(nFH, "<meta name='Author' content='" + ToHTML(TABELLE.Copyright)
+ "'>");
.Do WriteLn(nFH, "<meta name='Description' content='" + ToHTML("") + "'>");
.Do WriteLn(nFH, "<meta name='Keywords' content='" + ToHTML("KEYWORD") +
"'>");
.Do WriteLn(nFH,"");
.Do WriteLn(nFH,"<title>" + ToHTML(sTitel) + "</title>");
.Do WriteLn(nFH,"</head>");
.Do WriteLn(nFH,"<BODY>");
.Do WriteLn(nFH,"<A NAME='top'> </A>");
.Do Close(nFH)
.Else
.Do Message(sFile + " kann nicht erstellt werden.","Fehler",1)
.ST
.End
.Endproc
..
und zur Schliessung eine HTML-Datei
..#
..#HTMLFileClose
..#
.Procedure HTMLFileClose(sFile : String);
.VarDef nFH : Real;
.Do nFH := TAppend(sFile)
.If nFH > 0
.Do WriteLn(nFH, "<br>")
.Do WriteLn(nFH, "<center><font size=-1>Erstellt mittels ANWENDUNG (c) <a
href='mailto:" + TABELLE.EMail +"'> " + ToHTML($TABELLE.Autor) + "</a> " +
DateStr(ToDay) + " " + TimeStr(Now) + "</font></center>");
.Do WriteLn(nFH, "</BODY>")
.Do WriteLn(nFH, "</HTML>")
.Do Close(nFH);
.End
.Endproc
..
|
Wichtig ist die Verwendung von := anstatt =. Es gibt keine Fehlermeldung bei der Verwendung von = und man wundert sich warum kein Wert zugewiesen wurde. Beispiel Datenbankjob .DO nSelektion := $NOTIZEN.Laufende_Nummer |
DO _"Execmacro(MODUL,Prozedur("+STR(real)+"))"
|
..#variable definieren der turbopl code enthält
Var sMsg = "Message('Hallo Welt')";
..#die variable sMsg DO zuweisen und ausführen.
..#Wichtig is der Unterstrich (_) vor DO
DO _sMsg;
..#Angezeigt wird das Meldungsfenster mit als Begrüßung Hallo Welt.
|
Prüfen im Datenbankjob ob Datensätze vorhanden sind.
Wenn keine Datensätze gefunden wurde, dann gebe eine Meldung aus und
Job beenden.
..#
.Epilog
.If Count(TABELLE) = 0
.Do Message("Keine Datensätze vorhanden!", "Hinweis")
.ST
.End
|
Fonts in einem Datenbankjob definieren ..# ..# Fonts ..# .FONT a6n = Arial, 6, n .FONT a6b = Arial, 6, b .FONT a8b = Arial, 8, b .FONT a8i = Arial, 8, i .FONT a8n = Arial, 8, n .FONT a10n = Arial, 10, n .FONT a10i = Arial, 10, i .FONT a10b = Arial, 10, b .FONT a10u = Arial, 10, u .FONT a10bi = Arial, 10, bi .FONT a10bu = Arial, 10, bu .FONT a10ui = Arial, 10, ui .FONT a12n = Arial, 12, n .FONT a12b = Arial, 12, b .FONT a12i = Arial, 10, i .FONT a14n = Arial, 14, n .FONT a16b = Arial, 16, b .FONT a20b = Arial, 20, b .FONT a24b = Arial, 24, b ..# ..# Beispielaufrufe definierte Fonts ..# $(@a8n "TurboPL Zusatzreferenz") $(@a12b "Makro Übersicht" C_Form ToMargin) |
Wert eines Steuerbefehls ermitteln. Siehe [Getpara] |
GroupHeader/Footer soll anstatt. group oder .gruppe verwendet werden um in Datenbankjobs Gruppen aufzubauen. Beispiel ..# ..# G R U P P E ..# .GP 1 ..#gruppenkopf ausgeben .GroupHeader $NOTIZEN.Thema.Thema $(@a10b "") .If G_Neu = "" $(@a10b "<Kein Thema>") .Else $(@a10b G_Neu) .End $(@a8n $NOTIZEN.Thema.Kurzbeschreibung) .HL ..die linien verwischen nach seitenumbruch. hier einen trick das zu beheben .If $SYSTEM.DruckenNotizenGruppiertMitCR = JA $(@a8n /) .End ..#gruppenfuß ausgeben. eignet sich sehr gut für seitenumbruch nach gruppenwechsel .GroupFooter .If $SYSTEM.DruckenNotizenGruppiertMitCR = JA .PA .End |
Punktbefehle die aber währendder Übersetzung schon bearbeitet werden, können mittels SetPara nicht mehr zuverläßig bearbeitet werden. |
.Epilog
..#wenn count 0 liefert, eine meldung ausgeben und job beenden
.If Count(TABELLE.Laufende_Nummer) = 0
.Do Message("Keine Einträge gefunden!", "Hinweis")
.ST
.End
|
.Report .Prolog .PRIMTABLEIS TABELLE .ZUGRIFF TABELLE.ID |
Bei illegalen Punktbefehle wird SetPara nicht ausgeführt. Es gibt keine Fehlermeldung. |
Punktbefehle die aber währendder Übersetzung schon bearbeitet werden, können mittels SetPara nicht mehr zuverläßig bearbeitet werden. |
Steuerbefehle setzen. Siehe [SetPara] |
SetPara(Zeichenkette: String); Parameter in einem Job dynamisch setzen. |
Es ist sinnvoll eine Tabelle mit Einstellungen für Ihr Projekt zudefinieren, z.B. Tabelle SYSTEM.
Diese Tabelle kann dann u.a. Einstellungen für Reports enthalten. DieseEinstellungen können innerhalb eines Datenbankjobs wie folgt gesetzt werden:
.REPORT
.PROLOG
.DO ReadRec(SYSTEM, 1)
.DO SetPara(".PL"+STR(SYSTEM.EL)+", PO"+STR(SYSTEM.ER))
...
|
In nachfolgenden Programmfragment erscheint die Fehlermeldung: "Illegale Indexdefinition" Beispiel Anhand Datenbankjob .Sub Topic.Titel $(TOPICS.tTitel) .Do GotoXY(SYSTEM.sPrnPO...) .Endsub Titel Die Fehlerursache ist die Verwendung der Angabe SYSTEM.sPrnPO. Die SYSTEM-Tabelle stört VDP. Lösung: .Var nTmp = SYSTEM.sPrnPO .Sub Topic.Titel $(TOPICS.tTitel) .Do GotoXY(nTmp, ...) .Endsub Titel |
SUB SUB [Selektion] ..Anweisungen ENDSUB [Indexdefinition] |
Die alte Tabelle in eine temporäre TDB-Tablle exportieren. Dann eine leere Tabelle mit der neuen Datenstruktur in das Projekt kopieren. Schließlich einen Import der temp. TDB-Tabelle durchführen; "Felder nach Name zuweisen" wählen und den Import starten. Dabei bleiben die alten Auto-Nummern erhalten. Dabei nicht vergessen, die Index-Dateien zu sichern (*.CIN !), ebenso die von der exportierten Datei benutzten Relationsdateien (falls Relationsfelder enthalten). NUR für VDP |
Die Anwendung hat ein Hauptformular.
Angekoppelte Datnsätze sollen in eine Druckvorschau gezeigt werden.
Dazu wird ein zweites Formular aufgerufen, welches die Druckvorschau zeigt.
Um dieses zu ermöglichen, muss DataWnd verwendet werden.
Hintergrund:
CloseWnd bezieht sich immer auf das aktive Datenfenster, in diesem Fall
liegt aber das Druckvorschau-Fenster ganz oben.
CloseWnd muss gezielt für das betreffende Datenfenster aufgerufen werden.
Procedure DruckeBericht;
VarDef nRec : Integer;
VarDef wnd : DataWnd;
nRec := RecNr(AUFTRAG);
If nRec > 0
ActivateForm ("AUFTRAG.Auftrag");
wnd := FindDataWnd("AUFTRAG.Auftrag");
Delmarks(AUFTRAG);
SetMark( AUFTRAG,RecNr(AUFTRAG));
Access(AUFTRAG,"Markierung");
Attach;
Drucken("AUFTRAG.Jobname");
wnd.closewnd;
End
|
Ein Formular ComboBox hat folgende Einträge in der Werteliste:
Berlin, Hamburg, München usw.
Wenn nun Hamburg angeklickt wird, soll ein Makro ausgeführt werden.
Lösung:
1. Im Formulareditor die ComboBox anklicken
2. Im Eigenschafts-Bereich unter "BeimÄndern", "Neues Makro" auswählen
3. In dieses ein Makro bsw. Message("BeimÄndern (Formular ComboBox)") eintragen.
4. Alles speichern und neu übersetzen
5. Das Formular im 'normalen' Modus öffnen.
Wird in der ComboBox einen anderen Wert ausgewählt, erscheint ein
Meldungsfenster mit dem Text "BeimÄndern (Formular ComboBox)".
|
Bei Nachschlagefiltern, verwendet bei Nachschlagefelder, sind nur einfache statische Ausdrücke möglich. Wird eine dynamische Lösung benötigt, muss die Funktion BeimÖffnen des Nachschlage-Formulares zu implementieren. |
Procedure Edit1Gültigkeitsbedingung : Integer;
..#ein integerfeld sollte den wert 5 enthalten
..#falls nicht wird eine ungültigkeitsmeldung ausgegeben
..#die ungültigkeitsmeldung ist im formular unter feldeigenschaften definiert
..#Feld Edit1 Ungültigkeitsmeldung:
..#"Bitte den richtigen Wert von 5 eingeben."
..#Feld Edit1 Gültigkeitsbedingung:
..#Edit1Gültigkeitsbedingung
..#Rückgabe:
..#0 = ungültig; 1 = gültig
..#eingegeben wert prüfen
If $TESTTAB.Testinteger <> 5
..#wert ist nicht 5, dann 0 = ungültig zurückgeben
Return 0
Else
..#wert ist 5, dann 1 = gültig zurückgeben
Return 1
End;
EndProc;
|
Im Formular Kunden ist eine eingebette Tabelle Termine mit folgenden
Datensätzen: Termin 1, Termin 2, Termin 3 usw.
Wenn nun Termin 2 angeklickt wird sollte ein Makro ausgeführt werden.
Lösung:
1.Im Formulareditor die eingebettete Tabelle doppelklicken um
den Spalteneditor zu öffnen.
2.In der Liste der Spalten die ComboBox-Spalte wählen und
die Option Daten wählen.
3.Im Eigenschaften-Bereich beim Eintrag "BeimÄndern" ein "Neues Makro" wählen.
4.Im Hintergrund wurde schon im Makroeditor ein Makro angelegt, in
dem ein Befehl einegtrahen wird.
Beispiel: Message("BeimÄndern (Datengrid ComboBox)"
5.Formular speichern, neu übersetzen und das Formular im 'normalen' Modus öffnen.
6.Wenn in der ComboBox einen anderen Wert ausgewählt wird, erscheint ein
Meldungsfensterchen mit dem Text "BeimÄndern (Formular ComboBox)".
Wenn ein eigenes Makro (bzw. im Beispiel oben die MessageBox) nur ausgeführt
werde soll, wenn der Benutzer tatsächlich etwas geändert hat, muß vorher noch
den Wert in der Tabelle mit dem Wert in der ComboBox abgleichen, also:
Procedure ComboBoxBeimÄndern;
If (Str(Tabelle.Feld) <> ComboBox.Text)
Message("BeimÄndern (Formular ComboBox)");
End
Endproc;
Dieses Vorgehen nur bei Formular-Comboboxen, da man auf Comboboxen in einer
|
Procedure Formular_Modus(sFormular: String):String;
..#zeige bearbeitungsstatus an. es muss datawnd verwendet werden, weil sonst beim drucken
..#eine fehlermeldung gezeigt wird (formular kann nicht gefunden werden)
..##
VarDef dwDatenfenster: DataWnd; ..fensterobject für das formular
dwDatenfenster := DatenfensterSuchen(sFormular);
..#datenfenster wurde nicht gefunde, dann leerstring zurückgeben
IF Assigned(dwDatenfenster) = 0
Return ""
Else
..#getmode auswerten
If dwDatenfenster.GetMode < 0
Return ""
Else
Return 'Modus: ' + Choice(dwDatenfenster.GetMode+1, 'Betrachten', 'Ändern', 'Neueingabe', 'Fehler');
End;
End;
Endproc;
|
Im Formular der Wert eine Combobox zeigen
Beispiel 1
==========
procedure MeinComboxboxBeimÄndern;
..#combobox control suchen und ausgewählter wert anzeigen
..##
Vardef cbCtrl: ComboBox; ..#combobox deren wert gesucht wird
..#control suchen
cbCtrl := FindControl("MeinComboxbox") as ComboBox;
..#gefunden, dann wert zeigen
if Assigned(cbCtrl)
Message(cbCtrl.Text);
else
Message('ComboBox gibt es nicht');
End;
endproc;
Beispiel 2
==========
Procedure cbEinstellungenDBVerwaltungDBBeimÄndern;
..#Der ausgewählte Wert eines Comboboxes den Text eines Labels zuweisen
..##
Vardef cbCtrl: ComboBox; ..#combobox deren wert ermittelt wird
Vardef lblCtrl: Label; ..#label welche datenbank info zeigt
cbCtrl := FindControl("cbEinstellungenDBVerwaltungDB") as ComboBox;
..#control gefunden? wenn nicht dann abbruch
if NOT Assigned(cbCtrl)
Return
..Message(cbCtrl.Text);
End;
lblCtrl := FindControl("lblEinstellungenDBVerwaltungDB") as Label;
..#control gefunden? wenn nicht dann abbruch
if NOT Assigned(lblCtrl)
Return
..Message(lblCtrl.Text);
End;
..#combobox eintrag den labeltext zuweisen
lblCtrl.Text := cbCtrl.Text;
EndProc;
|
Procedure Button1BeimAnklicken;
..#In einem Formular mit eingebettete Tabelle die markierte Einträge ermitteln
..#und darstellen
..##
Var CCRLF = Chr(13) + Chr(10);
Vardef Marks: Integer[0];
Vardef nCnt, i : Integer;
VarDef dwDatenfenster: DataWnd;
Vardef sTitel : String;
..#keine einträge dann stop
?FileSize($MP3TITEL) = 0 / Return
..#tabelle in formular suchen
dwDatenfenster := FindDataWnd("INTERPRET.Interpret", "dgInterpretTitel");
..#gefunden
If Assigned(dwDatenfenster)
..#gibt es markierungen
If dwDatenfenster.StarNum > 0
nCnt := dwDatenfenster.GetStars(Marks);
..#wieviele markierungen
Message(Str(nCnt));
i := -1; ..#muss mit -1 starten und dann bei < ncnt aufhören
..#loop durch die titel und gebe aus
While i := i + 1 < nCnt
ReadRec($MP3TITEL, Marks[i]);
sTitel := sTitel + $MP3TITEL.Ablage + $MP3TITEL.Titel + ".mp3" + CCRLF;
..#zeige die tabelleneinträge
Message(Str(Marks[i]) + CCRLF + sTitel);
End;
End;
End;
Endproc;
|
Procedure SchalterTextSetzen;
..#Ändert den standardtext eines schalters mit den namen BtnOK
..##
Vardef BtnCtrl: Button; #schalter
..#schalter btnok im formular suchen
BtnCtrl := FindControl("BtnOK") as Button;
..#schalter gefunden, dann neuen text zuweisen, sonst fehlermeldung
If Assigned(BtnCtrl)
BtnCtrl.Text := "Schaltertext";
Else
Message("Sorry, aber Schalter BtnOK gibt es nicht!");
End;
Endproc;
|
Unter Windows XP darf bei Farbzuweisungen, wie SCHALTER.Color := clGreen, der Rahmentyp nicht auf "STANDARD" gesetztwerden. |
procedure btnTippVerweisAendernBeimAnklicken;
..#im formular tipps befindet sich eine eingebette tabelle verweise
..#die tabelle verweise hat einen linkfeld auf die tabelle tipps
..##
Vardef nVRNo : Integer; ..#verweis record speichern
Vardef dwVerweise : dataWnd; ..#eingebette tabelle verweise
nVRNo := RecNr($VERWEISE);
If nVRNo = 0
Return
End;
..Message(VERWEISE.Verweis, Str(nRNo));
ActivateForm("VERWEISE.Verweise");
dwVerweise := FindDataWnd("VERWEISE.Verweise");
If Assigned(dwVerweise)
dwVerweise.ShowRec(nVRNo);
dwVerweise.EditRec("Ändern Sie die Angaben.");
dwVerweise.Schließen;
Refresh;
End;
endproc;
|
procedure btnMemoZeigenBeimAnklicken;
..#Im formular inhalt eines memoelement zeigen
..##
Vardef MemoCtrl : Memo;
MemoCtrl := FindControl("Memo1") as Memo;
Message(MemoCtrl.Text);
endproc;
|
Vardef CtrlDP1 : DateTimePicker;
..#datetimepicker control suchen
CtrlDP1 := FindControl("DateTimePicker1") as DateTimePicker;
..#wenn gefunden, dann inhalt ausgeben
If Assigned(CtrlDP1)
Message(CtrlDP1.Text);
End;
|
Procedure btnFormularListeBeimAnklicken;
..schaltet um im register pagecontrol1 und setzt entsprechend den text im schalter
Vardef ButtonCtrl: Button;
ButtonCtrl := FindControl("btnFormularListe") as Button;
If Assigned(ButtonCtrl)
If ViewPage(0) = 2
ViewPage(-3);
ButtonCtrl.Text := 'Liste';
Else
ViewPage(-2);
ButtonCtrl.Text := 'Formular';
End;
End;
..Message(Str(ViewPage(0)));
Endproc;
|
Verwendet Eigenschaft: ComboBox1.Text |
Verwendet Eigenschaft: RadioGroup1.ItemIndex Beispiel: procedure RadioGroup1BeimÄndern; Message(Str(RadioGroup1.ItemIndex)); endproc; Dazu muss im Formular die Option "FormularbezogeneMakros" aktiviert sein. |
Dieses Info-Formular kann wie folgt definiert und aufgerufen werden:
Procedure Anwendung_Info;
..#info fenster aufrufen
ExecDialog("SYSTEM.Information");
Return
Endproc;
Aufruf: Anwendung_Info
Verwendet werden kann der Aufruf in Formularmenüstrukturen (Menüpunkt, Symbol oder Taste)
|
procedure btnTestTurboPLBeimAnklicken;
..#formularmemo turbopl code ausführen. das memofeld ist kein datenbankfeld zugeordnet und
..#wird als objekt verwendet
..#Hinweis:
..#keine weitere prüfungen eingebaut
..#anstatt tempfile kann auch ramtext verwendet werden
..##
Var CTEMPFILE = BaseDir+"x.x";
Vardef nRT : Integer;
Vardef memoCtrl: Memo;
memoCtrl := FindControl("memoTestTurboPL") as Memo;
nRT := Rewrite(CTEMPFILE);
WriteLn(nRT, memoCtrl.Text);
Close(nRT);
nRT := ExecProg(CTEMPFILE);
If nRT <> 0
Message(Error.Message, "Fehler");
End;
DelFile(CTEMPFILE);
endproc;
|
procedure btnTurboPLCodeAusfuehrenBeimAnklicken;
..#der code wird zeile für zeile gelesen und ausgeführt.
,,#der code befindet sich in ein memofled einer systemtabelle:
..#$SYSTEM.TurboPLMemo
..##
Var CCRLF = Chr(13) + Chr(10);
VarDef sTempPrg : String;
VarDef sTempMod : String;
VarDef nFH : Integer; ..handle für dateiöffnen
VarDef nRT : Integer; ..returncode execprog
VarDef i : Integer; ..counter
VarDef nFound : Integer; ..flag ob proc gefunden wurde
Vardef sProcname : String; ..die proc die gesucht wird
Vardef sLine : String; ..zeilenbuffer
Vardef asProcCode : String[]; ..codebuffer zeile für zeile
sTempPrg := "temp.prg";
sTempMod := "temp.mod";
..gibt es inhalt
If $SYSTEM.TurboPLMemo = ''
Message("Fehler: Kein Code definiert!", "Quellcode Ausführen");
Return
End;
..moduldatei setzen
sTempMod := BaseDir + sTempMod;
..öffne modul
If Copymemo($SYSTEM.TurboPLMemo, sTempMod) <> 0
Message("Fehler: Temporäre Datei '" + sTempMod + "' kann nicht erstellt werden!","Quellcode Ausführen");
Return
End;
nFH := Reset(sTempMod);
If nFH = 0
Message("Fehler: Temporäre Datei '" + sTempMod + "' kann nicht gelesen werden!","Quellcode Ausführen");
Return
End;
..
i := 0;
ClrArray(asProcCode);
While Not EOT(nFH)
sLine := ReadLn(nFH);
ReDim(asProcCode, i);
asProcCode[i] := sLine;
i := i + 1;
End;
Close(nFH);
If i = 0
Message("Abbruch: Code wurde nicht gefunden!");
Else
nFH := Rewrite(sTempPrg);
..erste und letzte zeile mit angaben procedure (prozedur) und endproc (endproz) löschen
..sonst werden die anweisungen nicht ausgeführt
asProcCode[0] := "";
asProcCode[High(1, asProcCode)] := "";
..schreibe in eine temp datei
NLoop(i, High(1,asProcCode), WriteLn(nFH, asProcCode[i]));
Close(nFH);
..NLoop(i, High(1,asProcCode), Message(asProcCode[i]))
..ExecProg(asProcCode);
..führe tempdatei aus
nRT := ExecProg(sTempPrg);
..falls fehler
If nRT > 0
Message("Fehler bei der Ausführung ' Fehlercode = " + Str(nRT) + CCRLF + Error.Message, "Quellcode Ausführen");
End;
..tempdateien löschen
DelFile(sTempMod);
DelFile(sTempPrg);
End;
|
Den kompletten Inhalt eines Memos TABELLE.MemoFeld an die angegebene Datei anhängen:
Vardef FileHdl: integer;
FileHdl := TAppend('c:\temp\Test.txt');
Write(FileHdl, TABELLE.MemoFeld);
|
Es können nur die englische Eigenschaftsbezeichnungen verwendet werden. Beispiel: Label.Left := 336; Label.Top := 112; |
NUR VDP Es können mehr als 10 Menüpunkte angelegt werden, allerdings werden diese abhängig vom verfügbaren Speicher aufgebaut. Der verfügbare Speicher ist wiederum abhängig von a/ Anzahl der Prozeduren in dem Modul woraus die Menüpunkte aufgebaut werden und b/ von der Länge der Prozedurnamen. Fazit: Prozeduren die nicht in Menüpunkte verwendet werden mit einem dummy Parameter versehen (Procedur myProc(nB : Real) und Prozedurnamen so kurz (aber noch verständlich) halten. und werden neue Prozeduren erstellt und danach die Menüstruktur im Formular angepasst, kann es sein, daß abhängig vom verfügbaren Speicher, Prozeduren "wegfallen" ohne einen Hinweis dass der Speicher nicht mehr ausreicht. |
NUR VDP Für die meisten Menüpunkte gibt es entsprechende easy-Funktionen. Probleme gibt es bei den Menüpunkten: Bearbeiten|Einfügen Der Inhalt der Zwischenablage läßt sich mit Clip2Text auslesen. Ansicht|Alle Datensätze Mit Sortierung oder SetSortOder |
Procedure Test; ..#in einem Formular erst ein Optionselement definieren ..## Message(str(RadioGroup1.ItemIndex)) Endproc; Kann verwendet werden um Variablen zu belegen deren Inhalt in einer Tabelle nichts zu suchen haben. |
Im Formular zwei Schalter definieren, eine mit Textfarbe Rot (LabelRot),
der andere mit Textfarbe Schwarz (LabelSchwarz)
Sicherstellen das die Option Formularbezogene Makros aktiviert ist.
procedure Button1BeimAnklicken;
..#Testprozedur der die Schalter ROT oder SCHWARZ setzt
..##
if LabelRot.Visible
LabelSchwarz.Visible := 1;
LabelRot.Visible := 0;
else
LabelRot.Visible := 1;
LabelSchwarz.Visible := 0;
end;
endproc;
procedure ReferenzSchwarzBeimAnklicken;
..#schwarz setze rot
..##
ReferenzRot.Visible := 1;
ReferenzSchwarz.Visible := 0;
endproc;
procedure ReferenzRotBeimAnklicken;
..#rot setze schwarz
..##
ReferenzSchwarz.Visible := 1;
ReferenzRot.Visible := 0;
endproc;
|
In eine Systemtabelle ein Feld definieren der die Anzahl Tage vom aktuellen Datum zum Ziel Datum enthält: Feldname: $SYSTEM.VorgabeZielDatumTage Typ: DateTime oder DatumZeit Option: "Unterscheidung zwischen Null und leer" darf NICHT gesetzt sein! Eintrag im Feld unter Vorgabe: CombineDateTime(ToDay + $SYSTEM.VorgabeZielDatumTage, Now) |
procedure FormOnOpen;
..#wird beim öffnen des formulars ausgeführt
..#gesetzt wird inhalt des eingabefeldes MakroSuchen
..##
edMakroSuchen.Text := "<Makro suchen>";
Return
..#eine andere möglichkeit den wert zu setzen
Vardef EditCtrl : Edit;
EditCtrl := FindControl("edMakroSuchen") as Edit;
If Assigned(EditCtrl)
EditCtrl.Text := "<Makro suchen>";
End;
EndProc;
|
Formular mit Gültigkeitsprüfung.
Funktion des Formulares mit einem nummerischen Rückgabewert.
Innerhalb dieser Funktion erfolgt ebenfalls die Prüfung und eine eventuelle
Meldung.
Rückgabewert der Funktion entscheidet, ob der Datensatz gespeichert werden soll:
0 = nicht speichern
1 = speichern
Beispiel:
Procedure FormCondition: Integer;
If CountRecs(TABELLE) > 0
Return 1 ..#Bedingung erfüllt: 1 (True)
Else
Return 0
End;
Endproc;
Weitere Prüfungsbeispiele:
Feld Text
FELD = "VergleichtsText"
FELD <> "VergleichtsText"
Length:
Length(FELD) = VergleichsZahl
Length(FELD) < VergleichsZahl
|
procedure FormOnOpen;
..#möglichkeit die programmversion mittels eines labels zu zeigen
..##
Vardef lblProgrammversion: Label; ..#label deren text gesetzt wird
..#label suchen
lblProgrammversion := FindControl("lblHauptmenueProgrammversion") as Label;
..#nicht gefunden, dann anhalten
If not Assigned(lblProgrammversion)
Halt;
End;
..#gefunden, dann text zuweisen
lblProgrammversion.Text := "Programmname Version 1";
endproc;
|
Tipps zu TurboDB Studio Formulare
..#
..# ComboBox bei Auswahl Makro ausführen
..#
Ein Formular ComboBox hat folgende Einträge in der Werteliste:
Berlin, Hamburg, München usw.
Wenn nun Hamburg angeklickt wird, sollte ein Makro ausgeführt werden.
Lösung:
Im Formulareditor die ComboBox anklicken, dann im Eigenschafts-Bereich unter
"BeimÄndern", "Neues Makro" auswählen und in dieses Makro bsw.
Message("BeimÄndern (Formular ComboBox)") eintragen.
Alles speichern und neu übersetzen, anschließend das Formular
im 'normalen' Modus öffnen.
Wird in der ComboBox einen anderen Wert ausgewählt, erscheint ein
Meldungsfenster mit dem Text "BeimÄndern (Formular ComboBox)".
..#
..# Eingebettete Tabelle Makro ausführen
..#
Im Formular Kunden ist eine eingebette Tabelle Termine mit folgenden
Datensätzen: Termin 1, Termin 2, Termin 3 usw.
Wenn nun Termin 2 angeklickt wird sollte ein Makro ausgeführt werden.
Lösung:
1.Im Formulareditor die eingebettete Tabelle doppelklicken um
den Spalteneditor zu öffnen.
2.In der Liste der Spalten die ComboBox-Spalte wählen und
die Option Daten wählen.
3.Im Eigenschaften-Bereich beim Eintrag "BeimÄndern" ein "Neues Makro" wählen.
4.Im Hintergrund wurde schon im Makroeditor ein Makro angelegt, in
dem ein Befehl einegtrahen wird.
Beispiel: Message("BeimÄndern (Datengrid ComboBox)"
5.Formular speichern,neu übersetzen und das Formular im 'normalen' Modus öffnen.
6.Wenn in der ComboBox einen anderen Wert ausgewählt wird, erscheint ein
Meldungsfensterchen mit dem Text "BeimÄndern (Formular ComboBox)".
Wenn ein eigenes Makro (bzw. im Beispiel oben die MessageBox) nur ausgeführt
werde soll, wenn der Benutzer tatsächlich etwas geändert hat, muß vorher noch
den Wert in der Tabelle mit dem Wert in der ComboBox abgleichen, also:
Procedure ComboBoxBeimÄndern;
If (Str(Tabelle.Feld) <> ComboBox.Text)
Message("BeimÄndern (Formular ComboBox)");
End
Endproc;
Dieses Vorgehen nur bei Formular-Comboboxen, da man auf Comboboxen in einer
eingebetteten Tabelle keinen direkten Zugriff hat.
|
TS/VDP sucht das Modul im aktuellen Verzeichnis. Dieses wird aber durch Datei-Dialoge verstellt. Wenn also irgendwo in TS/VDP ein Datei-Dialog benutzt wird, der dann aufein anderes Verzeichnis weist, ist es aus. Projekt schließen und neu öffnen stellt einfach nur dasProjektverzeichnis wieder als das Aktuelle ein. |
Expizite Netzwerksperren braucht man nur dann einzusetzen, wenn man hinsichtlich Netzwerkperformance optimieren möchte. Eine Totalsperre einzurichten bedeutet, daß während dieser Zeit kein anderer User auf die Daten zugreifen kann und dann nach dem eingestellten TimeOut den Netzmonitor bekommt. Dies sollte eigentlich vermieden werden, damit nicht der Eindruck entsteht, daß permanent die Datenbank gesperrt ist. Am besten versucht man, Servieläufe, die eine Totalsperre erfolgen nachts laufen zu lassen. Ich würde dazu raten, expilzites Looken auf ein Minimum zu reduzieren. |
ExecSQL wird ausgeführt bei INSERT, DELETE, UPDATE, CREATE, ALTER oder DROP Befehle
Aufruf: ExecSQL(SQL-Befehl : String) : Integer;
Rückgabe: Anzahl Datansätze die geändert wurde.
Beispiel:
procedure btnExecSQLBeimAnklicken;
..#Tabellenstruktur: Name (S20), ID (AutoInc)
..##
Var CCRLF = Chr(13) + Chr(10);
Var CSQLCMD = "INSERT INTO TESTTAB12 (Name) VALUES ('Name99')";
Vardef nRT : Integer;
..#
Try
..#sql befehl ausführen
nRT := ExecSQL(CSQLCMD);
Except
Message(Error.Message + CCRLF + CSQLCMD, "Fehler: SQL Befehl");
Return
End;
..#der sql befehl wurde ausgeführt, aber war das ergebnis auch OK?
If nRT < 0
Message(Error.Message + CCRLF + CSQLCMD, "Fehler: SQL Befehl");
Else
Message("SQL Befehl erfolgreich ausgeführt." + CCRLF + CSQLCMD, "Hinweis: SQL Befehl");
Refresh;
End;
Endproc;
|
OpenSQL wird ausgeführt für SELECT Befehle
Aufruf: OpenSQL(SQL-Befehl : String) : Tabellenhandle;
Rückgabe: Tabelle mit dem Ergebnis
Beispiel:
Procedure btnOpenSQLBeimAnklicken;
..#Beispiel OpenSQL
..#Tabellenstruktur: Name (S20), ID (AutoInc)
..##
Var CCRLF = Chr(13) + Chr(10);
Var CSQLCMD = "SELECT * FROM TESTTAB12 WHERE Name = 'Name1'";
Vardef nSQLTab: Integer;
Vardef nRNo : Integer;
Vardef nCnt : Integer;
..#
Try
..#sql befehl ausführen
nSQLTab := OpenSQL(CSQLCMD);
..#anzahl gefunden records ermitteln
nCnt := FileSize(nSQLTab);
..#oder klassisch
..nCnt := 0;
..nRNo := FirstRec(nSQLTab);
..While nRNo > 0
.. nRNo := ReadRec(nSQLTab, nRNo);
.. nCnt := nCnt + 1;
.. nRNo := NextRec(nSQLTab);
..End;
..#und ausgeben
Message(Str(nCnt), "SQL Befehle - Datensätze");
..#ergebnis zeigen
nRNo := FirstRec(nSQLTab);
While nRNo > 0
ReadRec(nSQLTab, nRNo);
Message(GetField(nSQLTab, 1) + " (ID:" + GetField(nSQLTab, 2) + ")");
nRNo := NextRec(nSQLTab);
End;
CloseDB(nSQLTab);
Except
Message(Error.Message + CCRLF + CSQLCMD, "Fehler: SQL Befehl");
End;
Endproc;
|
SQL-Befehl:
ExecSQL("Alter Table MeineTabelle");
Hinweis:
SQL Alter Table kann nur für Tabellen funktionieren, die nicht im Projekt
eingebunden sind.
..#TurboPL Beispiel
Vardef sqlCmd: String;
sqlCmd := 'ALTER TABLE [TabellenNameOhnePunktDat]';
ExecSql(sqlCmd);
|
..#Adressen der Tabelle adressen.dat bearbeiten Spalten Name S50, EMail S255, Internet S255
..#pfad zur adressen tabelle
Var CADRESSENDB = BaseDir + "BSP\ADRESSEN.DAT";
procedure SQL_Adressen_lesen;
..#adressen mittels sql lesen
..##
Var CCRLF = Chr(13) + Chr(10);
Vardef nRNo: Integer; ..#handle für records
Vardef nSQLTab: Integer; ..#handle für die sql tabelle
Vardef sSQLCMD : String; ..#string für sql befehl
Vardef sStr : String; ..#string der die adresseneinträge hält
Vardef sSQLTab : String; ..#sql tabelle
..Message("Start ...");
Try
sSQLTab := '"'+CADRESSENDB+'"';
sSQLCMD := "SELECT * FROM " + sSQLTab;
nSQLTab := OpenSQL(sSQLCMD);
sStr := "";
sStr := "*** Adressen Einträge ***" + CCRLF;
sStr := sStr + "-------------------------" + CCRLF;
sStr := sStr + "Anzahl Einträge: " + Str(Filesize(nSQLTab)) + CCRLF;
nRNo := FirstRec(nSQLTab);
While nRNo > 0
ReadRec(nSQLTab, nRNo);
sStr := sStr + Label(nSQLTab, 1) + " = " + GetField(nSQLTab, 1) + ", ";
sStr := sStr + Label(nSQLTab, 2) + " = " + GetField(nSQLTab, 2) + ", ";
sStr := sStr + Label(nSQLTab, 3) + " = " + GetField(nSQLTab, 3) + ", ";
sStr := sStr + CCRLF;
nRNo := NextRec(nSQLTab);
End;
CloseDB(nSQLTab);
..CopyStrToClipboard(sSQLCMD);
Message(sStr, "Adressen Einträge");
Except
Message(Error.Message, "Fehler - Datenbank öffnen");
End;
..Message("Ende ...");
Endproc;
procedure SQL_Adressen_einfuegen;
..#adressen mittels sql einfuegen
..##
Var CCRLF = Chr(13) + Chr(10);
Var CCNT = 5; ..#anzahl testeinträge
Vardef nRNo: Integer; ..#handle für records
Vardef i: Integer; ..#laufvar
Vardef nRT: Integer; ..#handle für records
Vardef nSQLTab: Integer; ..#handle für die sql tabelle
Vardef sSQLTab : String; ..#sqltabelle
Vardef sSQLCMD : String; ..#string für sql befehl
Vardef sStr : String; ..#string der die adresseneinträge hält
..Message("Start ...");
sSQLTab := '"' + CADRESSENDB + '"';
For i := 1 To CCNT
sSQLCMD := "";
sStr := "";
Try
sStr := sStr + "'Testname" + Str(i) + "', ";
sStr := sStr + "'name" + Str(i) + "@adresse.de', ";
sStr := sStr + "'www.meineadresse" + Str(i) + ".de'";
sSQLCMD := sSQLCMD + "INSERT INTO " + CCRLF;
sSQLCMD := sSQLCMD + sSQLTab + CCRLF;
sSQLCMD := sSQLCMD + "(Name, EMail, Internet)" + CCRLF;
sSQLCMD := sSQLCMD + "VALUES (" + sStr + ")";
..CopyStrToClipboard(sSQLCMD);
..Message(sSQLCMD);
..sSQLCMD := "INSERT INTO " + sSQLTab + "(Name,EMail,Internet) VALUES (" + sStr + ")";
nRT := ExecSQL(sSQLCMD);
CloseDB(nSQLTab);
Except
Message(Error.Message + CCRLF + sSQLCMD, "Fehler: SQL Befehl");
Return
End;
..#der sql befehl wurde ausgeführt, aber war das ergebnis auch OK?
If nRT < 0
Message(Error.Message + CCRLF + sSQLCMD, "Fehler: SQL Befehl");
End;
Next;
..#
Message("Adressen - " + Str(CCNT) + " Testeinträge - hinzugefügt.", "Adressen Test Einträge");
..Message("Ende ...");
Endproc;
procedure SQL_Adressen_loeschen;
..#adressen mittels sql loeschen
..##
Var CCRLF = Chr(13) + Chr(10);
Vardef nRT: Integer; ..#handle für records
Vardef nSQLTab: Integer; ..#handle für die sql tabelle
Vardef sSQLTab : String; ..#sqltabelle
Vardef sSQLCMD : String; ..#string für sql befehl
..Message("Start ...");
sSQLTab := '"'+CADRESSENDB+'"';
sSQLCMD := "";
Try
sSQLCMD := sSQLCMD + "DELETE FROM " + CCRLF;
sSQLCMD := sSQLCMD + sSQLTab + CCRLF;
nRT := ExecSQL(sSQLCMD);
CloseDB(nSQLTab);
Except
Message(Error.Message + CCRLF + sSQLCMD, "Fehler: SQL Befehl");
Return
End;
..#der sql befehl wurde ausgeführt, aber war das ergebnis auch OK?
If nRT < 0
Message(Error.Message + CCRLF + sSQLCMD, "Fehler: SQL Befehl");
End;
..#
Message("Adressen gelöscht.", "Adressen Einträge löschen");
..Message("Ende ...");
Endproc;
procedure SQL_Adressen_abfragen;
..#adressen mittels sql abfragen
..##
Var CCRLF = Chr(13) + Chr(10);
Vardef nRNo: Integer; ..#handle für records
Vardef nRT: Integer; ..#returncodehandle
Vardef nSQLTab: Integer; ..#handle für die sql tabelle
Vardef sSQLCMD : String;..#string für sql befehl
Vardef sStr : String; ..#string der die adresseneinträge hält
Vardef sAbfrage : String; ..#abfrage
Vardef sSQLTab : String; ..#sql tabelle
..Message("Start ...");
sAbfrage := "Name has 'name1'";
nRT := Input("Suchbegriff eingeben:", "Adressen suchen", 0, sAbfrage);
If nRT = 0
Message("Abbruch durch den Benutzer", "Adresse suchen");
Return
End;
Try
sSQLTab := '"'+CADRESSENDB+'"';
sSQLCMD := sSQLCMD + "SELECT * " + CCRLF;
sSQLCMD := sSQLCMD + "FROM " + CCRLF;
sSQLCMD := sSQLCMD + sSQLTab + " " + CCRLF;
sSQLCMD := sSQLCMD + "WHERE " + CCRLF;
sSQLCMD := sSQLCMD + sAbfrage + CCRLF;
..CopyStrToClipboard(sSQLCMD);
..Message(sSQLCMD);
nSQLTab := OpenSQL(sSQLCMD);
sStr := "";
sStr := "*** Adressen Einträge ***" + CCRLF;
sStr := sStr + "-------------------------" + CCRLF;
sStr := sStr + "Anzahl Einträge: " + Str(Filesize(nSQLTab)) + CCRLF;
nRNo := FirstRec(nSQLTab);
While nRNo > 0
ReadRec(nSQLTab, nRNo);
sStr := sStr + Label(nSQLTab, 1) + " = " + GetField(nSQLTab, 1) + ", " + Label(nSQLTab, 2) + " = " + GetField(nSQLTab, 2) + CCRLF;
..Message(Label(nSQLTab, 1) + " = " + GetField(nSQLTab, 1) + ", " + Label(nSQLTab, 2) + " = " + GetField(nSQLTab, 2));
nRNo := NextRec(nSQLTab);
End;
CloseDB(nSQLTab);
..CopyStrToClipboard(sSQLCMD);
Message(sStr, "Adressen Einträge");
Except
Message(Error.Message, "Fehler - Datenbank öffnen");
End;
..Message("Ende ...");
Endproc;
procedure SQL_Adressen_export_csv;
..#adressen mittels sql in eine csv datei exportieren
..##
Var CCRLF = Chr(13) + Chr(10);
Var CHDG = "CSV Export";
Var CHDGF = "Fehler - CSV Export";
Var CINF1 = "Einträge exportiert.";
Var CERR1 = "Die CSV Datei kann nicht erstellt werden.";
Var CERR2 = "Einträge konnten nicht exportiert werden.";
Vardef nRNo: Integer; ..#handle für records
Vardef nSQLTab: Integer; ..#handle für die sql tabelle
Vardef sSQLTab : String; ..#sql tabelle
Vardef sSQLCMD : String; ..#string für sql befehl
Vardef sStr : String; ..#string der die adresseneinträge hält
Vardef nFH : Integer; ..#csv datei handle
Vardef sCSVDatei : String; ..#die csv datei
..Message("Start ...");
sCSVDatei := Exchange(Lower(CADRESSENDB), ".dat", ".csv")
nFH := Rewrite(sCSVDatei);
If nFH = 0
Message(CERR1+CCRLF+sCSVDatei, CHDGF);
Return
End;
Try
sSQLTab := '"'+CADRESSENDB+'"';
sSQLCMD := "SELECT * FROM " + sSQLTab;
..Message(sSQLCMD);
nSQLTab := OpenSQL(sSQLCMD);
sStr := "";
sStr := sStr + Label(nSQLTab, 1) + ",";
sStr := sStr + Label(nSQLTab, 2) + ",";
sStr := sStr + Label(nSQLTab, 3);
WriteLn(nFH, sStr);
nRNo := FirstRec(nSQLTab);
While nRNo > 0
ReadRec(nSQLTab, nRNo);
sStr := "";
sStr := sStr + "'" + GetField(nSQLTab, 1) + "',";
sStr := sStr + "'" + GetField(nSQLTab, 2) + "',";
sStr := sStr + "'" + GetField(nSQLTab, 3) + "'";
WriteLn(nFH, sStr);
nRNo := NextRec(nSQLTab);
End;
CloseDB(nSQLTab);
Close(nFH);
..CopyStrToClipboard(sSQLCMD);
If IsFile(sCSVDatei)
Message(CINF1+CCRLF+"CSV-Datei: " + sCSVDatei, CHDG)
Else
Message(CERR2+CCRLF+"CSV-Datei: " + sCSVDatei, CHDGF)
End;
Except
Message(Error.Message, "Fehler - Datenbank");
End;
..Message("Ende ...");
|
SQL-Befehl:
ExecSQL("Update MeineTabelle Set MeinBlobFeld = null");
Hinweis: Die zugehörige Blobdatei wird dabei NICHT automatisch verkleinert, der freigewordene Platz wird lediglich als unbelegt markiert und für neue Inhalte verwendet. Soll Dateigröße der *.blb-Datei auf das Minimum verkleinert werden ist es nötig eine Restrukturierung der Tabelle auszuführen.
|
SQL CREATE LEVEL 3 Maximale Stringlänge liegt bei 255
Beispiel:
CREATE TABLE "TABELLE" LEVEL 3 ("ID" INTEGER,"Spalte" VARCHAR(255))
|
procedure btnSQLInsertBeimAnklicken;
..#Tabellenstruktur: Name (S20), ID (AutoInc)
..##
Var CCRLF = Chr(13) + Chr(10);
Var CSQLCMD = "";
Var CSQLOK = "SQL Befehl erfolgreich ausgeführt.";
Var CCNT = 5;
Vardef nRT : Integer;
Vardef i : Integer;
Vardef sStr : String;
..#
For i := 1 To CCNT
CSQLCMD := "";
Try
sStr := 'Name' + Str(i);
CSQLCMD := "INSERT INTO TESTTAB12 (Name) VALUES ('" + sStr + "')";
nRT := ExecSQL(CSQLCMD);
Except
Message(Error.Message + CCRLF + CSQLCMD, "Fehler: SQL Befehl");
Return
End;
..#der sql befehl wurde ausgeführt, aber war das ergebnis auch OK?
If nRT < 0
Message(Error.Message + CCRLF + CSQLCMD, "Fehler: SQL Befehl");
End;
Next;
..#
EndeDerTabelle;
Message(CSQLOK, "Hinweis: SQL Befehl");
Endproc;
|
Mit SQL Select können Daten selektiert und mit ReadRec gelesen werden. Diese Möglichkeit ist sehr vielfältig. Beispiel 1 Var CCRLF = Chr(13) + Chr(10); ..#SQL Select Befehl definieren Var CSQLCMD = "SELECT Count(*), SUM(ID), AVG(ID) FROM TESTTAB12 WHERE Name = 'Name5'"; ..#handle für die sql tabelle Vardef nSQLTab: Integer; ..#sql befehl ausführen ..#als ergebis eine sql tabelle mit einem satz und 3 spalten count(*), sum(id), avg(id) nSQLTab := OpenSQL(CSQLCMD); ReadRec(nSQLTab, 1); sStr := sStr + Label(nSQLTab, 1) + ': Das Ergebnis der Anzahl ist: ' + GetField(nSQLTab, 1) + CCRLF; sStr := sStr + Label(nSQLTab, 2) + ': Das Ergebnis der Summierung ist: ' + GetField(nSQLTab, 2) + CCRLF; sStr := sStr + Label(nSQLTab, 3) + ': Das Ergebnis des Mittelwertes ist: ' + GetField(nSQLTab, 3) + CCRLF CloseDB(nSQLTab); Message(sStr, "SQL Befehle"); Beispiel 1 Var CCRLF = Chr(13) + Chr(10); Var CSQLCMD = "SELECT * FROM TESTTAB12 WHERE Name = 'Name5'"; Vardef nSQLTab: Integer; ..#handle für die sql tabelle ..#sql befehl ausführen ..#als ergebis eine sql tabelle mit alle felder der tabelle TESTTAB12 und Anzahl datensätze gefunden nSQLTab := OpenSQL(CSQLCMD); nRNo := FirstRec(nSQLTab); While nRNo > 0 ReadRec(nSQLTab, nRNo); Message(Label(nSQLTab, 1) + " = " + GetField(nSQLTab, 1) + ", " + Label(nSQLTab, 2) + " = " + GetField(nSQLTab, 2)); nRNo := NextRec(nSQLTab); End; CloseDB(nSQLTab); |
Im Update-Statement kann kein Sub-Select verwendet werden, das müssen feste Werte sein. |
Verwende den Befehl Execute um die tdbengine mit Parameter aufzurufen.
Parameter:
Modul.prg
Beispiel:
Execute("tdbengine.exe test.prg");
|
Procedure FormularAufrufenMitParameter(nMode : Integer);
..#abhängig vom parameter nmode wird bei
..#1 = ein neuer datensatz angelegt
..#2 = der datensatz bearbeitet
..##
ActivateForm("TABELLE.Formular");
?nMode = 1 / AppendNewRecords;
?nMode = 2 / ModifyRecords;
EndProc;
Testaufruf: FormularAufrufenMitParameter(2);
|
Vardef arMemo : String[0]; ..#string array
Vardef sZeile : String; ..#zeilen buffer
Vardef sStr : String; ..#string buffer
Vardef memoInfo: Memo; ..#memo control dem der text zugeordnet wird
Vardef i, nZeile, nCnt : Integer; ..#lauf vars
..#
sStr := "";
..#memo control im formular suchen
memoInfo := FindControl("memoInfo") as Memo;
..#control nicht gefunden, dann anhalten
If not Assigned(memoInfo)
Halt;
End;
..#inhalt memocontrol einem string zuweisem
sStr := memoInfo.Text;
..#wenn leer, dann abbruch
If sStr = ""
Halt;
End;
..#wieviel zeichen sind im memo enthalten
nCnt := Length(sStr);
..#zeilen counter
nZeile := -1;
i := 0;
..#lese zeichenweise
Repeat
i := i + 1;
If sStr[i] = Chr(13)
nZeile := nZeile + 1;
ReDim(arMemo, nZeile);
arMemo[nZeile] := sZeile;
sZeile := "";
Else
sZeile := sZeile + sStr[i];
End;
Until i = nCnt + 1;
..#die letzte zeile abfangen
If sZeile <> ""
nZeile := nZeile + 1;
ReDim(arMemo, nZeile);
arMemo[nZeile] := sZeile;
End;
..#
..#Testausgabe
..NLoop(i, High(1, arMemo), Message(arMemo[i]));
|
procedure Tabelle_aus_Array;
..#Tabellennamen aus einem String Array für Tabellenoperationen verwenden
..##
Vardef asTabelle : String[20]; ..#array mit tabellen namen
Vardef nTabelle : Integer; ..#Tabellennummer
Vardef i : Integer; ..#Ausgewählte tabelle
..#tabellenamen zum array zuordnen
asTabelle[1] := "TESTBLOB.DAT"
asTabelle[2] := "TESTTAB.DAT"
..#die erste tabelle auswählen
i := 1;
..
nTabelle := Round(Val(asTabelle[i]));
..#und als text anzeigen
Message("Tabellennummer:"+Str(nTabelle)+ " für Tabelle:" + DBName(nTabelle));
..#hier können tabellen operationen durchgeführt werden, wie
..Try
.. ClearDat(nTabelle);
.. RegenAll(nTabelle);
..Except
.. Message(Error.Meldung, "Fehler: " + Str(Error.Nummer));
..End;
EndProc;
|
procedure btnTurboPLCodeAusfuehrenBeimAnklicken;
..#formular schalter
..#beim anklicken wird der code zeile für zeile gelesen und ausgeführt.
..#der code ist in ein memofeld einer sytemtabelle gespeichert:
..# Vardef memoInfo: Memo; ..#memo control dem der text zugeordnet wird
..##
Var CCRLF = Chr(13) + Chr(10);
VarDef sTempPrg : String; ..#temporäre programmdatei
VarDef sTempMod : String; ..#temporäres modul
VarDef nFH : Integer; ..#handle für dateiöffnen
VarDef nRT : Integer; ..#returncode execprog
VarDef i : Integer; ..#counter
VarDef nFound : Integer; ..#flag ob proc gefunden wurde
Vardef sProcname : String; ..#die proc die gesucht wird
Vardef sLine : String; ..#zeilenbuffer
Vardef asProcCode : String[]; ..#codebuffer (zeile für zeile)
sTempPrg := "temp.prg";
sTempMod := "temp.mod";
..#gibt es code im memofeld der systemtabelle
If $SYSTEM.TurboPLMemo = ''
Message("Fehler: Kein Code definiert!", "Quellcode Ausführen");
Return
End;
..#moduldateinamen definieren
sTempMod := BaseDir + sTempMod;
..#öffne modul indem der memoinhalt in das temporäre module gespeichert wird
If Copymemo($SYSTEM.TurboPLMemo, sTempMod) <> 0
Message("Fehler: Temporäre Datei '" + sTempMod + "' kann nicht erstellt werden!","Quellcode Ausführen");
Return
End;
..#modul datei öffnen
nFH := Reset(sTempMod);
If nFH = 0
Message("Fehler: Temporäre Datei '" + sTempMod + "' kann nicht gelesen werden!","Quellcode Ausführen");
Return
End;
..#und zeile für zeile lesen und in codebuffer speichern
i := 0;
ClrArray(asProcCode);
While Not EOT(nFH)
sLine := ReadLn(nFH);
ReDim(asProcCode, i);
asProcCode[i] := sLine;
i := i + 1;
End;
Close(nFH);
If i = 0
Message("Abbruch: Code wurde nicht gefunden!");
Else
nFH := Rewrite(sTempPrg);
..#erste und letzte zeile mit angaben procedure (prozedur) und endproc (endproz) löschen
..#sonst werden die anweisungen nicht ausgeführt
asProcCode[0] := "";
asProcCode[High(1, asProcCode)] := "";
..#schreibe in eine temp datei
NLoop(i, High(1,asProcCode), WriteLn(nFH, asProcCode[i]));
Close(nFH);
..NLoop(i, High(1,asProcCode), Message(asProcCode[i]))
..ExecProg(asProcCode);
..#führe tempdatei aus
nRT := ExecProg(sTempPrg);
..#falls fehler
If nRT > 0
Message("Fehler bei der Ausführung ' Fehlercode = " + Str(nRT) + CCRLF + Error.Message, "Quellcode Ausführen");
End;
..#tempdateien löschen
DelFile(sTempMod);
DelFile(sTempPrg);
End;
EndProc;
|
Assigned(myObject : Object) : Integer Siehe auch unter Eintrag:/DataWnd und Eintrag:/Object |
..#.............................................................................
..# Formular Schalter Text setzen
..#.............................................................................
Procedure SchalterTextSetzen;
..#Ändert den standardtext eines schalters mit den namen BtnOK
..##
Vardef BtnCtrl: Button; #schalter
..#schalter btnok im formular suchen
BtnCtrl := FindControl("BtnOK") as Button;
..#schalter gefunden, dann neuen text zuweisen, sonst fehlermeldung
If Assigned(BtnCtrl)
BtnCtrl.Text := "Schaltertext";
Else
Message("Sorry, aber Schalter BtnOK gibt es nicht!");
End;
Endproc;
|
..#.............................................................................
..# Timer mittels Prozedur an- oder ausstellen und
..# Text eines Labels dazu anpassen.
..#.............................................................................
procedure btnActivateTimerBeimAnklicken;
..#timer an oder ausstellen
..#braucht formularelemente timer und label
..##
Vardef TimerCtrl: Timer; ..#der timer
Vardef LabelCtrl: Label; ..#label der den status des timers zeigt
..#label zur info darstellug finden
LabelCtrl := FindControl("lblTimerScandata") as Label;
If NOT Assigned(LabelCtrl)
Message("Fehler: Labelcontrol für Timer kann nicht gefunden werden");
End;
..#timer de- oder aktivieren
..#der timer has als name timerScandata
TimerCtrl := FindControl("timerScandata") as Timer;
If Assigned(TimerCtrl)
..timer is an, dann ausstellen
If TimerCtrl.Enabled = JA
TimerCtrl.Enabled := NEIN
LabelCtrl.Text := "Timer = AUS";
Else
..timer is aus, dann anstellen
TimerCtrl.Enabled := JA;
LabelCtrl.Text := "Timer = AN";
End;
..#hier kann der timer interval gesetzt werden
..#TimerCtrl.Interval
LabelCtrl.Text := LabelCtrl.Text + " (Interval=" + Str(TimerCtrl.Interval DIV 10) + "s.)";
End;
endproc;
|
Ja oder Nein ausgeben, wobei ein JaNein Feld (Boolean) verwendet wird: Choice($TABELLE.FeldJaNein, "Ja", "Nein") |
Procedure GetPfadAusLaufwerk(sDrive : String) : String; ..#sDrive ist Laufwerk A:, B:, C: ... ..#Rückgabe ist dann z.B. c:\, d:\daten\test\ ..## VarDef nDrive : Integer; ..laufwerk numerisch ermitteln Choice(Sel(nDrive:=Asc(Upper(LTRIM(sDrive)[1])) Von 65 Bis 90),nDrive:=nDrive - 64,nDrive:=0) ..dann mittels getdir das verzeichnis holen sDrive:=GetDir(nDrive) ..und mit \ zurückgeben Return Choice(SEL(RightStr(sDrive,1)="\"),sDrive, Choice(Sel(sDrive),sDrive+"\","")) Endproc |
Procedure GetDateinameAusPfad(sPath : String) : String; ..#sPath ist der Komplettpfad einer Datei ..## Vardef sSep : String; sPath := ""; ..separator ermitteln sSep := Choice(Sel(sPath := Exchange(sPath," ","") Hat "\"),"\",":") ..pfad extrahieren Repeat Until Not sPath := RightStr(sPath, Length(sPath) - Pos(sSep, sPath)) Hat sSep Return sPath Endproc; |
Procedure GetMonat(nMnt: Integer): string;
..#Monat aus Monatsnummer ermitteln
..##
VarDef nTmp : String;
nTmp := "";
If (nMnt > 0) AND (nMnt < 13)
nTmp := Choice(nMnt, "Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember");
End;
Return nTmp
Endproc;
oder einfach
Choice(nMonth, "Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember")
Choice(nMonth, "Jan", "Feb", "Mär", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")
|
Procedure GetMonatAusDatum(sDatum: string): string; ..#Monat aus sDatum als String Jan, Feb ... ..## VarDef nTmp : String; Return Choice(Month(DateTimeVal(sDatum)), "Jan", "Feb", "Mär", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez"); Endproc; |
Procedure FileDateiVorhandenX(sFile : String) : String; ..#Prüft ob eine Datei vorhanden ist. ..#Wenn ja, wird ein "X" sonst "Datei nicht vorhanden" angezeigt. ..## Return Choice(IsFile(sFile), "X","Datei nicht vorhanden") EndProc; |
Return Choice(Sel(IsFile(MeinVerzeichnis + MeineDatei) >0), "*", ""); |
Choice(Sel(MemoStr(TABELLE.MemoFeld) = ""),"Kein Inhalt","Inhalt vorhanden!"); |
ChooseFile("") zeigt das aktuelle Verzeichnis.
|
Siehe [CopyFile] |
Mittels ChooseFile(Dateiname) kann auch eine nicht existierende Datei angegeben werden. Diese Möglichkeit kann z.B. verwendet werden um ein Memo zu sichern. |
Procedure ExtractFilePath(sDateiname: String): String;
Vardef s, sResult: String;
Vardef i: Integer;
s := sDateiname;
sResult := "";
i := Pos("\", s);
While i > 0
sResult := sResult + LeftStr(s, i);
If s = "\"
..#Sonderfall: hinter letztem \ kein Text mehr vorhanden
s := ""
Else
s := RightStr(s, Length(s) - i)
End
i := Pos("\", s);
End
Return sResult;
Endproc
Procedure Bildpfad;
..#Dateinamen bestimmen:
Vardef sPfad: String;
T-Eingabe := "";
sPfad := "";
IF ChoosePicture("Bitte Bilddatei auswählen", "Datei|*.*|")
sPfad := ExtractFilePath(T-Eingabe)
End;
EndProc;
|
Choosefile übergibt den Dateinamen der gewählten Datei in der Variablen T-Eingabe.
Der Rückgabewert = 1 bedeutet, Datei ausgewählt.
Bitte beachten: ChooseFile nimmt einen Verzeichniswechsel vor.
Aus diesem Grund sollte man das Ausgangsverzeichnis speichern undanschließend sofort wieder dahin zurückwechseln.
Beispiel:
PROCEDURE Import_starten
VARDEF sAktDir : STRING
sAktDir := GetDir(0)
T-Eingabe := PARAM.Importverzeichnis + "\*.TXT";
IF ChooseFile("Bitte Quelldatei auswählen!") = 1
CHDIR(sAktDir);
END
ENDPROC
|
Procedure Textdatei_Auswahl_und_Inhalt_Zeigen;
..#Eine einfache Methode den Inhalt eine Textdatei zu zeigen. Die Datei kann vorher ausgewählt werden.
..##
VarDef nFH : Integer;
VarDef sStr : String;
VarDef sDatei : String;
..#datei wählen
If ChooseFile("Textdatei auswählen", "Textdatei (*.txt)|*.txt|Alle Dateien (*.*)|*.*|", sDatei) <> 1
Return
End;
..#und öffnen
nFH := Reset(sDatei);
If nFH = 0
Message("Datei " + sDatei + " kann nicht geöffnet werden!", "Fehler - Datei zeigen");
Return
End;
..#und lesen
While NOT Eot(nFH)
sStr := sStr + Read(nFH, 1);
End;
..#und inhalt zeigen
Message(sStr, "Inhalt " + sDatei);
..#und schliessen
Close(nFH);
EndProc;
|
Vardef sFile : String;
Vardef nRT : Integer;
..#standard öffnen dialog zeigen und rückgabe in globale var t-eingabe
nRT := ChooseFile("");
?nRT = 1 / Message(T-Eingabe);
..#
..#öffnen dialog mit eigene überschrift zeigen und rückgabe in globale var t-eingabe
nRT := ChooseFile("Datei wählen ...");
?nRT = 1 / Message(T-Eingabe);
..#
..#öffnen dialog mit eigene überschrift, filter zeigen und rückgabe in globale var t-eingabe
nRT := ChooseFile("Text Datei wählen ...", "Textdatei (*.txt)|*.txt|Alle Dateien (*.*)|*.*|");
?nRT = 1 / Message(T-Eingabe);
..#
..#öffnen dialog mit eigene überschrift, filter zeigen und rückgabe in lokale var sFile
nRT := ChooseFile("Text Datei wählen ...", "Alle Dateien (*.*)|*.*|", sFile);
?nRT = 1 / Message(sFile);
..#
..#öffnen dialog mit eigene überschrift, filter zeigen, lokale var vorbelegen und rückgabe in lokale var sFile
sFile := "*.bmp";
nRT := ChooseFile("Text Datei wählen ...", "Alle Dateien (*.*)|*.*|", sFile);
?nRT = 1 / Message(sFile);
|
procedure btnShowFolderBeimAnklicken;
..#Verzeichnis einlesen
..##
Var CCRLF = Chr(13) + Chr(10);
Vardef nRT: Integer;
Vardef sFolder: String;
Vardef FName, FAttributes, FFolder: string;
Vardef FSize: Integer;
Vardef FDate: Date;
Vardef FTime: Time;
Vardef sStr : String;
Vardef MemoCtrl : Memo;
sStr := "";
..#Vorbelegung Projektverzeichnis
sFolder := BaseDir;
..#Dialog ausführen
nRT := ChooseFolder("Wähle Verzeichnis welches gelesen soll ...", sFolder);
..#Auf Eingabe reagieren
If nRT <> 1
Message("Abbruch gedrückt");
Halt;
End
..#
nRT := FindFirstFile(sFolder + "\*.*", "DHS", FName, FSize, FDate, FTime, FAttributes, FFolder);
While nRT = 0
If not FName = "." and not FName = ".."
sStr := sStr + Exchange(Lower(FFolder + FName), "\\", "\") + CCRLF;
End;
nRT := FindNextFile(FName, FSize, FDate, FTime, FAttributes, FFolder);
End;
CloseFindFile;
MemoCtrl := FindControl("Memo1") as Memo;
MemoCtrl.Text := sStr;
Message("Verzeichnis " + sFolder + " wurde gelesen.", "Verzeichnis lesen");
EndProc;
|
Procedure AuswahlJPGoderGIFBild: String
..#1. Aktuelle Verzeichnis merken.
..#2. Verzeichnis wechseln + Dateiauswahl
..#3. Arbeitsverzeichnis zurücksetzen
VarDef sOrgDir : String;
sOrgDir := GetDir(0);
T-Eingabe := "C:\Demo\*.JPG";
ChDir("C:\Demo");
IF ChoosePicture("Bilddatei auswählen", 32 + 64) = 1
ChDir(sOrgDir);
RETURN T-Eingabe;
ELSE
ChDir(sOrgDir);
RETURN "";
END
ENDPROC;
|
..# ....Zeilenumbruch mittels Chr(13) + Chr(10) ..# Als Konstante definiert: CRLF = Chr(13) + Chr(10); oder als DEF DEF = Chr(13) + Chr(10); oder als VAR Var CCRLF = Chr(13) + Chr(10); ..# ....Zeilenumbruch in einem String setzen (als Prozedur) ..# Procedure SetCRLF(nTimes:Integer):String; ..#setzt zeilenumbruch in einem string ..#ntimes = anzahl zeilenumbrüche die gesetzt werden ..## Var CCRLF = Chr(13) + Chr(10); Vardef i : Integer; Vardef sStr : String; sStr := ""; ?nTimes <= 0 / Return sStr NLoop(i, nTimes - 1, sStr := sStr + CCRLF); Return sStr Endproc; ..# ....Sonderzeichen ..# Verschiedene Sonderzeichen: Chr(9) = Tab Chr(13) = Return Chr(184) = © = Copyright |
....Sonderzeichen ..# Verschiedene Sonderzeichen: Chr(9) = Tab Chr(13) = Return Chr(184) = © = Copyright |
....Zeilenumbruch mittels Chr(13) + Chr(10) ..# Als Konstante definiert: CRLF = Chr(13) + Chr(10); oder als DEF DEF = Chr(13) + Chr(10); oder als VAR Var CCRLF = Chr(13) + Chr(10); |
....Zeilenumbruch in einem String setzen (als Prozedur) ..# Procedure SetCRLF(nTimes:Integer):String; ..#setzt zeilenumbruch in einem string ..#ntimes = anzahl zeilenumbrüche die gesetzt werden ..## Var CCRLF = Chr(13) + Chr(10); Vardef i : Integer; Vardef sStr : String; sStr := ""; ?nTimes <= 0 / Return sStr NLoop(i, nTimes - 1, sStr := sStr + CCRLF); Return sStr Endproc; |
Als Konstante definiert: CRLF = Chr(13) + Chr(10); oder als DEF DEF = Chr(13) + Chr(10); oder als VAR Var CCRLF = Chr(13) + Chr(10); |
Zeilenumbruch im Text darstellen mittels "Zeile 1" + Chr(13) + Chr(10) + "Zeile 2". oder DEF CRLF = Chr(13) + Chr(10); "Zeile 1" + CRLF + "Zeile 2". Gilt auch für die Funktion Message. |
Procedure Tabelle_alle_Einträge_löschen(nTabelle : Integer; sTabelle : String):integer
..#alle einträge der tabelle <nTabelle> unwiderruflich löschen
..#rückgabe: 0 = OK, 1 = fehler/abbruch
Vardef nCnt : Integer;
Vardef sHdg : String;
..#parameter prüfen und Vorgaben setzen
?nTabelle = 0 / Return 1
?sTabelle = "" / Return 1
sHdg := sTabelle + " alle Einträge löschen"
..#anzahl einträge
nCnt := FileSize(nTabelle);
If nCnt = 0
Meldung_Fehler("Abbruch: " + sTabelle + " nicht gefunden.", sHdg);
Return 1
End;
If Message("Wollen Sie wirklich alle " + sTabelle + " (#" + Str(nCnt) + ") unwiderruflich löschen?", sHdg, 2) <> 1
Return 1
End;
Try
..#alle einträge löschen
ClearDat(nTabelle);
..#autonummer wieder auf 1 setzen
SetAuto(nTabelle, 1);
..#indices regenieren
RegenAll(nTabelle);
..#anzeige aktualisiere
Refresh;
Except
Meldung_Fehler("Einträge der " + sTabelle + " konnten nicht gelöscht werden!", sHdg);
Return 1
End;
..
Meldung_Info("Alle Einträge der " + sTabelle + " (#" + Str(nCnt) + ") wurden gelöscht.", sHdg);
Return 1
|
Procedure Zeige_Zwischenablage;
..#zeigt den inhalt der zwischenablage
..##
Var CHDG = "Inhalt der Zwischenablage zeigen";
Var CERR1 = "Abbruch: Datei zur Speicherung Inhalt Zwischenablage konnte nicht gelesen werden.";
Var CERR2 = "Abbruch: Die Zwischenablage ist leer.";
Vardef sStr : String;
Vardef nFH : Integer;
..#inhalt zwischenablage zum ramtext kopieren
Clip2Text;
nFH := Reset("RAMTEXT");
If nFH = 0
Message(CERR1, "Fehler - " + CHDG);
Return
End;
While Not EOT(nFH)
sStr := sStr + ReadLn(nFH) + Chr(13) + Chr(10);
End;
Close(nFH);
Message(sStr, CHDG);
EndProc;
|
..#format aktuellen computer setzen SetNumberFormats(-1, -1, -1); ..#datum und aktuelle zeit ausgeben, 3 = zeit in sekunden DateTimeStr(CombineDateTime(Today, Now), 3) ..#aktuelles datum und zeit in eine datei schreiben WriteLn(nFH, DateTimeStr(CombineDateTime(Today, Now), 3)); |
Var sStr : String; sStr := ""; sStr := sStr + "Heute " + DateTimeStr(CombineDateTime(Today, Now), 3); sStr := sStr + ", " + DayOfWeek(Today) + ", " + "Woche " + Str(Week(Today)); Message(sStr); Ausgabe ist: Heute 11.05.2009 08:39:21, Montag, Woche 20 |
Procedure GetFileFromDir(sPath : String) : String;
Vardef sSep : String
sSep := Choice(Sel(sPath := Exchange(sPath," ","") HAT "\"),"\",":")
Repeat
Until Not sPath := RightStr(sPath, Length(sPath) - POS(sSep, sPath)) HAT sSep
Return sPath
Endproc
Procedure Kopiere_Datei_zum_Verzeichnis;
..#datei zum einem verzeichnis kopieren
..##
T-Eingabe := "*.*";
If ChooseFile("Datei auswählen der zum " + TABELLE.Verzeichnis + "' kopiert werden soll.", "Bitmap|*.bmp|Gif|*.gif|Alle Dateien|*.*|") = 1
CopyFile(T-Eingabe, TABELLE.Verzeichnis + GetFileFromDir(T-Eingabe));
If IsFile(TABELLE.Verzeichnis + GetFileFromDir(T-Eingabe))
Message("Datei '" + T-Eingabe + "' zum Thema-Verzeichnis " + TABELLE.Verzeichnis + " kopiert!", "INFORMATION");
Else
Message("Datei '" + T-Eingabe + "' konnte NICHT zum Thema-Verzeichnis " + TABELLE.Verzeichnis + " kopiert werden!", "FEHLER");
End
Else
Return
End;
Endproc;
|
Procedure btnDBBackupBeimAnklicken;
..#eine sicherungsdatei der datenbank anlegen
..##
Var CDBBAKFILE = BaseDir + "meinprojekt.tdbd";
Var CHDG = "Datensicherung";
Var CINF = "Sicherungsdatei " + CDBBAKFILE + " erfolgreich angelegt!";
Var CERR = "Sicherungsdatei " + CDBBAKFILE + " konnte NICHT angelegt werden.";
Vardef nRT : Integer; ..#returncode von copyfile: 0 = OK, sonst windows fehlercode
nRT := CopyFile(CDBFILE, CDBBAKFILE);
If nRT <> 0
Message(CERR + " (Code = " + Str(nRT) + ")", CHDG)
Else
Message(CINF, CHDG);
End;
|
Procedure Notiz_zur_Zwischenablage;
..#kopiert den aktuellen tabelleneintrag zur zwischenablage
..##
DEF CCRLF = Chr(13) + Chr(10);
Vardef sStr : String;
If ReadRec($TABELLE, RecNo($TABELLE)) = 0
Return
End;
..#string initialisieren
sStr := "";
..#betreff als erstes
sStr := sStr + $TABELLE.Betreff + CCRLF;
..#memofeld beschreibung
sStr := sStr + $TABELLE.Beschreibung + CCRLF;
..#und kopieren
CopyStrToClipboard(sStr);
EndProc;
|
Gebe eine Meldung aus, wenn keine Datensätze gefunden wurden und beende
den Job entsprechend
..
.Epilog
.If Count($TABELLE) = 0
.Do Message("Abbruch: Keine Datensätze vorhanden!", "HINWEIS")
.ST
|
..#datenfenster definieren
VarDef dwDatenfenster: DataWnd;
..#und suchen
dwDatenfenster := FindDataWnd("TABELLE.Formular");
..#wenn nicht gefunden, dann abbruch
?NOT Assigned(dwDatenfenster) / Return
..#Daten ausgeben
..#Datensatznummer 123
dwDatenfenster.ShowRec(123);
..#aktueller Datensatz
dwDatenfenster.CurrentRecNo;
|
VarDef dwDatenfenster: DataWnd
..#prüfungen durchführen
..#anzahl adressen ermitteln, sind keine da dann abbruch
?FileSize($TABELLE) = 0 / Return
dwDatenfenster := DatenfensterSuchen("TABELLE.Formular");
?NOT Assigned(dwDatenfenster) / Return
..#gibt es markierte adressen
nSCnt := dwDatenfenster.StarNum;
If nSCnt = 0
Message("Es wurden keine markierte Einträge gefunden!", "Hinweis");
Return
End;
|
VarDef rDaysBetween : Real; rDaysBetween := $TABELLE.MyDateField2 - $TABELLE.MyDateField1; |
Beispiele: TABELLE.MyDateField TABELLE.MyDateTimeField VarDef dMyDate : Date; VarDef dtMyDateTime : DateTime; dMyDate := $TABELLE.MyDateField; dMyDateTime := $TABELLE.MyDateTimeField; |
Beispiel wie ein DateTimeFeld in einem Datenbankjob ausgegeben werden kann: $(@a8b $AUFGABEN.Aufgabe:100) $(@a8n DateTimeStr($AUFGABEN.AufgenommenAm,3):40) $(DateTimeStr($AUFGABEN.ErledigenBis,3):40) Hinweise Die Fontangabe @a8b definiert wird mittels .FONT a8b = Arial, 8, b DateTimeStr($AUFGABEN.AufgenommenAm,3):40 ausgegeben wird als dd.mm.YYYY ss:mm. Beispiel: 01.04.2009 11:11 |
Vardef sStr : String; sStr := ""; sStr := sStr + "Heute " + DateTimeStr(CombineDateTime(Today, Now), 3); sStr := sStr + ", " + DayOfWeek(Today) + ", " + "Woche " + Str(Week(Today)); |
If DBName(FileNo) = 'meintab.dat' //Tabelle gefunden... End; |
Procedure Projekttabellen-Liste;
..#listet alle tabellen eines projekts
..##
Vardef i : Integer;
Vardef sStr : String;
sStr := "Tabellenliste für Projekt <Projektname>" + Chr(13) + Chr(10);
sStr := "Anzahl Tabellen: " + Str(MaxFile) + Chr(13) + Chr(10);
For i := 1 To MaxFile
sStr := sStr + Str(i) + " : " + DBName(i) + Chr(13) + Chr(10);
Next
Message(sStr, "Liste der Tabellen");
Endproc;
|
Procedure Projekttabellen-Liste;
..#listet alle tabellen eines projekts
..##
Vardef i : Integer;
Vardef sStr : String;
sStr := "Tabellenliste für Projekt <Projektname>" + Chr(13) + Chr(10);
sStr := sStr + "Anzahl Tabellen: " + Str(MaxFile) + Chr(13) + Chr(10);
sStr := sStr + "-----------------------------------------" + Chr(13) + Chr(10);
sStr := sStr + "Nr : Tabellenname (#Datensätze)" + Chr(13) + Chr(10);
sStr := sStr + "-----------------------------------------" + Chr(13) + Chr(10);
For i := 1 To MaxFile
sStr := sStr + Str(i) + " : " + DBName(i) + " (#" + Str(FileSize(i)) + ")" + Chr(13) + Chr(10);
..oder nur der tabellenname
..sStr := sStr + Str(i) + " : " + DBName(i) + Chr(13) + Chr(10);
Next
sStr := sStr + Chr(13) + Chr(10);
sStr := sStr + "Stand: " + DateTimeStr(CombineDateTime(Today, Now), 3) + Chr(13) + Chr(10);
Message(sStr, "Liste der Tabellen");
..oder zum clipboard
..CopyStrToClipboard(sStr);
Endproc
|
.DEF CRLF = Chr(10) + Chr(13) |
In ein globales Modul verschiedene DEFs definieren, wie
DEF DEFCRLF = Chr(13) + Chr(10);
DEF DEFCRLF2 = Chr(13) + Chr(10) + Chr(13) + Chr(10);
Verwendung für Meldungen:
Message("Notiz " + DEFCRLF2 + GetField(NOTIZEN, LabelNo(NOTIZEN, "Betreff")) +
DEFCRLF2 + "ist leer!");
Die Definition von
DEF DEFCRLF2 = DEFCRLF + DEFCRLF;
vermeiden. Führt zu einer Fehlermeldung.
|
Verwendet wird die Funktionen MessageBoxW aus der Windows user32.dll.
dllproc MessageBoxW(hWnd: Integer;
lpText: String;
lpCaption: String;
dwType: Integer): Integer Library 'user32.dll';
Procedure Meldung_Fehler(sMeldung, sÜberschrift : String);
..#standard fehlermeldung plus überschrift
..#Falls error.meldung <> "" wird diese auch noch mit ausgegeben
Var CCRLF2 = Chr(13) + Chr(10) + Chr(13) + Chr(10);
Vardef sMsg : String; ..die meldung die ausgegeben wird
sMsg := sMeldung;
If Error.Meldung <> ""
sMsg := sMsg + CCRLF2;
sMsg := sMsg + "Beschreibung: " + Error.Meldung;
sMsg := sMsg + " (" + Str(Error.Number) + ")";
End;
..#überschrift anpassen
?sÜberschrift = "" / sÜberschrift := "Fehler";
MessageBoxW(0, sMsg, sÜberschrift, MB_OK + MB_ICONERROR);
..Message(sMsg, sÜberschrift, 1);
EndProc;
Procedure Meldung_Warnung(sMeldung, sÜberschrift : String);
..#standard hinweismeldung plus überschrift
?sÜberschrift = "" / sÜberschrift := "Warnung";
MessageBoxW(0, sMeldung, sÜberschrift, MB_OK + MB_ICONWARNING);
..Message(sMeldung, sÜberschrift, 1);
EndProc;
Procedure Meldung_Info(sMeldung, sÜberschrift : String);
..#standard infomeldung plus überschrift
?sÜberschrift = "" / sÜberschrift := "Information";
MessageBoxW(0, sMeldung, sÜberschrift, MB_OK + MB_ICONASTERISK);
..Message(sMeldung, sÜberschrift, 1);
EndProc;
|
DLLProc ShellExecuteA(hwnd:Integer;LpOp:String;LPFile:String;LpPar:String;LpDir:String;nCmd:Integer):Integer Library "Shell32.dll"; Procedure Aufruf_URL; ..#Ein URL aufrufen ..## Vardef sUrl : String; Vardef nHdl : Integer; nHdl:= 0 sUrl := "http://www.rwblinn.de" ShellExecuteA(nHdl, "Open", sUrl, "", "", 1); EndProc; |
..#Im TurboPL Modul dllprocs definieren und als beispiel eine testaufruf
..#die rotsnet.dll enthält die prozeduren
DLLProc TSGetComputerName(Var sResult: string as LPStr) library "rotsnet.dll";
DLLProc TSGetCurrentUserName(Var sResult: string as LPStr) library "rotsnet.dll";
Procedure NetInfo;
..#computername und benutzer anzeigen
Vardef sComputerName, sCurrentUserName: String;
sComputerName := "<Unbekannt>";
TSGetComputerName(sComputerName);
sCurrentUserName := "<Unbekannt>";
TSGetCurrentUserName(sCurrentUserName);
Message("Computername: " + sComputerName + Chr(13) + Chr(10) + "Benutername: " + sCurrentUserName + Chr(13) + Chr(10));
Endproc;
..#In Delphi folgende Library definieren und die fertige dll im Projektverzeichnis kopieren
Library rotsnet;
Uses
ShellAPI, Windows, SysUtils;
{$R *.RES}
Procedure TSGetComputerName(pResult : PChar);StdCall; Export;
//lese computername
var
buffer: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
Size: Cardinal;
begin
Size := MAX_COMPUTERNAME_LENGTH + 1;
Windows.GetComputerName(@buffer, Size);
StrPLCopy(pResult, StrPas(buffer), 255);
end;
Procedure TSGetCurrentUserName(pResult : PChar);StdCall; Export;
var iLen: Cardinal;
var S : String;
begin
iLen := 255;
SetLength(S, iLen - 1);
if GetUserName(PChar(S), iLen) then
SetLength(S, iLen - 1)
else
begin RaiseLastWin32Error;
end;
StrPLCopy(pResult, S, 255);
end;
//
//EXPORTS
//
Exports
TSGetComputerName Index 1,
TSGetCurrentUserName Index 2;
Begin
End.
|
dllproc GetComputerNameW(Var lpBuffer: String; Var nSize: Integer): Integer Library 'kernel32.dll';
dllproc GetUserNameW(Var lpNameBuffer : String; nSize : Integer): Integer Library 'advapi32.dll';
Procedure ZeigeComputerName : String;
..#zeigt der aktuelle computername
..##
Vardef sResult : String;
Vardef nSize : Integer;
..#Init ist wichtig
nSize := 1024;
sResult := FillStr(' ', ' ', nSize);
Try
If GetComputerNameW(sResult, nSize) <> 0
Message("Computername: " + sResult, "Information")
Return sResult
Else
Message("Computername kann nicht ermittelt werden!", "Fehler");
Return ""
End;
Except
Message("Computername kann nicht ermittelt werden!", "Fehler");
Return ""
End;
Endproc;
Procedure ZeigeBenutzerName : String;
..#zeigt der aktuelle benutzername
..##
Vardef sResult : String;
Vardef nSize : Integer;;
..#Ini ist wichtig
nSize := 255;
sResult := FillStr(' ', ' ', nSize);
GetUserNameW(sResult, nSize);
Message("Username: " + sResult, "Information")
Return
..#funktioniert nicht. Warum?
Try
GetUserNameW(sResult, nSize);
Message("Username: " + sResult, "Information")
Return sResult
Except
Message("Benutzername kann nicht ermittelt werden!", "Fehler");
Return ""
End;
Endproc;
..#
..# Zweite Möglichkeit
..#
dllproc GetComputerNameW(var computerName: String; var size: Integer): Integer Library "Kernel32.dll";
dllproc GetUserNameW(var userName: String; var size: Integer): Integer Library "Advapi32.dll";
Procedure GetUserName: String;
Vardef Size: Integer;
Vardef UserName: String;
Size := 1024;
UserName := NTimes(" ", Size);
GetUserNameW(UserName, Size);
Return UserName
Endproc;
Procedure GetComputerName: String;
Vardef Size: Integer;
Vardef ComputerName: String;
Size := 1024;
ComputerName := NTimes(" ", Size);
GetComputerNameW(ComputerName, Size);
Return ComputerName
Endproc;
Procedure GetUserNameAndComputerName
Message(GetUserName + " sitzt an Rechner: " + GetComputerName);
Endproc;
|
..#Konstanten definieren aus der windows api
Var OCR_NORMAL = 32512; ..#normal als zeigen
Var OCR_WAIT = 32514; ..#sanduhr = warten
..#Windows api funktionen cursor laden und setzen
DLLProc LoadCursorA(hInstance: Integer; lpCursorName: Integer): Integer Library "user32.dll";
DLLProc SetCursor(hCursor: Integer): Integer Library "user32.dll";
.
procedure SetCursorTo(nM : Integer);
..#setzt den cursor.
..#cursor als sanduhr: SetCursorTo(OCR_WAIT); oder normal SetCursorTo(OCR_NORMAL)
..##
Vardef nC : Integer;
nC := LoadCursorA(0, nM);
SetCursor(nC);
Endproc;
..#Beispiel Cursor zeigen für lange operationen - zB suche mittels BySelection (TurboPL)
Try
SetCursorTo(OCR_WAIT);
ViewPage(-1);
..#erst alle datensätze anzeigen, dazu markierungen entfernen
SetSortOrder("MARKIERUNG");
AlleMarkierungenEntfernen(1);
SetSortOrder(sIndex);
..#dann datum suche durchführen
nRT := BySelection("LetzteAenderung >= " + sStr,1,1);
SetCursorTo(OCR_NORMAL);
sMsg := "";
|
DLLProc ShellExecuteW(hWnd: Integer; lpOperation: String; lpFile: String; lpParameters: String; lpDirectory: String; nShowCmd: Integer): Integer Library 'shell32.dll'; procedure Datei_Öffnen_Mit ..#Diese Proceudre zeigt den Öffnen-Mit-Dialog an. Als Parameter muss die Datei übergeben werden, auf die der Dialog reagieren soll. ..#Als Beispiel wird hier die datei text.txt angegeben ..## ShellExecuteW(0, 'open','rundll32.exe', 'shell32.dll,OpenAs_RunDLL ' + 'test.txt', "", 5); endproc; |
..#DLLProc definieren
dllproc MessageBoxW(hWnd: Integer; lpText: String; lpCaption: String; dwType: Integer): Integer Library 'user32.dll';
Procedure Meldung_Fehler(sMeldung, sÜberschrift : String);
..#standard fehlermeldung plus überschrift
..#Falls error.meldung <> "" wird diese auch noch mit ausgegeben
..#dieses beispiel braucht ein windows dll messageboxw
..##
Var CCRLF2 = Chr(13) + Chr(10) + Chr(13) + Chr(10);
Vardef sMsg : String; ..die meldung die ausgegeben wird
sMsg := sMeldung;
If Error.Meldung <> ""
sMsg := sMsg + + CCRLF2 + "Beschreibung: " + Error.Meldung + " (" + Str(Error.Number) + ")";
End;
..#überschrift anpassen
?sÜberschrift = "" / sÜberschrift := "Fehler";
MessageBoxW(0, sMsg, sÜberschrift, MB_OK + MB_ICONERROR);
..oder mittels TS message
..Message(sMsg, sÜberschrift, 1);
EndProg;
|
DLLProc ShellExecuteW(hWnd: Integer; lpOperation: String; lpFile: String; lpParameters: String; lpDirectory: String; nShowCmd: Integer): Integer Library 'shell32.dll'; Procedure Adresse_Mailen; ..#adresse mailen ..## ..Beispiel: ShellExecuteW(0, "", "mailto:robert@rwblinn.de", "", "", 5); Vardef sEMail : String; If $ADRESSEN.EMail <> "" sEMail := "mailto:" + $ADRESSEN.EMail; ShellExecuteW(0, "", sEMail, "", "", 5); End; Endproc; oder Procedure Tipp_Senden; ..## ..#sonderzeichen für zeilenumbruch im email text Var CCRLF = "%0D%0A"; ..Chr(13) + Chr(10); Vardef sWWW : String; ..erst mal ein wieder ein paar prüfungen ?FileSize(TIPPS) = 0 / Return ?ReadRec(TIPPS, RecNr(TIPPS)) = 0 / Return ..#adresse vorbelegen sWWW := "mailto:name@adresse.xyz?" sWWW := sWWW + "subject="+$TIPPS.Makro; sWWW := sWWW + "&body="+$TIPPS.Beschreibung; ..sonderzeichen umsetzen sWWW := Exchange(sWWW, Chr(13) + Chr(10), "%0D%0A"); ..#dll ausführen ShellExecuteW(0, "open",sWWW, "","",5); Endproc; |
..#Konstanten definieren (aus der windows api) const MB_OK = 0; const MB_OKCANCEL = 1; const MB_ABORTRETRYIGNORE = 2; const MB_YESNOCANCEL = 3; const MB_YESNO = 4; const MB_RETRYCANCEL = 5; const MB_ICONERROR = 16; const MB_ICONQUESTION = 32; const MB_ICONWARNING = 48; const MB_ICONASTERISK = 64; const MB_DEFBUTTON1 = 0; const MB_DEFBUTTON2 = 256; const MB_DEFBUTTON3 = 512; const MB_APPLMODAL = 0; const MB_SYSTEMMODAL = 4096; const MB_TASKMODAL = 8192; ..#Messagebox dll aus der user32.dll DLLproc MessageBoxW(hWnd: Integer; lpText: String; lpCaption: String; dwType: Integer): Integer Library 'user32.dll'; ..#Beispiele ..#procedure MessageBoxTest; ..#Beispiel ..# Vardef nType : Integer; ..# nType := MB_YESNOCANCEL + MB_ICONERROR; ..# MessageBoxW(0, "Testmeldung", "Testüberschrift", nType); ..#oder ..# MessageBoxW(0, sMsg, sÜberschrift, MB_OK + MB_ICONERROR); ..# MessageBoxW(0, sMeldung, sÜberschrift, MB_OK + MB_ICONWARNING); ..# MessageBoxW(0, sMeldung, sÜberschrift, MB_OK + MB_ICONASTERISK); ..#endproc; |
Definition von ShellExecuteA: DLLProc ShellExecuteA(hwnd:Integer;LpOp:String;LPFile:String;LpPar:String;LpDir:String;nCmd:Integer):Integer Library "Shell32.dll"; |
Eine Anwendung verwendet eine Tabelle um Einstellungen zu speichern. Diese Tabelle, auch Systemtabelle genannt, hat nur 1 Datensatz. Bei starten der Anwendung wird die Prozedur OnOpenProject ausgeführt. Bei der Ausführung wird der eine Datensatz der Systemtabelle gelesen. Kann der Datensatz nicht gelesen werden, erfolgt einen Programmabbruch. ..#Tabelle SYSTEM lesen ..#Die Anwendung wird abgebrochen, wenn die Systemtabelle nicht gelesen werden ..#kann Procedure OnOpenProject; Var CHDG = "Anwendung"; Var CERR = "Abbruch: Die Optionen können nicht gelesen werden!"; Var CINF = "Aktion: Anwendung neu installieren." Try MoveBegin(SYSTEM); ReadNext(SYSTEM); ..#Einträge aus der Systemtabelle lesen. ..# Except Message(CERR + Chr(13) + Chr(10) + CINF, CHDG); EndProg; EndProc; |
Procedure Zeige_Kundenfahrzeug;
Message("Fahrzeug des Kunden: " + EnumStr(KFZ, LabelNo(KFZ, "Art"),KUNDEN.Fahrzeug.Art));
EndProg;
|
Procedure Button1BeimAnklicken; ..## Vardef ExtStr: string; ExtStr := EnumStr(KFZ, LabelNo(KFZ, 'Art'), KFZ.Art); Message(ExtStr); Endproc; |
Procedure BerichtDruckenBeimAnklicken;
..#der druckermodus ist in eine SYSTEM tabelle wie folgt definiert:
..#Feld: VorgabeDruckModus
..#Typ: Enum, Size: 20
..#Specifikation: Druckdialog,Standard_Drucker,Druckvorschau,Datei
..##
Vardef nModus : Integer; ..#druckermodus
..#druckermodus ermitteln
nModus := EnumVal($SYSTEM, LabelNo($SYSTEM, "VorgabeDruckModus"), Str($SYSTEM.VorgabeDruckModus)) - 1;
..#und bericht ausgeben
Run("TABELLE.MeinBericht", nModus);
Endproc;
|
procedure ZeigeFehlermeldung; ..#ausgabe der error werte ..## Var CCRLF = Chr(13) + Chr(10); Var sMsg = ""; sMsg := sMsg + "Nummer:" + Str(Error.Nummer)+ CCRLF; sMsg := sMsg + "Meldung:" + Error.Message + CCRLF; sMsg := sMsg + "Beschreibung:" + Error.Description+ CCRLF; Message(sMsg, "Fehler", 1); endproc; |
Tabelle A, der mit der Tabelle B verknüpft ist, Sätze zur Weiterbearbeitung markieren, die keinen Eintrag in Feld X, Tabelle B haben: EsGibt(TabelleB,TabelleB.X#"") |
Vardef sStr : String; ..#Zeichenkette mit Platzhalter Vardef sTStr : String; ..#Hilfszeichenkette ..#Platzhalter ersetzen sStr := Exchange(sStr, "%d%", DateStr(ToDay)); sStr := Exchange(sStr, "%z%", TimeStr(Now)); sStr := Exchange(sStr, "%dz%", DateTimeStr(CombineDateTime(ToDay, Now))); sStr := Exchange(sStr, "%jmt%", Str(Year(ToDay)) + Str(Month(Today),2,0,"","0") + Str(Day(Today),2,0,"","0")); sStr := Exchange(sStr, "%h%", DayOfWeek(Today) + ", den " + DateStr(ToDay) + " um " + TimeStr(Now)); sStr := Exchange(sStr, "%w%", "Woche " + Str(Week(ToDay))); sStr := Exchange(sStr, "%t%", DayOfWeek(Today)); sStr := Exchange(sStr, "%m%", Choice(Month(Today), "Jan","Feb","Mär","Apr","Mai","Jun","Jul","Aug","Sep","Okt","Nov","Dez")); sStr := Exchange(sStr, "%j%", Str(Year(ToDay))); sTStr := ""; sStr := Exchange(sStr, "%kl%", "..#" + FillStr(sTStr, '*', 77)); sStr := Exchange(sStr, "%n%", Chr(13) + Chr(10)); |
Procedure MeldungSetzen(sMsg: string): string; ..#setzt eine Erstellungsmeldung unten am fenster ..## Vardef sTmp : String; sTmp := sMsg; ?Pos( "%Datum", sTmp) > 0 / sTmp := Exchange(sTmp, "%Datum", DateStr(ToDay)); ?Pos( "%Date", sTmp) > 0 / sTmp := Exchange(sTmp, "%Date", DateStr(ToDay)); ?Pos( "%Zeit", sTmp) > 0 / sTmp := Exchange(sTmp, "%Zeit", TimeStr(Now)); ?Pos( "%Time", sTmp) > 0 / sTmp := Exchange(sTmp, "%Time", TimeStr(Now)); Return sTmp; Endproc; |
Procedure ReplaceMsgToken(sToken, sMsg : String) : String;
..##
Vardef sTMsg, sTmp : String;
Vardef nP : Real;
?(sMsg = "") Or (sToken = "") / Return sMsg
sTMsg := "";
sToken := Lower(sToken);
If Pos(sToken, Lower(sMsg)) > 0
While nP := Pos(sToken, Lower(sMsg)) > 0
?sToken = "%c%" / sTMsg := sTMsg + sMsg[1, nP - 1] + Chr(13) + Chr(10);
?sToken = "%t%" / sTMsg := sTMsg + sMsg[1, nP - 1] + " ";
?sToken = "%d%" / sTMsg := sTMsg + sMsg[1, nP - 1] + DateStr(Today);
?sToken = "%z%" / sTMsg := sTMsg + sMsg[1, nP - 1] + TimeStr(Now);
sTmp := sMsg[nP + 3, 255];
sMsg := sTmp;
End;
End;
sTMsg := sTMsg + sMsg;
Return sTMsg;
Endproc;
|
Vardef sStr : String; sStr := Exchange(sStr, "%d%", DateStr(ToDay)); sStr := Exchange(sStr, "%z%", TimeStr(Now)); sStr := Exchange(sStr, "%dz%", DateTimeStr(CombineDateTime(ToDay, Now))); sStr := Exchange(sStr, "%jmt%", Str(Year(ToDay)) + Str(Month(Today),2,0,"","0") + Str(Day(Today),2,0,"","0")); sStr := Exchange(sStr, "%h%", DayOfWeek(Today) + ", den " + DateStr(ToDay) + " um " + TimeStr(Now)); sStr := Exchange(sStr, "%w%", "Woche " + Str(Week(ToDay))); sStr := Exchange(sStr, "%t%", DayOfWeek(Today)); sStr := Exchange(sStr, "%m%", Choice(Month(Today), "Jan", "Feb", "Mär", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")); sStr := Exchange(sStr, "%j%", Str(Year(ToDay))); Ausgabe: Datum = 13.08.2009 Zeit = 09:30 Datum + Zeit = 13.08.2009 09:30 Datum JJJMMTT = 20090813 Heute = Donnerstag, den 13.08.2009 um 09:30 Woche = Woche 33 Tag = Donnerstag Monat = Aug |
VarDef sTStr : String; sTStr := ""; ..#zeilenumbruch sTStr := Exchange($TABELLE.MemoFeld, Chr(13) , "<BR>"); ..#leerzeichen sTStr := Exchange(sTStr, Chr(0) , " "); ..#leerzeichen sTStr := Exchange(sTStr, Chr(32) , " "); ..#tab |
Procedure Hilfe_Zeigen(sID : String);
..#hilfetext in einem modulen fenster zeigen
..#verwendet wird eine tabelle mit hilfetexte:
..#Tabelle HILFETEXTE, Felder Hilfsthema (S50), Hilfstext (Memo), HilfsID (AutoNUmmer)
..#sID ist die autonummer des hilfetextes
..#Beispielaufruf: Hilfe_Zeigen("1");
..#alternativ kann auch ein feld mit zum beispiel formularname verwendet werden
..#Beispielaufruf: Hilfe_Zeigen("Formular 1");
..##
Vardef nRNo : Integer;
nRNo := Findrec(HILFSTEXTE, sID, "HILFSTEXTE.INR", 1);
If nRNo > 0
ExecDialog("HILFSTEXTE.hilfstexte-Formular", nRNo);
Else
Message("Hilfetext nicht gefunden!", "Hinweis");
End;
EndProg;
|
Wenn in einem Formular ein ExecMacro eine andere Tabelle ausgeführt wird, kann es vorkommen, daß nachdem Datensätze markiert sind und ein Formular in Tabellensicht aufgerufen wird, keine Datensätze angezeigt werden. Hierzu folgenden Tipp wie die Datensätze angezeigt werden: Statt Makro-Befehl EXECMACRO(Tabelle, Ausdruck...), den Befehl ACTIVATEFORM(Formular);EXECMACRO(Tabelle, Ausdruck...) verwenden. |
Aufruf: ExecMacro(ModulName, Prozedur 1, Prozedur n ) : Real Beispiel: ExecMacro(c:\daten\adres95\uti-pana, ProjektAnalyse,Zeige_ProjektAnalyseReport) Dieses Beispiel ruft nach einander die Prozeduren ProjektAnalyse und Zeige_ProjektAnalyseReport aus dem Modul uti-pana.prg auf. Mit der Funktion ExecMacro ist es Möglich eine Bibliothek von Moduleaufzubauen, die in den verschiedensten Projekte verwendet werden können. Das Beispiel analysiert alle Tabellen und Indizes in einem Projekt. |
Beispiel:
ExecMacro(SYSTEM,SystemMeldung("Test"));
SystemMeldung ist im Modul SYSTEM definiert.
Es erscheint die Fehlermeldung, daß das Modul SYSTEM nicht gefundenwerden kann.
Innerhalb des gleichen Moduls die Procedure direkt aufrufen. FürsBeispiel wäre das SystemMeldung(...) direkt.
|
ExecProg(Dateiname oder Feld[] oder Memo-Datenbankfeld) : Integer;
..#
..# Inhalt eines Formular Memos ohne Datenbankzuordnung ausführen
..# (Einfache Methode)
..#
procedure btnTestTurboPLBeimAnklicken;
..#formularmemo turbopl code ausführen. das memofeld ist kein datenbankfeld zugeordnet und
..#wird als objekt verwendet
..#Hinweis:
..#keine weitere prüfungen eingebaut
..#anstatt tempfile kann auch ramtext verwendet werden
..##
Var CTEMPFILE = BaseDir+"x.x";
Vardef nRT : Integer;
Vardef memoCtrl: Memo;
memoCtrl := FindControl("memoTestTurboPL") as Memo;
nRT := Rewrite(CTEMPFILE);
WriteLn(nRT, memoCtrl.Text);
Close(nRT);
nRT := ExecProg(CTEMPFILE);
If nRT <> 0
Message(Error.Message, "Fehler");
End;
DelFile(CTEMPFILE);
endproc;
..#
..# Inhalt eines Formular Memo ausführen (Ausführliche Methode)
..#
procedure btnTurboPLCodeAusfuehrenBeimAnklicken;
..#der code wird zeile für zeile gelesen und ausgeführt.
,,#der code befindet sich in ein memofled einer systemtabelle:
..#$SYSTEM.TurboPLMemo
..##
Var CCRLF = Chr(13) + Chr(10);
VarDef sTempPrg : String;
VarDef sTempMod : String;
VarDef nFH : Integer; ..handle für dateiöffnen
VarDef nRT : Integer; ..returncode execprog
VarDef i : Integer; ..counter
VarDef nFound : Integer; ..flag ob proc gefunden wurde
Vardef sProcname : String; ..die proc die gesucht wird
Vardef sLine : String; ..zeilenbuffer
Vardef asProcCode : String[]; ..codebuffer zeile für zeile
sTempPrg := "temp.prg";
sTempMod := "temp.mod";
..gibt es inhalt
If $SYSTEM.TurboPLMemo = ''
Message("Fehler: Kein Code definiert!", "Quellcode Ausführen");
Return
End;
..moduldatei setzen
sTempMod := BaseDir + sTempMod;
..öffne modul
If Copymemo($SYSTEM.TurboPLMemo, sTempMod) <> 0
Message("Fehler: Temporäre Datei '" + sTempMod + "' kann nicht erstellt werden!","Quellcode Ausführen");
Return
End;
nFH := Reset(sTempMod);
If nFH = 0
Message("Fehler: Temporäre Datei '" + sTempMod + "' kann nicht gelesen werden!","Quellcode Ausführen");
Return
End;
..
i := 0;
ClrArray(asProcCode);
While Not EOT(nFH)
sLine := ReadLn(nFH);
ReDim(asProcCode, i);
asProcCode[i] := sLine;
i := i + 1;
End;
Close(nFH);
If i = 0
Message("Abbruch: Code wurde nicht gefunden!");
Else
nFH := Rewrite(sTempPrg);
..erste und letzte zeile mit angaben procedure (prozedur) und endproc (endproz) löschen
..sonst werden die anweisungen nicht ausgeführt
asProcCode[0] := "";
asProcCode[High(1, asProcCode)] := "";
..schreibe in eine temp datei
NLoop(i, High(1,asProcCode), WriteLn(nFH, asProcCode[i]));
Close(nFH);
..NLoop(i, High(1,asProcCode), Message(asProcCode[i]))
..ExecProg(asProcCode);
..führe tempdatei aus
nRT := ExecProg(sTempPrg);
..falls fehler
If nRT > 0
Message("Fehler bei der Ausführung ' Fehlercode = " + Str(nRT) + CCRLF + Error.Message, "Quellcode Ausführen");
End;
..tempdateien löschen
DelFile(sTempMod);
DelFile(sTempPrg);
End;
endproc;
|
procedure Anwendung_ausführen;
..#beispiel prozedur zur prüfung des übergabeparameters
..##
Var CHDGF = "Fehler - Anwendung ausführen";
Vardef nRT : Integer;
Vardef sAnwendung : String;
sAnwendung := "test.exe";
If Not IsFile(sAnwendung)
Message("Abbruch: Anwendung '" + sAnwendung + "' nicht gefunden!", CHDGF);
Return
End;
Try
nRT := Execute(sAnwendung, 1);
Except
Message("Die Anwendung '" + sAnwendung + "' konnte nicht ausgeführt werden!", CHDGF);
End;
endproc;
|
Procedure AppExecute(sAppType: string; sApp: string; sFile: string; nTask: Integer);
..#eine anwendung ausführen, dabei fehlerbehandlung übernehmen
..##
Vardef nRT : Integer;
If sApp = ""
Message("Abbruch: '" + sAppType + "' nicht angegeben.", "Fehler - Anwendung ausführen");
Return
End;
..nur check wenn pfadangabe, sonst wird path durchsucht
If sApp hat "\"
If (IsFile(sApp) = 0)
Message("Abbruch: '" + sAppType + "' nicht gefunden (" + sApp + ").", "Fehler - Anwendung ausführen");
Return
End;
End;
..wenn sfile ist - dann keine prüfung
If sFile = "-"
sFile := ""
End
If sFile <> ""
nRT := Execute(sApp + " " + sFile, nTask);
Else
nRT := Execute(sApp, nTask);
End;
If nRT > 0
Message("Abbruch: '" + sApp + "' konnte nicht ausgeführt werden.", "Fehler - Anwendung ausführen");
End;
Endproc;
|
Dateien, wie txt, ini etc. können direkt mittels Execute ausgeführt werden. Beispiele: Vardef sAnwendung : String; sAnwendung := '"C:\Dokumente und Einstellungen\rwblinn\Anwendungsdaten\dataWeb\TurboDB Studio\turbodbstudio.ini"'; Execute(sAnwendung); Vardef sAnwendung : String; sAnwendung := "meinehilfedatei.chm"; Execute(sAnwendung); |
Procedure Nachricht_Senden; ..#email nachricht aus eine tabelle senden ..#anstatt eines strings kann auch ein memofeld verwendet werden ..## ..#Sonderzeichen für zeilenumbruch im email text Var CCRLF = "%0D%0A"; ..# ist Chr(13) + Chr(10); Vardef sWWW : String; ..erst mal ein wieder ein paar prüfungen ?FileSize($TABELLE) = 0 / Return ?ReadRec($TABELLE, RecNr($TABELLE)) = 0 / Return ..#adresse vorbelegen sWWW := "mailto:name@adresse.xyz?" sWWW := sWWW + "subject="+$TABELLE.Betreff; sWWW := sWWW + "&body="+$TABELLE.Nachricht; ..#sonderzeichen umsetzen sWWW := Exchange(sWWW, Chr(13) + Chr(10), "%0D%0A"); ..#Execute Execute(sWWW) ..#oder mittels DLL - diese muss erst mit DLLPROC definiert werden ..#ShellExecuteW(0, "open",sWWW, "","",5); Endproc; |
Procedure Nachricht_Senden; ..#email nachricht aus eine tabelle senden ..## ..#Sonderzeichen für zeilenumbruch im email text Var CCRLF = "%0D%0A"; ..# ist Chr(13) + Chr(10); Vardef sWWW : String; ..#erst mal ein wieder ein paar prüfungen ?FileSize($TABELLE) = 0 / Return ?ReadRec($TABELLE, RecNr($TABELLE)) = 0 / Return ..#adresse vorbelegen sWWW := "mailto:name@adresse.xyz?" sWWW := sWWW + "subject="+$TABELLE.Betreff; sWWW := sWWW + "&body="+$TABELLE.Nachricht; ..#sonderzeichen umsetzen sWWW := Exchange(sWWW, Chr(13) + Chr(10), "%0D%0A"); ..#Execute Execute(sWWW) Endproc; |
procedure Code_Senden; ..#Code als email senden ..#Syntax für mailto: ..#mailto:name@adresse.de?subject=Meine Nachricht&cc=kopiean@adresse.de&body=Der Nachrichten Text ..## ..#Sonderzeichen für zeilenumbruch im email text Var CCRLF = Chr(13) + Chr(10); Var CECR = "%0A"; ..# ist Chr(13) + Chr(10); Var CECRLF = "%0A%0A"; ..# ist Chr(13) + Chr(10); Var CHDG = "EMail senden"; Var CERR1 = "Abbruch: Keine Einträge vorhanden."; Var CERR2 = "Abbruch: Eintrag kann nicht gelesen werden."; Vardef sStr : String; ..#email Vardef sEmpfaenger : String; ..#empfaenger name@adresse.de Vardef nRT : Integer; ..#return code ..#erst mal ein wieder ein paar prüfungen If FileSize($CODE) = 0 Message(CERR1, "Fehler - " + CHDG); Return End; If ReadRec($CODE, RecNr($CODE)) = 0 Message(CERR2, "Fehler - " + CHDG); Return End; sEmpfaenger := "name@adresse.de"; nRT := Input("Empfänger Adresse: ", CHDG, 0, sEmpfaenger); ?nRT = 0 / Return ?sEmpfaenger = "" / Return sStr := "mailto:" + sEmpfaenger + "?" sStr := sStr + "subject="+$CODE.Thema; sStr := sStr + "&body="+$CODE.Code; ..#sonderzeichen umsetzen sStr := Exchange(sStr, CCRLF, CECRLF); ..#Execute Execute(sStr); Endproc; |
Procedure Hilfe_Zeigen_Kontext(sKontextID:String);
..#zeigt die htmlhelp kontextseite sKontextID
..#Beispiel: aufruf hilfe zu einstellungen mittels Hilfe_Zeigen_Kontext("144972385");
..##
Execute("hh.exe -mapid " + sKontextID + " " + BASEDIR+"projekt.chm");
Endproc;
..#Beispiel
Procedure Hilfe_Zeigen_Einstellungen;
..#zeigt die html hilfe zu den einstellungen
..##
Hilfe_Zeigen_Kontext("144972385");
Endproc;
|
Procedure refInfoReadmeBeimAnklicken;
..#die textdatei readme.txt aus dem projektverzeichnis lesen
..##
Vardef sReadme : String;
sReadme :=BaseDir + "readme.txt";
If IsFile(sReadme)
Execute(sReadme)
Else
Message("Abbruch: Die Readme Datei nicht gefunden.", "Readme lesen");
End;
EndProc;
|
Enthält der Übergabeparameter Leerzeichen, dann muss der Übergabeparameter in doppelte Anführungszeichen gesetzt werden:
Execute('"c:\programme\mein programm\mit leerzeichen.exe"')
Mit einer TurboDBStudio-Variable geht es jedenfalls so:
Vardef sDateiName : String;
sDateiName := "meinedatei.txt";
Execute('"c:\programme\mein programm\mit leerzeichen.exe" "' + sDateiName + '"');
Zu Beachten:
Sowohl der Pfad des zu startenden Programms als auch der Pfad
der zu ladenden Datei von Anführungszeichen (keine Hochkommas!) umschlossen sein
sollten um Probleme mit Leerzeichen im Pfad zu vermeiden.
|
SetSortOrder gibt keine Meldung aus, wenn der Übergabeparameter(Indexdatei) im aktuellen Verzeichnis nicht gefunden wurde.
Dieses Problem läßt sich wie folgt umgehen:
Vardef sDatei : String;
sDatei := "Executeparameter";
IF Exists(sDatei) = 2
Message("Kann Programm " + sDatei + " nicht finden.", "Fehler");
Halt;
END
|
Procedure PotenzFunktion(X: Real; Y:Real): Real Return Exp(Y*Log(X)) Endproc; Procedure Testpotenztfunktion; ..#test aufrufe für die potenzfunktion ..## Message(Str(PotenzFunktion(5, 8)), "5 hoch 8"); Message(Str(PotenzFunktion(5, 9 - 3)), "5 hoch (9 - 3)"); EndProc; |
FileNr : Real;
FileNr liefert die Nummer der aktuellen Primärtabelle
..#
..# Nummer einer Tabelle im aktuellen Projekt ermitteln
..#
Um die Nummer einer Tabelle im aktuellen Projekt zu ermitteln, VAL verwenden.
VAL("TABELLE1.DAT");
|
If FileSize($TABELLE) = 0
Message("Keine Datensätze für Tabelle " + DBName($TABELLE) + "gefunden!", "Hinweis");
End;
|
VarDef dwDatenfenster: DataWnd
Vardef GRIDCtrl: DataGrid;
..#Gibt es Einträge
?FileSize(ADRESSEN) = 0 / Return
?FileSize(KONTAKTE) = 0 / Return
..#Tabelle (Grid) suchen
GRIDCtrl := FindControl("dgAdressenKontakte") as DataGrid;
..#Gefunden
If Assigned(GRIDCtrl)
If Upper(IndName(KONTAKTE, IndNo(KONTAKTE))) = "KONTAKTETERMINDESC.IND"
GRIDCtrl.Sortierung("KONTAKTETERMINASC.IND");
Else
GRIDCtrl.Sortierung("KONTAKTETERMINDESC.IND");
End;
GRIDCtrl.AlleMarkierungenEntfernen(1);
End;
|
Procedure edMakroSuchenBeimÄndern;
..#kleines eingabefeld wo direkt nach einen wert gesucht werden kann
..##
Vardef EditCtrl : Edit;
Vardef nCnt : Integer;
Vardef sStr : String;
..#suche eingabe feld
EditCtrl := FindControl("edMakroSuchen") as Edit;
..#gefunden, dann suche makro
If Assigned(EditCtrl)
sStr := 'TIPPS.Makro wie "' + EditCtrl.Text + '*"';
..#Message(sStr, EditCtrl.Text);
nCnt := BySelection(sStr, 0, 2);
End;
endproc;
|
..#npage auf -1 = nicht gefunden
nPage := -1;
..#suche pagecontrol und ermittle aktive seite
pageCtrl := FindControl("pcAdressenFormular") as PageControl;
If Assigned(pageCtrl)
nPage := pageCtrl.ViewPage(0);
End;
..#jetzt schalter formular <> tabelle suchen und text anhand seite setzen
ButtonCtrl := FindControl("btnAdressenFormularListe") as Button;
If Assigned(ButtonCtrl)
?nPage = 1 / ButtonCtrl.Text := 'Liste';
?nPage = 2 / ButtonCtrl.Text := 'Formular';
End;
...
|
Procedure btnEinstellungenHauptordnerWaehlenBeimAnklicken;
..#Mittels Choosefolder den Hauptordner wählen und dann Feld Hauptordner
..#zuweisen
..##
Vardef EditCtrl : Edit;
Vardef sFolder: String;
Vardef nRT: Integer;
?GetMode = 0 / ModifyRecords;
nRT := ChooseFolder("Hauptordner wählen", sFolder);
..#bei 1 ist alles gut
If nRT = 1
..#jetzt verwenden wir editctrl um den wert zu setzen
..#suche eingabe feld
EditCtrl := FindControl("edEinstellungenHauptordner") as Edit;
..#gefunden, dann setze wert
If Assigned(EditCtrl)
EditCtrl.Text := sFolder;
End;
End;
EndProc;
|
procedure SetzeEditControlText(Var editCtrl : Edit; sEditCtrl: String; sText : String);
..#Setzt den Text für EditCtrl
..##
..#suche eingabe feld
editCtrl := FindControl(sEditCtrl) as Edit;
..#gefunden, dann setze wert
If Assigned(editCtrl)
editCtrl.Text := sText;
End;
endproc;
procedure SetzeEditControlHinweis(Var editCtrl : Edit; sEditCtrl: String; sHinweis : String);
..#Setzt den Hinweistext für EditCtrl
..##
..#suche eingabe feld
editCtrl := FindControl(sEditCtrl) as Edit;
..#gefunden, dann setze wert
If Assigned(editCtrl)
editCtrl.Hint := sHinweis;
End;
endproc;
|
..#datepicker 1
Vardef CtrlDP1 : DateTimePicker;
CtrlDP1 := FindControl("DateTimePicker1") as DateTimePicker;
..#datepicker 2
Vardef CtrlDP2 : DateTimePicker;
CtrlDP2 := FindControl("DateTimePicker2") as DateTimePicker;
..#werte auslesen, umwandeln und differenz tage ermitteln
rDaysBetween := Val(CtrlDP2.Text) - Val(CtrlDP1.Text);
..#und als string zurückgeben
Return "Anzahl Tage zwischen Datum 1 und 2: " + Str(rDaysBetween)
|
Procedure Button1BeimAnklicken;
..#erste möglichkeit mittels object
VarDef objFeld: Object;
objFeld := DatenfensterSuchen("SYSTEM.Optionen", "edSystemAdressenGeburtstageVoraus");
IF Assigned(objFeld)
Message("Gefunden");
Else
Message("NICHT Gefunden")
End;
..#
..#zweite möglichkeit mittels control
vardef EditCtrl: Edit;
EditCtrl := FindControl("edSystemAdressenGeburtstageVoraus") as Edit;
if Assigned(EditCtrl)
Message('edSystemAdressenGeburtstageVoraus gibt es.');
else
Message('edSystemAdressenGeburtstageVoraus gibt es nicht!');
end;
Endproc;
|
Das Kommando "as" verwenden um den Rückgabewert von FindControl umzuwandeln.
Procedure TESTLookupTable1BeimÄndern;
Vardef coLT: LookupTable;
coLT := FindControl("TESTLookupTable1") as LookupTable
If Assigned(coLT)
trace(coLT.Text)
End
Endproc;
|
procedure Button1BeimAnklicken;
..#einfacher taschenrechner.
..#dazu in einem formular folgende felder und schalter definieren:
..#3 editfelder; 1 radiogroup; 1 schalter
..##
Vardef i : Integer;
Vardef ctrlEdit1: Edit;
Vardef ctrlEdit2: Edit;
Vardef ctrlEdit3: Edit;
Vardef rgPlusMinus: RadioGroup;
Vardef nAction : Integer;
ctrlEdit1 := FindControl("Edit1") as Edit;
ctrlEdit2 := FindControl("Edit2") as Edit;
ctrlEdit3 := FindControl("Edit3") as Edit;
rgPlusMinus := FindControl("rgPlusMinus") as RadioGroup;
..#
if NOT Assigned(ctrlEdit1)
Message("Edit1 konnte nicht zugewiesen werden.");
Return;
end;
if NOT Assigned(ctrlEdit2)
Message("Edit2 konnte nicht zugewiesen werden.");
Return;
end;
if NOT Assigned(ctrlEdit3)
Message("Edit3 konnte nicht zugewiesen werden.");
Return;
end;
if NOT Assigned(rgPlusMinus)
Message("Radiogroup konnte nicht zugewiesen werden.");
Return;
end;
..#
Try
nAction := rgPlusMinus.ItemIndex;
?nAction = 0 / ctrlEdit3.Text := Str(Val(ctrlEdit1.Text) + Val(ctrlEdit2.Text));
?nAction = 1 / ctrlEdit3.Text := Str(Val(ctrlEdit1.Text) - Val(ctrlEdit2.Text));
?nAction = 2 / ctrlEdit3.Text := Str(Val(ctrlEdit1.Text) * Val(ctrlEdit2.Text));
?nAction = 3 / ctrlEdit3.Text := Str(Val(ctrlEdit1.Text) / Val(ctrlEdit2.Text),1, 2);
Except
Message(Error.Message, "Fehler");
End;
Refresh;
endproc;
|
Procedure TopicLinkZumClipboard(nDummy: real);
..#aus einem formular mit eine eingebette tabelle TOPICS werden der inhalt des
..#autonummer feld eines markierten records zum clipboard kopiert
DEF CRLF = Chr(13) + Chr(10);
Vardef oTT : Object;
Vardef nTRNo, nCnt, nLN, nLNLast : Real;
nCnt := 0;
..clipboard entleeren
CopyStrToClipboard("");
..keine topics in der eingebette tabelle, dann verlasse procedur
If LinkCount(TOPICS) = 0
Return
End;
..suche die eingebette topicstabelle
oTT := FindDataWnd("THEMA.Thema_Links", "TABLINKTOPICS");
..eingebette tabelle gefunden
If Assigned(oTT)
..oTT.SetSortOrder("TOPICS.ID",2);
..sind recorsd markiert?
If oTT.StarNum > 0
..gehe zum ende der tabelle
oTT.BottomOfTable;
..und ermittle die autonummer des letzten records
ReadRec(TOPICS, RecNr(TOPICS));
nLN := 0;
nLNLast := TOPICS.Laufende_Nummer;
..gehe wieder zum anfang der tabelle
oTT.TopOfTable;
..und durchlaufe die tabelle und prüfe ob records markiert (*) sind
Repeat
..lese record
ReadRec(TOPICS, RecNr(TOPICS));
..speichere die autonummer
nLN := TOPICS.Laufende_Nummer;
..wenn markiert dann kopiere zum clipboard
If oTT.IsStar
nCnt := nCnt + 1;
AddStrToClipboard("<[T:" + Str(TOPICS.Laufende_Nummer) + "]"+TOPICS.tTitel+">" + CRLF);
End;
..wenn aktuelle autonummer ungleich autonummer des letzten record ist gehe
..zum nächsten record
?nLN <> nLNLast / oTT.NextRecord;
..ende erreicht
Until nLN = nLNLast
End;
End;
..wenn keine records markiert waren, dann kopiere aktuelles record
If nCnt = 0
?ReadRec(TOPICS, RecNr(TOPICS)) = 0/ Return
AddStrToClipboard("<[T:" + Str(TOPICS.Laufende_Nummer) + "]"+TOPICS.tTitel+">");
End;
CloseWnd;
Endproc;
|
procedure btnAlbumAbspielenBeimAnklicken;
..#das aktuelle album abspielen. dabei werden im formular tabellengrid alle
..#mp3titel mit eine markierung gesetzt. dann die system routine mp3titelabspielen
..#aufgerufen. hier wird eine playlist generiert und der mp3player gestartet.
..#dann werden alle sichtbare markierungen entfernt.
..##
VarDef objDG: DataWnd; ..#die eingebette tabelle mit mp3titel
Vardef nRNo : Integer; ..#die jeweils aktuelle mp3titel record nummer
..#mp3titel tabelle im formular suchen
objDG := FindDataWnd("ALBUM.Alben", "dgAlbumMP3Titel");
..#gefunden
IF Assigned(objDG)
..#gehe zur anfang der tabelle und merke recno
objDG.TopOfTable;
nRNo := objDG.CurrentRecNo;
..#loope durch die tabelle so lange bis recno 0 ist
While nRNo <> 0
..#Message(Str(objDG.CurrentRecNo));
objDG.PutStar;
objDG.NextRecord;
..#sind wir schon am ende der tabelle gelangt?
If objDG.CurrentRecNo <> nRNo
nRNo := objDG.CurrentRecNo
Else
nRNo := 0;
End;
End;
..#mp3 titel abspielen
MP3TitelAbspielen("ALBUM.Alben", "dgAlbumMP3Titel");
..#und anschließend alle sichbare markierungen entfernen
objDG.RemoveAllStars(1);
..#und gehe wieder zum ersten eintrag
objDG.TopOfTable;
End;
endproc;
|
procedure GetWindow(window: Object): DataWnd
..#Gibt ein Fenster-Objekt zurück. Ist das Fenster nicht geöffnet, wird es geöffnet.
..#Verwendung:
..# VarDef wnd: Datawnd; ..#windowvar
..# ..window holen mittels syntax project.tabelle.formular
..# wnd := GetWindow(Project.Aufgaben.Aufgaben);
..# ..und mit dem window arbeiten, wie zB
..# wnd.SetSortOrder("AUFGABEN.ID", 0);
..# wnd.ViewPage(2);
..##
Vardef wndName: String; ..#fenster = formular name
Vardef wnd: DataWnd; ..#formular objekt
wndName := GetCompleteObjectName(window);
wnd := FindDataWnd(wndName);
if not Assigned(wnd)
ActivateForm(wndName);
wnd := FindDataWnd(wndName);
end;
if not Assigned(wnd)
Message("Formular '" + wndName + "' konnte nicht geöffnet werden.");
Halt;
end;
return wnd;
endproc;
|
procedure GetFileAttr(sFile:String; sAttr:String):String;
vardef nRT : Integer;
vardef FName, FAttributes, FFolder: string;
vardef FSize: Integer;
vardef FDate: Date;
vardef FTime: Time;
sAttr := Upper(sAttr);
nRT := FindFirstFile(sFile, "DHS", FName, FSize, FDate, FTime, FAttributes, FFolder);
CloseFindFile;
..#wurde die datei auch gefunden?
If nRT = 0
?sAttr = 'N' / Return FName;
?sAttr = 'S' / Return Str(FSize);
?sAttr = 'D' / Return DateStr(FDate);
?sAttr = 'T' / Return TimeStr(FTime);
?sAttr = 'X' / Return DateStr(FDate) + " " + TimeStr(FTime);
?sAttr = 'A' / Return FAttributes;
?sAttr = 'F' / Return FFolder;
?sAttr = 'P' / Return FFolder + FName;
Else
?nRT = -1 / Return "Allgemeiner Fehler"
?nRT = -2 / Return "Der Pfad in Mask ist ungültig, zum Beispiel weil er ein nicht vorhandenes Laufwerk oder Verzeichnis enthält."
?nRT = -3 / Return "Es wurde kein passender Verzeichniseintrag gefunden."
..#oder eingene fehlerbehandlung, dann leeren string als return und oben auskommentieren
..#Return ""
End;
endproc;
Obige Prozedur (vereinfacht) zur Verwendung in Datenbankjobs
.procedure GetFileAttr(sFile:String; sAttr:String):String;
..#aufrufbeispiel:
..#$("Letzte Änderung:":50 + GetFileAttr(BaseDir + "meindb.tdbd", "X"))
.vardef nRT : Integer;
.vardef FName, FAttributes, FFolder: string;
.vardef FSize: Integer;
.vardef FDate: Date;
.vardef FTime: Time;
.Do sAttr := Upper(sAttr);
.Do nRT := FindFirstFile(sFile, "DHS", FName, FSize, FDate, FTime, FAttributes, FFolder);
.Do CloseFindFile;
.If sAttr = 'N'
.Return FName
.End
.If sAttr = 'S'
.Return Str(FSize);
.End
.If sAttr = 'D'
.Return DateStr(FDate);
.End
.If sAttr = 'T'
.Return TimeStr(FTime);
.End
.If sAttr = 'X'
.Return DateStr(FDate) + " " + TimeStr(FTime);
.End
.If sAttr = 'A'
.Return FAttributes;
.End
.If sAttr = 'F'
.Return FFolder;
.End
.If sAttr = 'P'
.Return FFolder + FName;
.End
.endproc;
|
Procedure GetFileInfo(sFile: string) : String; ..#Dateiinformationen ermitteln und in einem Infofenster ausgeben ..## var CCRLF = Chr(13) + Chr(10); Vardef nRT : Integer; Vardef nS : Integer; Vardef sTmp, sF,sA,sV : String Vardef dD : Date; Vardef tT : Time; sTmp := ""; nRT := FindFirstFile(sFile, "DHS", sF, nS, dD, tT, sA, sV); ..#return code auswerten ..#0 = OK ?nRT = 0 / sTmp := sF + CCRLF + Str(nS) + CCRLF + DateStr(dD) + CCRLF + TimeStr(tT) + CCRLF + sA + CCRLF + sV + CCRLF; ?nRT = -1 / sTmp := "Allgemeiner Fehler"; ?nRT = -2 / sTmp := "Der Pfad in Mask ist ungültig, zum Beispiel weil er ein nicht vorhandenes Laufwerk oder Verzeichnis enthält."; ?nRT = -3 / sTmp := "Es wurde kein passender Verzeichniseintrag gefunden."; CloseFindFile; Return sTmp Endproc; |
Procedure GetTheFileDate(sFile: string) : String;
..#liefert das datei-datum + zeit
..#Parameter:
..#sFile = Dateiname
..#Rückgabe:
..#das datei-datum
Vardef sF, sA, sV, sTmp : String;
Vardef nRT, nS : Integer;
Vardef sD : Date;
Vardef sT : Time;
?sFile = "" / Return ""
?Lower(sFile) = "nul" / Return ""
sTmp := "";
If sFile hat "/"
sFile := sFile[1, Pos("/", sFile) - 1];
End;
nRT := FindFirstFile(sFile, "", sF, nS, sD, sT, sA, sV);
If nRT = 0
sTmp := DateStr(nD) + " " + TimeStr(nT);
Else
sTmp := "nicht vorhanden!";
End;
CloseFindFile;
?sFile = "" / sTmp := "";
Return sTmp
Endproc;
Procedure GetTheFileSize(sFile: string) : Integer;
..#liefert die dategroesse
..#Parameter:
..#sFile = Dateiname
..#Rückgabe:
..#dateigroesse
..##
Vardef sF, sA, sV, sTmp : String;
Vardef nRT, nS : Integer;
Vardef sD : Date;
Vardef sT : Time;
?sFile = "" / Return 0
sTmp := "";
If sFile hat "/"
sFile := sFile[1, Pos("/", sFile) - 1];
End
nRT := FindFirstFile(sFile, "", sF, nS, sD, sT, sA, sV);
CloseFindFile;
Return nS
Endproc;
Procedure GetTheFileInfo(sFile: string): string;
..#liefert dateidatum, zeit und groesse
..##
VarDef sTmp : String;
VarDef nSize : Real;
Vardef sResult : String;
sResult := "";
?sResult = "" / Return ""
nSize := GetTheFileSizeKB(sFile);
sTmp := Str(nSize,0,0,".") + " Kb.";
?nSize = 0 / sTmp := "";
Return GetTheFileDate(sFile) + " " + sTmp
|
..#Datenatz suchen
nRNo := FindRec(TABELLE,...)
If nRNo < 1 Or ReadRec(TABELLE, nRNo) < 1
..#Meldung ausgeben Datensatz nicht gefunden oder kann nicht gelesen werden
Else
If EditOn(TABELLE) = 1
Try
..#Änderungen durchführen und Satz speichern
WriteRec(TABELLE, nRNo);
Except
..#Meldung dass die Tabelle nicht bearbeitet werden kann
Finally
EditOff(TABELLE)
End
Else
..#Meldung dass die Tabelle nicht bearbeitet werden kann
End;
End;
|
Vardef nRT : Integer; Beispiel anhand Beispielprojekt KFZ: nRT := FindRec(KFZ, "Audi 80 1.8 S, 1991", GetFileName(Project.KFZ.Index_Standard), 1); |
nRNo := FindRec(TABELLE, Feld1 + "," + Feld2, "TABELLE.ID", 1); If nRNo > 0 Satz gefunden Hinweis: Feld1 und Feld2 sind alphanumerische Felder Der Index tabelle.id enthält die Felder die bei der Tabellen-Definitionin den Eigenschaften des Auto-Nummer Feldes eingetragen wurden. I.d.F. Feld1, Feld2 |
nRNo := FindRec(TABELLE, Str(KOPPELTABELLE.Laufende_Nummer) + "," +Feld1, "TABELLE.ID", 1); If nRNo > 0 Satz gefunden Hinweis: Feld1 ist ein alphanumerisches Feld |
nRNo := FindRec(TABELLE, Str(Laufende_Nummer), "TABELLE.INR", 1); If nRNo > 0 Satz gefunden Hinweis: Der Index tabelle.inr verwaltet das Auto-Nummer Feld |
Beispiel:
Try
..#suchen mittels index name
nRNo := FindRec(ADRESSEN, sName, "ADRESSEN.ID", 1);
If nRNo > 0
Meldung_Info("Name '" + sName + "' gefunden!", "Adressen nach Name Suchen");
ShowRec(nRNo);
End;
?nRNo = 0 / Meldung_Info("Name '" + sName + "' nicht gefunden!", "Adressen nach Name Suchen");
Except
Meldung_Fehler("Die Suchfunktion konnte nicht ausgeführt werden!", "Adressen nach Name Suchen");
End;
|
Der Dateiname befindet sich an der Position 1 bis 12 und
läßt sich mit folgende Möglichkeit extrahieren:
Vardef sDateiName : String;
Vardef s : String;
s := FirstDir("*.*", "A");
sDateiName := s[1, Pos(Chr(0),s) - 1];
Der Trick ist Chr(0) und nicht Chr(32) oder " " zu benutzen.
|
Objectname als String ermitteln
Parameter: Project.<Tabelle>.<Objectname>
..#
..# Datenbankjobname ermitteln
..#
Message(GetCompleteObjectName(Project.adressen.Adressenliste));
liefert
ADRESSEN.Adressenliste
Mittels Run könnte diesen Datenbankjob ausgeführrt werden:
Run(GetCompleteObjectName(Project.adressen.Adressenliste));
In den Projekteigenschaften wurde diese Datenbankjob wie folgt definiert:
Tabelle: ADRESSEN
Pfad: D:\Daten\tdbstudio\projekte\ropav\ber\ADRESSEN-Bericht.ber
Titel: Adressenliste
Beispiel als Prozedur:
procedure Adressenliste_Drucken
vardef sJob : String;
sJob := GetCompleteObjectName(Project.ADRESSEN.Adressenliste));
If sJob <> ""
Drucken(sjobName);
Else
Message("Fehler: Jobname konnte nicht ermittelt werden!");
End;
endproc;
|
Unterscheidung von Null und Leer
Frage:
Wie kann mit der Unterscheidung von Null und Leer geprüft werden, ob eine Null
eingetragen ist oder noch keine Eintragung erfolgt ist.
Lösungen
Lösung A:
Tabellensicht mittels Suchen mit Bedingung GetField(...) = "".
GetField liefert einen Leerstring oder "0" zurück.
Lösung B: Index auf das Integer Feld definieren. Dann in der Tabellensicht Suchen,
Integer Feld aufrufen. Eingabefeld leer lassen.
Es wird der erste Eintrag angezeigt. Mittels F3 zum Nächsten usw...
Lösung C:
Als Makro
MoveBegin($TESTTAB);
While ReadNext($TESTTAB)
If GetField($TESTTAB, LabelNo($TESTTAB, "Testinteger")) = ""
Message("Feld " + $TESTTAB.Teststring + " hat kein Wert");
End;
End;
|
Procedure Formular_Modus:String;
..#formular modus ermitteln (neu, betrachen, ändern
..##
VarDef dwDatenfenster: DataWnd;
dwDatenfenster := DatenfensterSuchen("TABELLE.Formular");
If Assigned(dwDatenfenster) = 0
Return ""
Else
If dwDatenfenster.GetMode < 0
Return ""
Else
Return 'Modus: ' + Choice(dwDatenfenster.GetMode+1, 'betrachten', 'ändern', 'neu eingeben', 'unbekannt');
End;
End;
EndProc;
|
Dazu ist ein DataWnd Variable notwendig.
Der Rückgabewert kann für ein Formelfeld (CalcLabel) verwendet werden.
Ausserdem ist diese Möglichkeit unter TS notwendig, wenn Datenbankjobs
ausgeführt werden.
Würde GetMode ohne dataWnd ausgeführt werden, erscheint eine Fehlermeldung, dass das Formular nicht gefunden werden kann.
Procedure Adressen_Modus:String;
..
VarDef dwDatenfenster: DataWnd;
dwDatenfenster := DatenfensterSuchen("ADRESSEN.Adressenformular");
IF Assigned(dwDatenfenster) = 0
Return ""
Else
If dwDatenfenster.GetMode < 0
Return ""
Else
Return 'Adressen: ' + Choice(dwDatenfenster.GetMode+1, 'betrachten', 'ändern', 'neu eingeben', 'Fehler');
End;
End;
EndProc;
|
Frage Das über ShowProgress eingeblendete Fenster verschwindet mit HideProgress nicht. Antwort Das Problem tritt auf: 1.Wenn den Aufruf aus onopenproject erfolgt. 2. Aus eine Prozedur aufgerufen wird, der einen Execdialog enthält. ExecDialog erlaubt keine weiteren Fenster. |
Hat die IMPORT-Tabelle eine Volltextsuche mit der Position an erster Stelle, dann ist das Feld für die Volltextsuche (Begriffe) an die letzte Stelle zu setzen. Erst dann können die Daten nach Reihenfolge importiert werden. Wenn das .REL-Feld die Reihenfolge stört, entsteht jeweils eine Verschiebung um 1 Feld ... Hat die IMPORT-Tabelle keine Volltextsuche muß beim Übernehmen auch die Reihenfolge der Zuweisung stimmen. |
Indexname suchen und Indexnummer zurückgeben
Procedure GibIndexNummer(Tabelle: Integer; IndexName: string): Integer
Vardef Result : Integer
Vardef i : Integer;
Vardef TempName : string;
Result := 0;
i := 1;
TempName := IndName(Tabelle, i)
Repeat
If Upper(TempName) = Upper(IndexName)
Result := i;
End
i := i + 1;
TempName := IndName(Tabelle, i)
Until TempName = ""
Return Result
Endproc;
Procedure Test
Message(Str(GibIndexNummer(ABC, "MeinIndex.ind")), "Indexnummer ist")
Endproc
|
Procedure Prüfe_Datum;
..##
Vardef nDatum : Integer;
Vardef sDatum : String;
T-Eingabe := DateStr(Today);
Input("Datum");
SetPara('ec 1');
nDatum := VAL(T-Eingabe);
SetPara('ec 0')
IF nDatum >= 1.1.1900 And nDatum <= 31.12.2099
Message("Datum '" + T-Eingabe + "' ist gültig...")
ELSE
Message("Datum '" + T-Eingabe + "' ist NICHT gültig...")
END
EndProc;
|
.Report
..
.Prolog
.PRIMTABLEIS TABELLE
..sortierung. hier ist es wichtig das nach Jahrx und Monatx sortiertwird, d.h.
..der Index der Tabelle muss Jahrx, Monatx sein. Entweder
..wird das über die Laufende_Nummer (=Autonummer) oder
..über eine separaten Index (z.B. jahrmnt.ind) definiert.
.ZUGRIFF TABELLE.ID
..
..Definition der Vars
.Var nRT = 0
.Var sDatum = ""
..
..Datum vorgeben.
..Hier ist das aktuelle datum, kann aber auch was anderes sein z.B."1997, 5")
.Var sDatum = DateStr(ToDay)
.Do T-Eingabe := DateStr(ToDay);
.Do nRT := Input("z.B. 1998, 9","Jahrx, Monatx");
.Do sDatum := T-Eingabe
..Rückgabe 0 dann beende Job
.If nRT = 0
.ST
.End
..
..Die Selektionskriterien sind die Felder "Jahrx" und "Monatx".
.Selektion Val(DateStr(TABELLE.Datumsfeld)) = Val(sDatum)
..
.Header
usw...
|
Procedure Projekttabellenstrukturliste_abfragen;
Var CCRLF = Chr(13) + Chr(10);
Vardef i,j : Integer
Vardef sStr : String; ..auswahl, d.h ergebnis von input
Vardef sListe : String; ..liste der tabellenfelder
Vardef asFelder : String[250]; ..array für die felder
..keine tabellen dann abbruch
?MaxFile = 0 / Return
..liste der tabellen erstellen um diese in der abfrage anzeigen zu können
sListe := "";
While j:=j+1 <= MaxFile
sListe := sListe + Lower(Exchange(Upper(DBName(j)),".DAT", "")) + CCRLF;
End;
..tabelle abfragen, dabei werden alle tabellen gezeigt
If Input("Bitte Tabelle eingeben. Liste der Tabellen:" + CCRLF + sListe, "Tabellenstruktur abfragen und kopieren", 0, sStr) = 0
Return
End;
|
Procedure Taschenrechner : Real;
Vardef sFrage : String;
sFrage := "";
Input(sFrage, "Taschenrechner");
Return Val(T-Eingabe)
EndProc;
...#Eine kleine Rechenspielerei.
Procedure Taschenrechner(A, B : Real)
Vardef sFrage : String;
sFrage := Str(A) + " mal " + Str(B) + " ist?";
Input(sFrage, "Rechentest");
If Val(T-Eingabe) ist A * B
Message("Sehr gut!")
Else
Message("Ist leider nicht richtig!");
End
EndProc;
|
Vardef wndD: DataWnd;
wndD := FindDataWnd('TABELLE.Formularname')
If wndD.IsStar
Message("Der Datensatz ist markiert.");
|
procedure btnTestBeimAnklicken;
..##
MoveBegin($TESTTAB);
While ReadNext($TESTTAB)
..#option 1
If IsUndef($TESTTAB.Testinteger)
Message("Feld " + $TESTTAB.Teststring + " hat kein Wert (undefiniert).");
End;
..#option 2
..If GetField($TESTTAB, LabelNo($TESTTAB, "Testinteger")) = ""
.. Message("Feld " + $TESTTAB.Teststring + " hat kein Wert (undefiniert).");
..End;
End;
Message("Fertig");
EndProc;
|
Label verfügt über ein undokumentierten dritten Parameter Koppelfeldausgabe vom Typ Real. NUR VDP Syntax: Label(Tabelle, Feldnummer, Koppelfeldausgabe : Real) : String; Werte: Koppelfeldausgabe = 1 bei Koppelfelder (L-Felder)wird die Datei in Klammern mit ausgegeben Koppelfeldausgabe = 0 keine Ausgabe der Datei bei Koppelfelder Test: Message(Label(KAPITEL, 1, 1), "mit Datei"); Message(Label(KAPITEL, 1, 0), "ohne Datei"); |
If sTmp <> "" sTmp := LeftStr(sTmp, Length(sTmp) - 2); End; anstatt If sTmp <> "" sTmp := sTmp[1, Length(sTmp) - 2]; End; |
LinkBlob(TABELL.BlobFeld, "", 1);
BlobFeld ist ein Real Feld welches den Zeiger auf die Verknüpfungspeichert.
..#Bild Laden
Procedure Bild_Laden;
?GetMode = 1 / ModifyRecords;
?GetMode = 2 / AppendNewRecords
T-Eingabe:="*.JPG"
IF ChooseFile("Bild Laden")
IF T-Eingabe
LinkBlob(MeineBilder, T-Eingabe, 1);
Attach
END
END
EndProc;
WICHTIG
Der Datensatz muß bereits gespeichert sein.
Das Linkblob funktioniert analog zum Speichern eines Memos und dazu ist es
erforderlich, daß der Datensatz bereits physikalisch angelegt ist.
Man kann in der Procedure zuerst einen leeren DAtensatz anlegen und
speichern und anschließend LinkBlob aufrufen.
VDP baut bei Öffnen der Tabellen anhand der Linkfelder eine Beziehung zwischen
den Tabellen auf. Diese kann unter Tabelle / Verknüpfungen eingesehen werden.
|
Verwende dazu LinkCount($ANGEKOPPELTE_TABELLE)
Beispiele:
Anzahl Datensätze angekoppelt an TABELLE: Str(LinkCount($TABELLE))
Vardef nCnt : Integer;
nCnt := LinkCount($TAB);
If nCnt = 0
Message("Keine angekoppelte Datensätze vorhanden!");
Else
Message(Str(nCnt) + " angekoppelte Datensätze vorhanden!");
End;
..#Datenbankjob: LinkSum/Count funktionieren nicht
Sollte LinkSum oder LinkCount nicht funktionieren, dann kann es sein daß die Reihenfolge der Tabellen eine Verknüpfung zwischen den beiden Tabellen vorangig herstellt.
In einem Datenbankjob kann das mit dem Kommando .Relation manuell umgestellt werden.
|
Sollten LinkSum/Count nicht funktionieren, dann kann es sein daß die Reihenfolge der Tabellen eine Verknüpfung zwischen den beiden Tabellen vorangig herstellt. |
..#LOGDATEI routinen
Procedure LogEintrag(sStr: string);
..#log eintrag in die logdatei basedir + ropav.log schreiben
Vardef sLogFile : String;
Vardef nFH : Integer;
sLogFile := BaseDir + "anwendung.log";
..#ist die logdatei nicht vorhanden, erstellt eine neue logdatei
..#und schreibe eine überschrift
If NOT IsFile(sLogFile)
nFH := Rewrite(sLogFile);
WriteLn(nFH, "Logdatei - Erstellt am " + DateTimeStr(CombineDateTime(Today, Now), 3));
WriteLn(nFH, FillStr("-", "-", 50));
Close(nFH);
End;
..#keine meldung angegeben, dann mache nichts
?sStr = "" / Return
..#die logdatei ist vorhanden, dann schreibe eintrag
nFH := TAppend(sLogFile);
If nFH > 0
WriteLn(nFH, DateTimeStr(CombineDateTime(Today, Now), 3) + ' : ' + sStr);
Close(nFH);
End;
EndProc;
|
Procedure CreateADir(sDir: string): real;
..#erstellt ein Verzeichnis in Zwischenschritte
..#Parameter: sDir : Verzeichnis welches erstellt werden soll
..#Rückgabe: 1 = Ok, 0 = Fehler
Vardef nRT, i : Real;
Vardef sTmpDir : String;
..keine angabe
?sDir = "" / Return 1
?sDir[Length(sDir)] <> "\"/ sDir := sDir + "\";
sTmpDir := "";
i := 1;
While i <= Length(sDir)
..Zwischenverzeichnis erstellen
If sDir[i] = "\"
nRT := MakeDir(sTmpDir);
sTmpDir := sTmpDir + sDir[i];
Else
sTmpDir := sTmpDir + sDir[i];
End
i := i + 1;
End
If IsFile(sTmpDir + "NUL")
Message(sTmpDir + " erstellt.");
Return 1
Else
Message(sTmpDir + " konnte NICHT erstellt werden.");
Return 0
End;
EndProc;
|
MarkTable(Table, IndexTable: Real; SearchExpr: String; ExtABC,Operators: String; Mask: Real; Relations: String): Real;
..#
....Volltextsuche
..#
Beispiel: gesucht wird der Inhalt String sStr in der Tabelle VTINDEX. Die gefunde Einträge werden dann in Tabelle TIPPS markiert.
Die Tabelle STICHWORT enthält die Relation zwischen der Tabelle TIPPS und der Volltextindex Tabelle VTINDEX.
Vardef nRT : Integer; ..#Rückgabewert.
nRT := MarkTable($TIPPS, $VTINDEX, sStr, '', '', 0, $STICHWORT);
..#fehler?
Vardef sHStr : String;
If nRT >= 201 And nRT <= 204
?nRT = 201 / sHStr := "Ungültige Index-Tabelle";
?nRT = 202 / sHStr := "Ungültige Relation"
?nRT = 203 / sHStr := "Schließende Klammer erwartet"
?nRT = 204 / sHStr := "Ungültiges Zeichen"
Message(sHStr, "Fehler Volltextsuche"););
Return
End;
..#
....Volltextsuche mit Zahlen
..#
Wenn ein Volltextindex statt über die TurboDB Studio Oberfläche mit der TurboPL-Funktion ScanRecs erzeugt wird, kann ein
erweitertes Alphabet angeben (Parameter ExtABC) werden und dort Zahlen mit aufnehmen.
Nachdem der Volltextindex mit ScanRecs unter Verwendung von ExtABC erzeugt wurde, muß bei der Suche nun
ebenfalls das erweiterte Alphabet angegeben werden.
Es ist deshalb besser für die Suche die Funktion MarkTable zu verwenden.
..#
....Beispiel Volltextsuche
..#
PROCEDURE Volltextsuche
..#Beispiel einer Volltextsuche
..##
ACCESS(ADRESSEN, "ADRESSEN.ID");
DelMarks(ADRESSEN);
T-Eingabe := ""
IF INPUT("Bitte geben Sie Ihren Suchbegriff ein:")=1
T-Eingabe := UPPER(T-Eingabe)
MarkTable(ADRESSEN.DAT, STICHWOR.DAT, T-Eingabe,"","",0, STICHWOR.REL)
IF nMarks( ADRESSEN)>0
Showwait(STR( nMarks( ADRESSEN))+" Eintrag gefunden!")
ACCESS( ADRESSEN,"Markierung")
ATTACH;
SetSortOrder("ADRESSEN.ID",2)
SetView(2)
ELSE
Message("Keinen passenden Datensatz gefunden");
END
END
ENDPROC
|
Abfrage der Tabellenstruktur
Procedure Projekttabellenfeldliste_abfragen;
..#abfrage der tabellenfelder für eine tabelle
..##
Var CCRLF = Chr(13) + Chr(10); ..#zeilenumbruch für meldungen
Var CHDG = "Tabellenstruktur abfragen und kopieren";
Vardef i,j, n : Integer ..#laufvars
Vardef sTabelle : String; ..#tabelle der abgefragt wird
Vardef sListe : String; ..#liste der tabellenfelder
Vardef asTabellen : String[250]; ..#array für tabellen. dieses wird sortiert
Vardef asFelder : String[250]; ..#array für tabellen felder
?MaxFile = 0 / Return
..#liste der tabellen erstellen und diese in der abfrage anzeigen zu können
i := 0;
While j:=j+1 <= MaxFile
asTabellen[i] := Lower(Exchange(Upper(DBName(j)),".DAT", ""));
i := i + 1;
End;
..#strsort verwenden
n := i - 1;
StrSort(asTabellen, n);
NLoop(i, n, sListe := sListe + asTabellen[i] + CCRLF);
..#tabelle abfragen, dabei werden alle tabellen gezeigt
If Input("Liste der Tabellen:" + CCRLF + sListe + CCRLF + "Tabelle eingeben:", CHDG, 0, sTabelle) = 0
Return
End;
sTabelle := Upper(sTabelle);
j := 0;
While j:=j+1 <= MaxFile
If Exchange(Upper(DBName(j)),".DAT", "") = sTabelle
..Message( Exchange(Upper(DBName(j)),".DAT", ""));
..#liste alle feldlabel der tabelle auf
WHILE i:=i+1 <= MaxLabel(j)
asFelder[i] := "$" + Exchange(Upper(DBName(j)),".DAT", "") + "." + Label(j, i,1)
END;
..und sortiere
StrSort(asFelder, MaxLabel(j));
..und gebe in der feldliste aus
sListe := "";
NLoop(i, MaxLabel(j),sListe := sListe + asFelder[i] + CCRLF);
CopyStrToClipboard(sListe);
Message("Feldliste für Tabelle '" + Lower(sTabelle) + "' erstellt und zur Zwischenablage kopiert", "Hinweis - Projekttabellenfeldliste");
Return;
End;
End;
Message("Abbruch: Tabelle " + sTabelle + " nicht gefunden!", "Fehler - Projekttabellenfeldliste");
Endproc;
|
Ab TS4 enthält MemoStr eine zusätzlichen Parameter nLen = Anzahl Zeichen die gelsen werden sollen. Möglichkeiten: nLen = keine Angabe - die ersten 255 zeichen werden gelesen nLen = N - die ersten N Zeichen werden gelesen nLen = 0 - der gesamte Memoinhalt wird gelesen |
Mit MemoStr können die ersten 255 Zeichen eines Memos erhalten werden Diesen String kann weiter begrenzt werden: MemoStr(TABELLE.Memofeld)[1,100] |
Verwendet wird die Funktionen MessageBoxW aus der Windows user32.dll.
dllproc MessageBoxW(hWnd: Integer; lpText: String; lpCaption: String; dwType: Integer): Integer Library 'user32.dll';
Procedure Meldung_Fehler(sMeldung, sÜberschrift : String);
..#standard fehlermeldung plus überschrift
..#Falls error.meldung <> "" wird diese auch noch mit ausgegeben
Var CCRLF2 = Chr(13) + Chr(10) + Chr(13) + Chr(10);
Vardef sMsg : String; ..die meldung die ausgegeben wird
sMsg := sMeldung;
If Error.Meldung <> ""
sMsg := sMsg + + CCRLF2 + "Beschreibung: " + Error.Meldung + " (" + Str(Error.Number) + ")";
End;
..#überschrift anpassen
?sÜberschrift = "" / sÜberschrift := "Fehler";
MessageBoxW(0, sMsg, sÜberschrift, MB_OK + MB_ICONERROR);
..Message(sMsg, sÜberschrift, 1);
Endproc;
Procedure Meldung_Warnung(sMeldung, sÜberschrift : String);
..#standard hinweismeldung plus überschrift
?sÜberschrift = "" / sÜberschrift := "Warnung";
MessageBoxW(0, sMeldung, sÜberschrift, MB_OK + MB_ICONWARNING);
..Message(sMeldung, sÜberschrift, 1);
Endproc;
Procedure Meldung_Info(sMeldung, sÜberschrift : String);
..#standard infomeldung plus überschrift
?sÜberschrift = "" / sÜberschrift := "Information";
MessageBoxW(0, sMeldung, sÜberschrift, MB_OK + MB_ICONASTERISK);
..Message(sMeldung, sÜberschrift, 1);
Endproc;
|
Zeilenumbrüche können dargestellt werden mittels Chr "Zeile 1" + Chr(13) + Chr(10) + "Zeile 2". DEF CRLF = Chr(13) + Chr(10); "Zeile 1" + CRLF + "Zeile 2". Beispiel: Hilfetext ausgeben procedure btnQuickHelpBeimAnklicken; ..#schalter QuickHelp. Hilfetext zeigen beim anklicken ..## Var CCRLF = Chr(13) + Chr(10); Vardef sStr : String; sStr := ""; sStr := sStr + "Readme.txt enthält weitere Informationen" + CCRLF; sStr := sStr + "" + CCRLF; sStr := sStr + "Testlauf starten:" + CCRLF; sStr := sStr + "Schalter [Grafik zeigen] betätigen." + CCRLF; sStr := sStr + "Dann die beiden Anwendungen nebeneinander laufen lassen." + CCRLF; Message(sStr, "QuickHelp"); endproc; |
MitBedingung('DateStr($KONTAKTE.KontaktTermin) = DateStr(Today)', 1, 1);
|
Procedure Sondersuche;
If Input ('Name' , 'Suche') = 1
MitBedingung ('Volksmund = " '+ T-Eingabe + " ' , 1);
End;
Endproc;
|
Procedure Markierungen_Alle_Setzen;
MitBedingung('Laufende_Nummer > 0',2,2);
Endproc;
Procedure Markierungen_Alle_Entfernen;
MitBedingung('',3,2);
Endproc;;
|
Maximale Stringlänge ist 255.
Vardef sStr : string;
sStr := "vonkm > 20";
sStr := sStr + " und vonkg > 0";
OpenForm("STCKGUT.STCKGUT");
BySelection(sStr);
oder
sStr := "vonkm > 20";
sStr := sStr + " und vonkg > 20";
BySelection(sStr);
Sollte sStr nicht ausreichen, dann Tabellennamen und Felder abkürzen.
Hierbei die Tabellenstruktur beachten.
Es kann bis zum Feldnummer abgekürzt werden.
|
Ein Datumsfeld ist ein Real-Feld. Es muß daher mittels Str umgewandelt werden.
Vardef nDatum : Real;
..Ausgabe des Datums
Message("Gesucht wird nach Einträge mit Datum " + DateStr(nDatum));
MitBedingung("$TABELLE.MeinDatum="+DateStr(nDatum),1,1);
|
Procedure SystemUpdate(sField:String; sValue:String):Integer;
..#feld in der system tabelle aktualisieren
..#Bsp: SystemUpdate("MeineMeldung", "Hallo Welt");
..##
Vardef nFNo : Integer; ..#feldnr
Vardef nRT : Integer; ..#return code 0 = fehler, 1 = OK
..#noch ist alles nicht ok
nRT := 0;
..#feld label suchen
nFNo := LabelNr($SYSTEM, sField);
..#gefunden, dann setze neuen wert
If nFNo > 0
Try
MoveBegin($SYSTEM);
ReadNext($SYSTEM);
ModifyRec($SYSTEM);
SetField($SYSTEM, nFNo, sValue);
PostRec($SYSTEM);
nRT := 1;
Except
nRT := 0;
End;
End;
Return nRT;
EndProc;
|
Mit ModifyRecords setzt das Formular den aktuellen Datensatz in den Editiermodus. Das SQL-Statement möchte das auch tun, deshalb gibt es einen Konflikt. Wenn Sie mit SQL eine Tabelle ändern möchten, muss diese in allen Formularen auf Betrachten stehen, so wie sie ja auch nicht in zwei Formularen gleichzeitig dieselbe Tabelle editieren können. Man muss sich das so vorstellen, dass SQL nicht in einem Formular wirkt sondern separat, es besitzt eigene Kursors. Zum interaktiven Editieren sind daher nach wie vor die Befehle EditRec, PostRec etc. die richtigen. Mit SQL kann man vor allem komplexere Abfragen und Updates auf vielen Datensätzen realisieren. |
Bei Nachschlagefiltern, verwendet bei Nachschlagefelder, sind nur einfache statische Ausdrücke möglich. Wird eine dynamische Lösung benötigt, muss die Funktion BeimÖffnen des Nachschlage-Formulares zu implementieren. |
Procedure SetCRLF(nTimes:Integer):String; ..#setzt zeilenumbruch in einem string ..#ntimes = anzahl zeilenumbrüche die gesetzt werden ..## Var CCRLF = Chr(13) + Chr(10); Vardef i : Integer; Vardef sStr : String; sStr := ""; ?nTimes <= 0 / Return sStr NLoop(i, nTimes - 1, sStr := sStr + CCRLF); Return sStr Endproc; |
Dieses Problem ist ein grundsätzliches, weil den '-' als gültigen Bezeichner erlaubt ist. Da es Spalten- oder Variablennamen mit einem '-' geben kann muss bei einer Subtraktion ein Leerzeichen angegeben werden, sonst wird der Ausdruck als Bezeichner interpretiert. Demnach anstatt nTimes-1 Leerzeichen verwenden nTimes - 1 |
Procedure ShowMessageZentriert DEF CRLF = Chr(13) + Chr(10); DEF MSGLEN = 30 ..max zeilen länge Vardef sTmp, sLine1, sLine2, sLine3, sLine4 : String; sTmp := "Zeile 1"; sLine1 := NTimes(Chr(32), (30 - Length(sTmp)) DIV 2) + sTmp +NTimes(Chr(32), (30 - Length(sTmp)) DIV 2); sTmp := "Zeile 2 unterhalb Zeile 1"; sLine2 := NTimes(Chr(32), (30 - Length(sTmp)) DIV 2) + sTmp +NTimes(Chr(32), (30 - Length(sTmp)) DIV 2); sTmp := "Zeile 3 oberhalb Zeile 4"; sLine3 := NTimes(Chr(32), (30 - Length(sTmp)) DIV 2) + sTmp +NTimes(Chr(32), (30 - Length(sTmp)) DIV 2); sTmp := "Zeile 4"; sLine4 := NTimes(Chr(32), (30 - Length(sTmp)) DIV 2) + sTmp +NTimes(Chr(32), (30 - Length(sTmp)) DIV 2); Message(sLine1 + CRLF + CRLF + sLine2 + CRLF + sLine3 + CRLF + sLine4,"Info"); Endproc |
Procedure TopicLinkZumClipboard(nDummy: real);
..#aus einem formular mit eine eingebette tabelle TOPICS werden der inhalt des
..#autonummer feld eines markierten records zum clipboard kopiert
DEF CRLF = Chr(13) + Chr(10);
Vardef oTT : Object;
Vardef nTRNo, nCnt, nLN, nLNLast : Real;
nCnt := 0;
..clipboard entleeren
CopyStrToClipboard("");
..keine topics in der eingebette tabelle, dann verlasse procedur
If LinkCount(TOPICS) = 0
Return
End;
..suche die eingebette topicstabelle
oTT := FindDataWnd("THEMA.Thema_Links", "TABLINKTOPICS");
..eingebette tabelle gefunden
If Assigned(oTT)
..oTT.SetSortOrder("TOPICS.ID",2);
..sind recorsd markiert?
If oTT.StarNum > 0
..gehe zum ende der tabelle
oTT.BottomOfTable;
..und ermittle die autonummer des letzten records
ReadRec(TOPICS, RecNr(TOPICS));
nLN := 0;
nLNLast := TOPICS.Laufende_Nummer;
..gehe wieder zum anfang der tabelle
oTT.TopOfTable;
..und durchlaufe die tabelle und prüfe ob records markiert (*) sind
Repeat
..lese record
ReadRec(TOPICS, RecNr(TOPICS));
..speichere die autonummer
nLN := TOPICS.Laufende_Nummer;
..wenn markiert dann kopiere zum clipboard
If oTT.IsStar
nCnt := nCnt + 1;
AddStrToClipboard("<[T:" + Str(TOPICS.Laufende_Nummer) + "]"+TOPICS.tTitel+">" + CRLF);
End;
..wenn aktuelle autonummer ungleich autonummer des letzten record ist gehe
..zum nächsten record
?nLN <> nLNLast / oTT.NextRecord;
..ende erreicht
Until nLN = nLNLast
End;
End;
..wenn keine records markiert waren, dann kopiere aktuelles record
If nCnt = 0
?ReadRec(TOPICS, RecNr(TOPICS)) = 0/ Return
AddStrToClipboard("<[T:" + Str(TOPICS.Laufende_Nummer) + "]"+TOPICS.tTitel+">");
End;
CloseWnd;
Endproc;
|
Procedure Button1BeimAnklicken;
..#
..#erste möglichkeit mittels object
VarDef objFeld: Object;
objFeld := DatenfensterSuchen("SYSTEM.Optionen", "edSystemAdressenGeburtstageVoraus");
IF Assigned(objFeld)
Message("Gefunden");
Else
Message("NICHT Gefunden")
End;
..#
..#zweite möglichkeit mittels control
vardef EditCtrl: Edit;
EditCtrl := FindControl("edSystemAdressenGeburtstageVoraus") as Edit;
if Assigned(EditCtrl)
Message('edSystemAdressenGeburtstageVoraus gibt es.');
else
Message('edSystemAdressenGeburtstageVoraus gibt es nicht!');
end;
Endproc;
|
procedure GetDataGrid(window: Object; name: String): DataWnd;
..#Eingebettete Tabellen von Formularen zurückgeben und arbeiten wie mit Fenstern.
..#Beispiel
..#vardef grid: DataWnd;
..#grid := GetDataGrid(Project.Aufgaben.Aufgaben, "dgNotizen");
..#grid.TopOfTable;
..#grid.NextRecord;
..#grid.NextRecord;
..#Message("Satznummer des aktuellen Datensatzes in der eingebetteten Tabelle: " + Str(grid.CurrentRecNo));
..##
Vardef wndName: String;
Vardef wnd: DataWnd;
wndName := GetCompleteObjectName(window);
wnd := FindDataWnd(wndName, name);
If not Assigned(wnd)
ActivateForm(wndName);
wnd := FindDataWnd(wndName);
End;
If not Assigned(wnd)
Message("Die eingebettete Tabelle '" + name + "' und/oder das Formular '" + wndName + "' existiert nicht.");
Halt;
End;
Return wnd;
Endproc;
|
Procedure Aufgaben_Export_Planmaker;
..#Erstellt wird eine Zusatzreferenz in TextMaker Format
..#Daten werden mittels OLE übertragen
..##
Var CHDG = "Liste der Aufagben Planmaker";
Var CERR1 = "Abbruch: Textmaker Dokument kann nicht erstellt werden!"
Vardef pm: OleObject; ..#das planmaker object
Vardef pm2: OleObject; ..#das planmaker object
Vardef nRNo : Integer; ..#recordnr
Vardef i : Integer; ..#eine laufvariable
Vardef nRow : Integer; ..#laufvar für die zeile im planmaker objekt
Vardef nCol : Integer; ..#laufvar für die spalte im planmaker objekt
?FileSize($AUFGABEN) = 0 / Return
Try
pm := CreateOleObject('PlanMaker.Application');
Except
Message(CERR1, CHDG);
Return
End;
pm.WindowState := 1;
pm.Visible := True;
pm.Activate;
pm.Workbooks.Add;
nRow := 1;
..#heading schreiben
..#heading überschriften
pm.ActiveSheet.Cells.Item(nRow, 1).Value := "Aufgabe";
pm.ActiveSheet.Cells.Item(nRow, 2).Value := "AufgenommenAm";
pm.ActiveSheet.Cells.Item(nRow, 3).Value := "Erledigen";
..#heading fett
pm.ActiveSheet.Rows(1).Font.Bold := True;
..#die aufgaben eintragen - nur die erste 3 spalten
nRNo := FirstRec($AUFGABEN);
While nRNo > 0
..#nächste zeile
nRow := nRow + 1;
..#spalten befüllen - A:C
ReadRec($AUFGABEN, nRNo);
pm.ActiveSheet.Cells.Item(nRow, 1).Value := $AUFGABEN.Aufgabe;
pm.ActiveSheet.Cells.Item(nRow, 2).Value := DateStr($AUFGABEN.AufgenommenAm);
pm.ActiveSheet.Cells.Item(nRow, 3).Value := DateStr($AUFGABEN.ErledigenBis);
..#nächste aufgabe
nRNo := NextRec($AUFGABEN);
End;
..#spaltenbreite anpassen
pm.ActiveSheet.Range("A:C").AutoFit;
..#splaten B und C zentriert
pm.ActiveSheet.Range("B:C").HorizontalAlignment := 3;
..#planmaker schließen?
pm.Workbooks.Close;
..pm.Nothing;
Endproc;
|
Procedure Textmaker_Dokument_Erstellen
..##
Vardef tm: OleObject; ..objekt
..
Try
tm := CreateOleObject('TextMaker.Application');
Except
Message("Abbruch: Textmaker Dokument kann nicht erstellt werden!", "Fehler");
Return
End;
tm.WindowState := 1;
tm.Visible := TRUE;
tm.Activate;
..neues dokument erstellen
tm.Documents.Add;
Endproc;
|
Zeilenumbruch einfügen
tm.ActiveDocument.Selection.InsertBreak(0);
Text eingeben
tm.ActiveDocument.Selection.TypeText("Hallo 2");
Font ändern
tm.ActiveDocument.Selection.Font.Size := 12;
tm.ActiveDocument.Selection.Font.Bold := 1;
Inhalt der Zwischenablage einfügen
tm.ActiveDocument.Selection.Paste;
|
Sicherstellen, dass ausschließlich die in OnOpenProject vorgesehenen Fenster
beim Programmstart geöffnet werden, müssen die beim Beenden der Anwendung
noch offenen Formulare in OnCloseProject geschlossen werden.
Procedure SchliesseFenster(Name: string);
VarDef wnd: DataWnd;
wnd := FindDataWnd(Name);
If Assigned(wnd)
wnd.CloseWnd;
End;
Endproc;
Procedure OnCloseProject;
..#alle fenster beim programmstart erstmal schliessen
SchliesseFenster('TABELLE1.Formular1')
SchliesseFenster('TABELLE1.Formular2')
..#usw.
Endproc;
|
Das Problem tritt auf: wenn den Aufruf aus OnOpenProject erfolgt aus eine Prozedur aufgerufen wird, der einen Execdialog enthält. ExecDialog erlaubt keine weiteren Fenster. |
Beispiele wie eine Formularseite beim Start gesetzt wird.
Procedure OnOpenProject;
..#Hinweis: Verwendet wird UIniGet... aus mein TS4UTIL.DLL.
..##
..#notizenformular aufrufen
ActivateForm("notizen.notizen");
..#prüfen welche startseite gezeigt werden soll. dazu inidatei auslesen
UIniGetValue(BaseDir + CPGMINI, "Global", "StartseiteNotizformular", "1", sRT, 255);
Try
..#wert umwandeln
nRT := Round(RealVal(sRT));
Except
..#bei fehler zeige die seite 1
nRT := 1;
End;
..#und die Formularseite anzeigen
ViewPage(nRT);
EndProc;
Procedure OnOpenProject;
..#Hinweis: Verwendet wird eine Systemtabelle mit Formularseiten Angabe
..##
Vardef nSeite : Integer;
..#Formularseite aus der Systemtabelle Feld StartSeite (Integer) ermitteln
nSeite := 1;
Try
ReadRec($SYSTEM, 1);
nSeite := $SYSTEM.StartSeite;
Except
End;
..#Notizenformular aufrufen
ActivateForm("notizen.notizen");
..#und die Formularseite anzeigen
ViewPage(nSeite);
EndProc;
|
OnOpenProject wird nur im Anwendungsmodus aufgerufen. Um die Prozedur zu tesen eine einfache Prozedur, wie unten verwenden Procedure OOPTest; ..#OnOpenProject testen ..## OnOpenProject; Endproc; |
Diese Möglichkeit kann in OnOpenProject verwendet werden.
..#system tabelle prüfen --- muss ein datensatz enthalten
Try
MoveBegin(SYSTEM);
ReadNext(SYSTEM);
Except
Meldung_Fehler("Die Optionen können nicht gelesen werden!" + Chr(13) + Chr(10) + "Aktion: Anwendung neu installieren.", "Anwendung starten");
EndProg;
|
Das Einlesen einer WAV-Datei geschieht genau wie das eines Bildes: DerSound erscheint als Schalter im Formular. Zuerst muß man den Editiermodus einschalten. Nach Drücken des Schalters wird ein Fenster geöffnet, in welchem ein Mikrofonsymbol enthält, falls das Feld schon mit einer WAV-Datei verbunden ist. Zum Abspielen eines Sounds braucht man auf jeden Fall die FunktionPlaySound. Plazieren Sie einfach einen Makroschalter in Ihr Formular und geben Sie als Makrobefehl an: PlaySound(Klangfeld) Wobei "Klangfeld" das Label Ihres Klangfeldes ist. |
PlaySound(blobSound: Tabellenfeld); |
Procedure ExtractFilePath(sDateiname: String): String;
Vardef s, sResult: String;
Vardef i: Integer;
s := sDateiname;
sResult := "";
i := Pos("\", s);
While i > 0
sResult := sResult + LeftStr(s, i);
If s = "\"
..#Sonderfall: hinter letztem \ kein Text mehr vorhanden
s := ""
Else
s := RightStr(s, Length(s) - i)
End
i := Pos("\", s);
End
Return sResult;
Endproc
|
Pos(sStrIn, sStrHat: String): Integer |
Procedure ZahlPrüfen(sStr:string):integer
..#Prüft ob sStr eine Zahl ist. Liefert 1 wenn OK
..#Test: Message(Str(ZahlPrüfen("1234")));
..##
Var i = 0;
Var nLen = Length(sStr);
Var sStrC = "0123456789.,";
Var nRT = 1;
While i := i + 1 <= nLen
?Pos(sStr[i], sStrC) = 0 / nRT := 0;
End;
Return nRT
Endproc
|
Procedure GetRamtextSize : Integer;
..#Anzahl Zeichen im RamText ermitteln
..##
VarDef nFH, nCnt : Integer;
VarDef c : String;
nCnt := 0;
If nFH := Reset("RAMTEXT") > 0
While Not EOT(nFH)
nCnt := nCnt + 1;
c := Read(nFH, 1);
End;
Close(nFH);
End;
Return nCnt
Endproc;
RamText verwenden um Inhalt Zwischenablage zu zeigen
Procedure Zeige_Zwischenablage;
..#zeige Inhalt der Zwischenablage
..##
Var CHDG = "Inhalt der Zwischenablage zeigen";
Vardef sStr : String;
Vardef nFH : Integer;
..#inhalt zwischenablage zum ramtext kopieren
Clip2Text;
If GetRamtextSize(0) = 0
Message("Abbruch: Die Zwischenablage ist leer.", "Info - " + CHDG);
Return
End;
nFH := Reset("RAMTEXT");
If nFH = 0
Message("Abbruch: Datei zur Speicherung Inhalt Zwischenablage konnte nicht gelesen werden.", "Fehler - " + CHDG);
Return
End;
While Not EOT(nFH)
sStr := sStr + ReadLn(nFH) + Chr(13) + Chr(10);
End;
Close(nFH);
Message(sStr, CHDG);
Endproc;
|
Var CERR = "Abbruch: Optionen können nicht gelesen werden!";
Try
..#anfang der tabelle - datensatz wurde noch nicht
gelesen
MoveBegin(SYSTEM);
..#datensatz lesen
ReadNext(SYSTEM);
..#mach irgebdetwas mit dem satz
Return 1
Except
..#fehler aufgetreten, meldung inkl. TS fehlercode
Message(CERR + Chr(13) + Chr(10) + Error.Message, "Fehler");
Return 0
End;
|
..#Vorgane aus der Tabelle SYSTEM lesen
..#Die Tabelle hat nur einen Datensatz
..#Wenn der Satz nicht gelesen werden kann, Job abbrechen
.If ReadRec(SYSTEM, 1) = 0
.Do Message("Abbruch: Keine Vorgaben gefunden!", "Fehler")
.ST
.End
|
Ein Datensatz kopieren, dabei Inhalt des Memofeldes nicht kopieren. Procedure SatzKopieren RELATION K=KUNDEN ReadRec(K,1); ReadRec(KUNDEN, 0); SetRecord(K, KUNDEN); SetField(KUNDEN, LabelNo(KUNDEN, 'Bemerkung'), null); WriteRec(KUNDEN, FileSize(KUNDEN)+1); Endproc; |
Var CHDG = "Datenbank Regenerieren";
Var CINF = "Die Datenbank wurde erfolgreich regeniert."
Var CERR = "Die Datenbank konnte nicht regeniert werden!"
Vardef j : Integer; ..#laufvar
j := 0;
Try
While j := j + 1 <= MaxFile
ShowWait("Regeneriere Tabelle " + Exchange(Lower(DBName(j)),".dat", "") + " (" + Str(j) + "/" + Str(MaxFile) + ")");
RegenAll(j);
End;
Hidewait;
Message(CINF, CHDG);
Return 1
Except
Message(CERR, CHDG);
Return 0
End;
|
RegenAll(ntabelle : Integer); |
Syntax: RELATION Relationsdefinition Statische Links festlegen, Tabellen virtuelle öffnen und Inklusionen definieren Das Relationskommando dient der Einrichtung von • virtuellen Tabellen, über die ein zusätzlicher Zugriff auf bereits geöffnete Tabellen möglich wird, und • statischen Links, mit denen die Tabellenverknüpfungen über das ADL-System erweitert oder überschrieben werden können, und • Zwangsverknüpfungen, so dass immer eine Kombination mit der Primärdatei hergestellt wird, auch wenn kein verknüpfter Datensatz vorhanden ist (Erzwungene Bildung des Kreuzproduktes). Die einzelnen Angaben werden einfach durch Komma getrennt hintereinander geschrieben. Die Länge eines Kommandos ist auf 255 Zeichen beschränkt. Jedes Relationskommando hebt das vorhergehende wieder auf. Eine Relationsdefinition wird innerhalb von Datenbankjobs und easy-Modulen mit dem Kommando RELATION angegeben. In Datenbankjobs ist dieses Kommando nur im Prolog zulässig. In allen anderen Textbereichen wird die Bearbeitung mit der Meldung "Illegale Operation" abgebrochen. Projektweite Relationsdefinitionen können über den Menüpunkt Projekt/Tabellen verknüpfen angelegt werden. |
Syntax im Datenbankjob ..# .primTableIs [MeineTabelle] .setAccess Nummer .sub .replace [MeineTabelle]([MeinFeld1] = [NeuerWert]) .endsub REPLACE [MeineTabelle]([MeinFeld2] = [NeuerWert] |
Replace TABELLE.Feldname := Wert |
Mittels Replace können Werte direkt geändert werden, wenn vorher allerdings den Index umgestellt wird, so daß dieser nicht über das zu ersetzende Feld geht. Beispiel: Anstatt ReadRec (TABELLE,0) .. leeren Datensatz zur Verfügung stellen Replace Feldname := x WriteRec (TABELLE) kann Replace TABELLE.Feldname := x verwendet werden. |
Procedure Textdatei_Inhalt_Zeigen;
..#Eine einfache Methode den Inhalt eine Textdatei zu zeigen
..##
VarDef nFH : Integer;
VarDef sStr : String;
nFH := Reset(BaseDir + "readme.txt");
If nFH = 0
Message("Datei kann nicht geöffnet werden!", "Fehler - Datei zeigen");
Return
End;
While NOT Eot(nFH)
sStr := sStr + Read(nFH, 1);
End;
Message(sStr);
Close(nFH);
EndProc;
|
Procedure LeseProjektEdition(nDummy:Integer):String;
..#lese aus der projekt tdb datei die projektedition.
..#verwendet werden die platzhalter # um die edition zu ermitteln. beispiel:
..#projekt eigenschaften, edition #20090118 (Professional)#
..##
Vardef nFH, i, nGo : Integer;
Vardef c, sStr : String;
sStr := "";
nGo := 0;
nFH := Reset(Basedir + "roptipp.tdb");
While NOT EOT(nFH)
c := Read(nFH, 1);
If c = "#" And nGo = 0
nGo := 1;
c := "";
End;
If c = "#" And nGo = 1
nGo := 0;
c := "";
End;
If nGo = 1
sStr := sStr + c;
End;
End;
Close(nFH);
Return sStr
EndProc;
|
Rewrite(DateiHandle : Integer); |
Vardef nFH : Integer; ..#Dateihandle
..#Datei neu erstellen
nFH := Rewrite(MeineDatei);
Try
#Datensätze lesen
Except
..#Fehlerbehandlung
Trace(Error.Message);
Finally
..#Datei richtig schließen
If nFT > 0
Close(nFT)
End;
End;
|
Procedure StringImEditorZeigen(sStr : String);
..#string in eine text datei speichern und im standardeditor zeigen
..#beispiel: StringImEditorZeigen("Hallo, hier nich ich...");
..##
Var sDatei = "temp.txt"; ..textdatei
Vardef nFH : Integer; ..dateihandle
If nFH := Rewrite(sDatei) > 0
WriteLn(nFH, sStr);
Close(nFH);
Execute(sDatei);
Else
Message("Datei kann nicht erstellt werden!", "Fehler");
End;
Endproc;
|
Procedure StringToFile(sStr : String);
..#string in eine text datei speichern
..##
Var sDatei = "temp.txt"; ..textdatei
Vardef nFH : Integer; ..dateihandle
If nFH := Rewrite(sDatei) > 0
WriteLn(nFH, sStr);
Close(nFH);
Message("Datei erstellt.", "Hinweis");
Else
Message("Datei kann nicht erstellt werden!", "Fehler");
End;
Endproc;
|
Rewrite(DateiHandle : Integer); |
Procedure MergeTmpFiles(sTmpDatei, sTmpDatei2 : String) : Real;
Vardef nFH2, nFH3 : Real;
Vardef sLine : String;
?(sTmpDatei = "") Or (sTmpDatei2 = "") / Return 0
If (IsFile(sTmpDatei2) = 0)
Message("Die temporäre Dateien können nicht zusammengefügt werden.", "FEHLER");
Return 0
End;
?IsFile(sTmpDatei) = 1 / nFH2 := TAppend(sTmpDatei);
?IsFile(sTmpDatei) = 0 / nFH2 := Rewrite(sTmpDatei);
If NOT nFH3 := Reset(sTmpDatei2)
Message("Die temporäre Dateien können nicht zusammengefügt werden.", "FEHLER");
Close(nFH2);
Return 0
Else
While Not Eot(nFH3)
sLine := ReadLn(nFH3);
WriteLn(nFH2, sLine) ;
End;
End;
Close(nFH2);
Close(nFH3);
Return 1
Endproc;
|
Vardef nTage : Integer; ..#wieviele tage noch zum Termin nTage := Round($KONTAKTE.KontaktTermin - Today); |
Die Funktion Round() rundet nur Nachkommastellen. Wenn man aber die Zahl vorher durch 10 teilt und danach wieder mit 10 multipliziert kann man sie auch für diesen Zweck benutzen: .. Parameter: .. number = die zu rundende Zahl .. digits = Zahner-Stelle die zu gerundet werden soll Procedure RoundInt(number: Real; digits: Integer): Integer number := number / Exp( digits * Log(10)); .. number / 10 hoch digits return Int(Round(number) * Exp(digits * Log(10)))); Endproc; In der Praxis sieht das dann so aus: RoundInt(152.531, 1) gibt 150 zurück. RoundInt(152.531, 2) gibt 200 zurück. |
Volltext aktualisieren
Beispiel Volltext aktualisieren für die Tabelle Tipps
=====================================================
Die Stichworte werden in der Tabelle VTINDEX gespeichert und die Relation zwischen der
Tabelle TIPPS und VTINDEX mittels STICHWORT.REL.
Die Angabe der Felder, Fields, sollte der Tabellennamen vorangestellt werden. Das Dollar ($) Zeichen dabei nicht vergessen.
Vardef nCnt : Integer; ..#die Anzahl der gefunden Einträge.
nCnt := ScanRecs($TIPPS, $VTINDEX, $STICHWORT, Fields($TIPPS.Beschreibung, $TIPPS.Tipp), "", 100, BaseDir+"stiwono.txt", 0);
Volltextsuche
Beispiel: gesucht wird der Inhalt String sStr in der Tabelle VTINDEX
====================================================================
Die gefunde Einträge werden dann in Tabelle TIPPS markiert.
Die Tabelle STICHWORT enthält die Relation zwischen der Tabelle TIPPS und der Volltextindex Tabelle VTINDEX.
Vardef nRT : Integer; ..#Rückgabewert.
nRT := MarkTable($TIPPS, $VTINDEX, sStr, '', '', 0, $STICHWORT);
..#fehler?
Vardef sHStr : String;
If nRT >= 201 And nRT <= 204
?nRT = 201 / sHStr := "Ungültige Index-Tabelle";
?nRT = 202 / sHStr := "Ungültige Relation"
?nRT = 203 / sHStr := "Schließende Klammer erwartet"
?nRT = 204 / sHStr := "Ungültiges Zeichen"
Message(sHStr, "Fehler Volltextsuche"););
Return
End;
Volltextsuche mit Zahlen
========================
Wenn ein Volltextindex statt über die TurboDB Studio Oberfläche mit der TurboPL-Funktion ScanRecs erzeugt wird, kann ein
erweitertes Alphabet angeben (Parameter ExtABC) werden und dort Zahlen mit aufnehmen.
Nachdem der Volltextindex mit ScanRecs unter Verwendung von ExtABC erzeugt wurde, muß bei der Suche nun
ebenfalls das erweiterte Alphabet angegeben werden.
Es ist deshalb besser für die Suche die Funktion MarkTable zu verwenden.
|
ScanRecs(MainTable, IndexTable, RelTable: Real; Fields(Column1 [,Column2, ..ColumnN]); ExtABC: String; MaxFrequency: Real; ContraIndex: String; Mode: Real):Real; |
.Var nRT = 0
.Var sStr = ""
..#input mittels ts input funktion
.DO nRT := Input("Bedingung: ", "Suchbedingung eingeben", 0, sStr)
..#nur für tests
..Do Message("Die Bedingung lautet:" + sStr);
..#die bedingung ausführen
.Try
.Selection _sStr
.Except
.Do Message("Fehler bei der Selektion:" + Error.Message, "Fehler Selektion")
.ST
.End
|
.Do Message($SYSTEM.Hilfsstring)
.If $SYSTEM.Hilfsstring = ""
.Do Message("Fehler: keine Bedingung angegeben!", "Aktueller Datensatz lesen")
.ST
.End
.Selektion $NOTIZEN.Laufende_Nummer = Val($SYSTEM.Hilfsstring)
|
.Do Message(sNOTE) .Selektion $NOTIZEN.Laufende_Nummer = Val(sNOTE) |
.Do ReadRec($NOTIZEN, RecNr($NOTIZEN)) .Do nSelektion := $NOTIZEN.Laufende_Nummer .Selektion $NOTIZEN.Laufende_Nummer = nSelektion .Do Message(Str(nSelektion), "Aktueller Datensatz lesen") .. |
Mittels DO können Selektionen dynamisch durchgeführt werden.
Beispiel
c := 'Name like "Müller"'
Do _"x:=SEL("+c+")"
If x=1
.. erfüllt
Else
.. nicht erfüllt
End
|
SetAccess <Indexdatei> funktioniert auch in Easy-Module. Beispiel: Setaccess adr-name.ind |
SETACCESS Index |
Mittels SetFilter(Tabelle,"") kann der aktuelle Filter ausgeschaltet werden. Das gilt für statischen und dynamischen Filter. |
Mit der Funktion IndNo(Tabelle) ermitteln, welcher Index momentan aktiv ist.
Dann diesen IndexWert in einer Variablen speichern.
SetFilter anpassen und zuordnen
Hinterher wieder der Ursprungsindex setzen
Beispielcode bezogen auf das bei TurboDB Studio mitgelieferte Demo "Vögel":
...
VarDef idxNo: Integer;
idxNo := IndNo(VÖGEL);
Access(VÖGEL, "VÖGEL.ind");
SetFilter(VÖGEL, "A*", "M*");
Attach;
Message("Weiter mit OK...");
Access(VÖGEL, IndName(VÖGEL, idxNo));
Attach;
|
Über einen JOB oder MAKRO eine Liste drucken, bei der die Bedingung für die
Selektion vom Anwender selbst eingegeben werden kann.
Makro schreiben:
Input ("Selektion:","Frage")
SUB _T-Eingabe
SetMark (FileNo, RecNo (FileNo))
ENDSUB Name, Vorname
SetSortOrder ("Markierung")
Run ("Liste")
...bzw. 'Liste' druckt nur markierte Datensaetze.
|
Eine Möglichkeit wäre SetNumberFormats in OnOpenProject aufzurufen: Procedure OnOpenProject ..#wird beim starten der anwendung ausgeführt ..#format für dec, datum, zeit setzen. -1 ist wie am rechner eingestellt SetNumberFormats(-1, -1, -1); EndProc; |
procedure Bericht_Drucken(sBerichtname : String);
..#bericht drucken
..##
Vardef nModus : Integer; ..#druckermodus = wohin soll gedruckt werden
Vardef sFile : String; ..#dateiname fall output in eine datei
..#modus ermitteln - aus denn einstellungen
nModus := EnumVal($SYSTEM, LabelNo($SYSTEM, "VorgabeDruckModus"), Str($SYSTEM.VorgabeDruckModus)) - 1;
..#nmodus auswerten
..#ausgabe datei - dann dateiname und typ abfragen
If nModus = 3
If Input("Dateiname (" + Str($SYSTEM.VorgabeDruckerDateiformat) + "):", "Drucken in Datei", 0, sFile) = 0
Halt;
End;
SetOutputFile(sFile, $SYSTEM.VorgabeDruckerDateiformat);
End;
Run(sBerichtname, nModus);
EndProc;
|
SetOutputFile(Dateiname : String; Format : String); |
Procedure Hilfe_Zeigen; ..#zeigt die projekt htmlhelp datei ..## ShellExecuteW(0, "open",BASEDIR+"projekt.chm", "","",5); Endproc; |
Procedure Progressbar(nArt: real; sMeldung: string; nMax: real; nAct: real);
..#Zeigt den Vorschreitungsstatus einer Operation
..#Parameter:
..#nArt: 1 = balken, 2 = %
..#sMeldung = die Meldung (wie zB "Bitte Warten"
..#nMax = Maximalwert, nAct = aktueller Wert
DEF CRLF = Chr(13) + Chr(10);
DEF nPMax = 100;
DEF sDEL = Chr(219)
Vardef sTmp : String;
Vardef i, k, f : Real;
f := nMax / nPMax;
?f = 0 / f := 1;
k := Int(nAct / f);
If nArt = 1
sTmp := "";
nLoop(i, k, sTmp := sTmp + Chr(219));
ShowWait("Thema: " + sThema + CRLF + sMeldung + CRLF + sTmp);
End
?nArt = 2/ShowWait(sMeldung + CRLF + Str(k,1,0) + "%");
EndProc;
|
Zeigt ein links abgeschnittenen String. Wird für Showwait verwendet.
Abgeschnittener Teil wird als ... gezeigt.
Procedure pShowLine(sLine : String; nMaxLength : Real) : String;
..#Zeigt ein links abgeschnittenen String. Wird für Showwait verwendet.
..#Abgeschnittener Teil wird als ... gezeigt.
..#Parameter:
..#sLine = dargestellte Information
..#nMaxLength = max. Länge des Strings
..#Returnwert
..#angepasster String
?nMaxLength < 0 Or nMaxLength > 255 / nMaxLength := 255
If Length(sLine) > nMaxLength
Return "..." + sLine[Length(sLine) - nMaxLength, 255]
Else
Return sLine
End
EndProc;
|
ShowWait(Message: String); |
Zeilenumbruch im Text darstellen mittels "Zeile 1" + Chr(13) + Chr(10) + "Zeile 2". oder DEF CRLF = Chr(13) + Chr(10); "Zeile 1" + CRLF + "Zeile 2". Gilt auch für die Funktion Message. |
Frage: Gibt es die Möglichkeit nach einer Sortierung (z.B. nach Namen) den ersten richtigen Datensatz nicht unten sondern oben am Feldrand anzuzeigen? Lösung: In das Ereignis BeimÖffnen des betreffenden Auswahlformulars die Funktion BottomOfTable eintragen. |
Sortierung(IndexName: String; Modus: Real) SetSortOrder(IndexName: String; Mode: Real) |
SetSortOrder gibt keine Meldung aus, wenn der Übergabeparameter(Indexdatei) im aktuellen Verzeichnis nicht gefunden wurde.
Dieses Problem läßt sich wie folgt umgehen:
Vardef sDatei : String;
sDatei := "Executeparameter";
IF Exists(sDatei) = 2
Message("Kann Programm " + sDatei + " nicht finden.", "Fehler");
Halt;
END
|
Die Funktion SOUNDEX liefert eine sehr simples phonetisches Bild einer Zeichenkette. Hier kurz die Regeln: Der erste Buchstabe wird unverändert übernommen. Die folgenden Zeichen werden von links nach rechts so codiert: 'B','F','P','V' -> '1' 'C','G','K','Q','S','X','Z','ß' -> '2' 'D','T' -> '3' 'L' -> '4' 'M','N' -> '5' 'R' -> '6' Alle anderen Zeichen werden übersprungen. Ein Zeichen wird auch übersprungen, wenn es den gleichen Code wie das letzte Zeichen liefert. Von dem resultierenden String werden nur die ersten 4 Zeichen verwendet. Der Hauptnachteil besteht darin, dass viel zu viele unterschiedliche Wörter passen, eine Suche also meist eine zu große Trefferzahl liefert. Allerdings hat SOUNDEX nichts mit dem Operator "enthält" zu tun, der wiederum auf dem Einsatz der Funktion POS beruht. Wenn der gesuchte Begriff nicht am Anfang des Strings steht, wird man mit "ähnlich" kein Glück haben. Besser als "ähnlich" oder "enthält" ist in jedem Fall der Einsatz von "wie" und "in" oder auch von STRCOMP (für Spezialanwendungen). |
Bei der Verwendung von numerischen berechneten Feldern in Formularen und Berichten kann es störend sein, daß immer zwei Nachkommastellen ausgegeben werden. Hier kann die Funktion STR Abhilfe schaffen: Wenn Ihr bisheriger Ausdruck <Formel> war, sollten Sie STR(<Formel>, 0,n) angeben, wobei n die gewünschte Anzahl von Nachkommastellen ist. Beispiel: Wenn Ihr bisheriger Ausdruck war, sollten Sie STR(, 0,n) angeben, wobei n die gewünschte Anzahl von Nachkommastellen ist. Beispiel: STR(INT(Geburtstag),5,0) |
Procedure Projekttabellenfeldliste_abfragen;
..#abfrage der tabellenfelder für eine tabelle
..##
Var CCRLF = Chr(13) + Chr(10); ..#zeilenumbruch für meldungen
Var CHDG = "Tabellenstruktur abfragen und kopieren";
Vardef i,j, n : Integer ..#laufvars
Vardef sTabelle : String; ..#tabelle der abgefragt wird
Vardef sListe : String; ..#liste der tabellenfelder
Vardef asTabellen : String[250]; ..#array für tabellen. dieses wird sortiert
Vardef asFelder : String[250]; ..#array für tabellen felder
?MaxFile = 0 / Return
..#liste der tabellen erstellen und diese in der abfrage anzeigen zu können
i := 0;
While j:=j+1 <= MaxFile
asTabellen[i] := Lower(Exchange(Upper(DBName(j)),".DAT", ""));
i := i + 1;
End;
..#strsort verwenden
n := i - 1;
StrSort(asTabellen, n);
NLoop(i, n, sListe := sListe + asTabellen[i] + CCRLF);
..#tabelle abfragen, dabei werden alle tabellen gezeigt
If Input("Liste der Tabellen:" + CCRLF + sListe + CCRLF + "Tabelle eingeben:", CHDG, 0, sTabelle) = 0
Return
End;
sTabelle := Upper(sTabelle);
j := 0;
While j:=j+1 <= MaxFile
If Exchange(Upper(DBName(j)),".DAT", "") = sTabelle
..Message( Exchange(Upper(DBName(j)),".DAT", ""));
..#liste alle feldlabel der tabelle auf
WHILE i:=i+1 <= MaxLabel(j)
asFelder[i] := "$" + Exchange(Upper(DBName(j)),".DAT", "") + "." + Label(j, i,1)
END;
..und sortiere
StrSort(asFelder, MaxLabel(j));
..und gebe in der feldliste aus
sListe := "";
NLoop(i, MaxLabel(j),sListe := sListe + asFelder[i] + CCRLF);
CopyStrToClipboard(sListe);
Message("Feldliste für Tabelle '" + Lower(sTabelle) + "' erstellt und zur Zwischenablage kopiert", "Hinweis - Projekttabellenfeldliste");
Return;
End;
End;
Message("Abbruch: Tabelle " + sTabelle + " nicht gefunden!", "Fehler - Projekttabellenfeldliste");
|
z.B. aus einem Memo mittels CopyMemo und ersetzen dann alle Platzhalter durch Feldinhalte. |
Subst(SuchString : String; ErsetzString : String; Art : Real) : Real Die Funktion ermöglich die Ersetzung von Zeichen innerhalb RAMTEXT. Ramtext ist eine virtuelle Textdatei (in den Speicher abgelegte Datei). Parameter SuchString = String der innerhalb von Ramtext gesucht wird ErsetzString = neue String Art: 0 = Normal, 1 = in HTML konvertieren Returnwert: Position der Ersetzung oder 0 bei keine Ersetzung |
procedure Übersicht_Systemsvariable;
..#Übersicht alle Systemvariablen
..##
Var CCRLF = Chr(13) + Chr(10);
Var sMsg = "";
sMsg := sMsg + "$heute: " + $heute+ CCRLF;
sMsg := sMsg + "$jetzt: " + $jetzt+ CCRLF;
sMsg := sMsg + "" + CCRLF;
sMsg := sMsg + "$TDB-Pfad (Programmverzeichnis TS Bin Dateien): " + $TDB-Pfad + CCRLF;
sMsg := sMsg + "$T-Eingabe (Globale Variable für Input): " + $T-Eingabe + CCRLF;
sMsg := sMsg + "" + CCRLF;
sMsg := sMsg + "$Seite (nur Datenbankjob): " + Str($Seite) + CCRLF;
sMsg := sMsg + "$Zeile (nur Datenbankjob): " + Str($Zeile) + CCRLF;
sMsg := sMsg + "G_alt (nur Datenbankjob): wird bei Gruppenwechsel (Steuerbefehl .GP) verwendet" + CCRLF;
sMsg := sMsg + "G_neu (nur Datenbankjob): wird bei Gruppenwechsel (Steuerbefehl .GP) verwendet" + CCRLF;
sMsg := sMsg + "" + CCRLF;
sMsg := sMsg + "$Fehler: " + "nicht mehr verwenden, dafür Error" + CCRLF;
sMsg := sMsg + "Error.Nummer: " + Str(Error.Nummer)+ CCRLF;
sMsg := sMsg + "Error.Meldung: " + Error.Message+ CCRLF;
sMsg := sMsg + "Error.Beschreibung: " + Error.Description+ CCRLF;
Message(sMsg, "Übersicht der Systemvariablen - WICHTIG: Groß/Kleinschreibung beachten", 1);
endproc;
Beispiel Datenbankjob Footer
wo $heute / $today, $jetzt / $Now und $Seite verwendet werden
$(@a8n "Ausgegeben am " + DateStr(ToDay) + " um " + TimeStr(Now)) $(@a8n "Seite " + $Seite R_Form ToMargin)
Procedure SystemUpdate(sField:String; sValue:String):Integer;
..#feld in der system tabelle aktualisieren
..#Bsp: SystemUpdate("MeineMeldung", "Hallo Welt");
..##
Vardef nFNo : Integer; ..#feldnr
Vardef nRT : Integer; ..#return code 0 = fehler, 1 = OK
..#noch ist alles nicht ok
nRT := 0;
..#feld label suchen
nFNo := LabelNr($SYSTEM, sField);
..#gefunden, dann setze neuen wert
If nFNo > 0
Try
MoveBegin($SYSTEM);
ReadNext($SYSTEM);
ModifyRec($SYSTEM);
SetField($SYSTEM, nFNo, sValue);
PostRec($SYSTEM);
nRT := 1;
Except
nRT := 0;
End;
End;
Return nRT;
Endproc;
|
Den kompletten Inhalt eines Memos TABELLE.MemoFeld an die angegebene Datei anhängen:
Vardef nFH: Integer;
nFH := TAppend('c:\hallowelt.txt');
Write(nFH, TABELLE.MemoFeld);
Close(nFH);
Hinweis:
Kann erweitert werden, durch z.B. vorher zu prüfen ob die Datei
c:\hallowelt.txt auch vorhanden ist:
If NOT Exists('c:\hallowelt.txt') Then
Message("Datei nicgt gefunden.");
Return
End;
|
TAppend(Dateiname) : Integer; |
Procedure MergeTmpFiles(sTmpDatei, sTmpDatei2 : String) : Real;
Vardef nFH2, nFH3 : Real;
Vardef sLine : String;
?(sTmpDatei = "") Or (sTmpDatei2 = "") / Return 0
If (IsFile(sTmpDatei2) = 0)
Message("Die temporäre Dateien können nicht zusammengefügt werden.", "FEHLER");
Return 0
End;
?IsFile(sTmpDatei) = 1 / nFH2 := TAppend(sTmpDatei);
?IsFile(sTmpDatei) = 0 / nFH2 := Rewrite(sTmpDatei);
If NOT nFH3 := Reset(sTmpDatei2)
Message("Die temporäre Dateien können nicht zusammengefügt werden.", "FEHLER");
Close(nFH2);
Return 0
Else
While Not Eot(nFH3)
sLine := ReadLn(nFH3);
WriteLn(nFH2, sLine) ;
End;
End;
Close(nFH2);
Close(nFH3);
Return 1
Endproc;
|
Verschiedene Beispiele zu T-Eingabe
Procedure Taschenrechner : Real;
..#t-eingabe als taschenrechner
..##
Vardef sFrage : String;
sFrage := "";
Input(sFrage, "Taschenrechner");
Return Val(T-Eingabe)
Endproc
Procedure Taschenrechner(A, B : Real)
..#taschenrechner mit parameter
..##
Vardef sFrage : String;
sFrage := Str(A) + " mal " + Str(B) + " ist?";
Input(sFrage, "Rechentest");
If Val(T-Eingabe) ist A * B
Message("Sehr gut!")
Else
Message("Ist leider nicht richtig!");
End
Endproc
Procedure Prüfe_Datum;
..#Datum prüfen nach Benutzereingabe
..##
Vardef nDatum : Integer;
Vardef sDatum : String;
T-Eingabe := DateStr(Today);
Input("Datum");
SetPara('ec 1');
nDatum := VAL(T-Eingabe);
SetPara('ec 0')
IF nDatum >= 1.1.1900 And nDatum <= 31.12.2099
Message("Datum '" + T-Eingabe + "' ist gültig...")
ELSE
Message("Datum '" + T-Eingabe + "' ist NICHT gültig...")
END
EndProc;
Procedure Prüfe_Zahl;
..#Zeichenkette als Zahl prüfen
..##
VarDef nRT : Integer; ..Rückgabe
..Fehlerhandling setzen
SetPara('ec 1');
nRT := VAL(TABELLE.MeinWert);
If $Fehler <> 0
Message("Fehler: Wert '" + TABELLE.MeinWert + "' ist kein Zahl! Fehlercode: " + Str(nRT), "Fehler");
End;
SetPara('ec 0');
Endproc;
|
T-Eingabe : String; |
procedure btnActivateTimerBeimAnklicken;
..#timer an oder ausstellen
..#braucht formularelemente timer und label
..##
Vardef TimerCtrl: Timer; ..#der timer
Vardef LabelCtrl: Label; ..#label der den status des timers zeigt
..#label zur info darstellug finden
LabelCtrl := FindControl("lblTimerScandata") as Label;
If NOT Assigned(LabelCtrl)
Message("Fehler: Labelcontrol für Timer kann nicht gefunden werden");
End;
..#timer de- oder aktivieren
..#der timer has als name timerScandata
TimerCtrl := FindControl("timerScandata") as Timer;
If Assigned(TimerCtrl)
..timer is an, dann ausstellen
If TimerCtrl.Enabled = JA
TimerCtrl.Enabled := NEIN
LabelCtrl.Text := "Timer = AUS";
Else
..timer is aus, dann anstellen
TimerCtrl.Enabled := JA;
LabelCtrl.Text := "Timer = AN";
End;
..#hier kann der timer interval gesetzt werden
..TimerCtrl.Interval
LabelCtrl.Text := LabelCtrl.Text + " (Interval=" + Str(TimerCtrl.Interval DIV 10) + "s.)";
End;
EndProc;
|
Die Steuerung erfolgt mittels
Enabled := JA|NEIN
Interval := NN (wobei NN 1/10 Sek ist. 10 ist also 1 Sek und 600 ist 1 Min.)
Innerhalb eine Prozedur Object Timer verwenden
Vardef TimerCtrl: Timer; ..der timer
..#der timer has als name timerScandata
TimerCtrl := FindControl("timerScandata") as Timer;
If Assigned(TimerCtrl)
TimerCtrl.Enabled := JA
TimerCtrl.Interval := 600;
|
procedure Button1BeimAnklicken;
..#schalter in einem formular erstellen und wenn angeklickt werden verschiedene hinweise im ausgabefenster ausgegeben.
..##
Trace("Aufruf eines Formulars.");
OpenForm("testblob.testblob-formular");
Trace("Das Formular ist jetzt geöffnet und sollte den Fokus haben.");
Trace("Es geht aber munter weiter...");
Trace("Wieviel sind 1 + 1?");
Trace(Str(Val("1") + Val("1")));
endproc;
|
Trace(Zeichenkette: String); |
If TransOn(TABELLE) = 0
Try
..#
..#Datenbankoperationen durchführen
..#
TransOff(TABELLE);
Except
..#Bei Fehler rollback durchführen
Rollback(TABELLE);
End
End;
|
Vardef nFH : Integer; ..#Dateihandle
..#Datei neu erstellen
nFH := Rewrite(MeineDatei);
Try
#Datensätze lesen
Except
..#Fehlerbehandlung
Trace(Error.Message);
Finally
..#Datei richtig schließen
If nFT > 0
Close(nFT)
End;
End;
|
..#Datenatz suchen
nRNo := FindRec(TABELLE,...)
If nRNo < 1 Or ReadRec(TABELLE, nRNo) < 1
..#Meldung ausgeben Datensatz nicht gefunden oder kann nicht gelesen werden
Else
If EditOn(TABELLE) = 1
Try
..#Änderungen durchführen und Satz speichern
WriteRec(TABELLE, nRNo);
Except
..#Meldung dass die Tabelle nicht bearbeitet werden kann
Finally
EditOff(TABELLE)
End
Else
..#Meldung dass die Tabelle nicht bearbeitet werden kann
End;
End;
|
Die Systemtabelle SYSTEM enhält ein Datensatz
Try
..#anfang der tabelle - datensatz wurde noch nicht gelesen
MoveBegin(SYSTEM);
..#datensatz lesen
ReadNext(SYSTEM);
..#mach irgendetwas mit dem satz
..#Eintrag lesen
Return 1
Except
..#fehler aufgetreten, meldung inkl. TS fehlercode
Message("Abbruch: Die Optionen können nicht gelesen werden!" + Chr(13) + Chr(10) + Error.Message, "Fehler");
Return 0
End;
|
..#
If TransOn(TABELLE) = 0
Try
..#
..#Datenbankoperationen durchführen
..#
TransOff(TABELLE);
Except
Rollback(TABELLE);
End
End;
|
Fehlerbehandlung mittels Try:
Try
..
Except
..
Finally
..
End
Hinweis
Except darf nicht weggelassen werden.
|
Uses modul, modul, modul; |
TS/VDP sucht das Modul im aktuellen Verzeichnis. Dieses wird aber durch Datei-Dialoge verstellt. Wenn also irgendwo in TS/VDP ein Datei-Dialog benutzt wird, der dann aufein anderes Verzeichnis weist, ist es aus. Projekt schließen und neu öffnen stellt einfach nur dasProjektverzeichnis wieder als das Aktuelle ein. |
Datum nach Benutzereingabe prüfen.
Verwendet werden Input und T-Eingabe
Procedure Prüfe_Datum : Integer;
..#Datum OK = 1, sonst 0
..##
Vardef nDatum : Integer;
Vardef sDatum : String;
T-Eingabe := DateStr(Today);
Input("Datum");
SetPara('ec 1');
nDatum := VAL(T-Eingabe);
SetPara('ec 0')
IF nDatum >= 1.1.1900 And nDatum <= 31.12.2099
Message("Datum '" + T-Eingabe + "' ist gültig...");
Return 1
ELSE
Message("Datum '" + T-Eingabe + "' ist NICHT gültig!");
Return 0
END
EndProc;
|
Dateizeit ist vom Typ ZEIT Die Meldung erscheint bei DATEIEN.Dateizeit := Val(LTRIM(RTRIM(sTmp[39,5]))); Verwendedeshalb: DATEIEN.Dateizeit := LTRIM(RTRIM(sTmp[39,5])); Bei Datum geht es schon: DATEIEN.Dateidatum := VAL(LTRIM(RTRIM(sTmp[27,10]))); |
Um die Nummer einer Tabelle im aktuellen Projekt zu ermitteln, VAL verwenden.
VAL("TABELLE1.DAT");
|
Val(Zeichenkette: String): Real; |
Procedure Taschenrechner : Real;
Vardef sFrage : String;
sFrage := "";
Input(sFrage, "Taschenrechner");
Return Val(T-Eingabe)
EndProc;
...#Eine kleine Rechenspielerei.
Procedure Taschenrechner(A, B : Real)
Vardef sFrage : String;
sFrage := Str(A) + " mal " + Str(B) + " ist?";
Input(sFrage, "Rechentest");
If Val(T-Eingabe) ist A * B
Message("Sehr gut!")
Else
Message("Ist leider nicht richtig!");
End
EndProc;
|
Tabellenfeld Zeichenkette als Zahl prüfen
Procedure Prüfe_Zahl;
..#Zeichenkette als Zahl prüfen
..##
VarDef nRT : Integer; ..Rückgabe
..Fehlerhandling setzen
SetPara('ec 1');
nRT := VAL(TABELLE.MeinWert);
If $Fehler <> 0
Message("Fehler: Wert '" + TABELLE.MeinWert + "' ist kein Zahl! Fehlercode: " + Str(nRT), "Fehler");
End;
SetPara('ec 0');
Endproc;
|
Var nRegisterSeiteAktiv : Integer; nRegisterSeiteAktiv := ViewPage(0); |
Procedure StringToFile(sStr : String);
..#string in eine text datei speichern
..##
Var sDatei = "temp.txt"; ..textdatei
Vardef nFH : Integer; ..dateihandle
If nFH := Rewrite(sDatei) > 0
WriteLn(nFH, sStr);
Close(nFH);
Message("Datei erstellt.", "Hinweis");
Else
Message("Datei kann nicht erstellt werden!", "Fehler");
End;
Endproc;
|
procedure StringImEditorZeigen(sStr : String);
..#string in eine text datei speichern und im standardeditor zeigen
..#beispiel: StringImEditorZeigen("Hallo, hier nich ich...");
..##
Var sDatei = "temp.txt"; ..textdatei
Vardef nFH : Integer; ..dateihandle
If nFH := Rewrite(sDatei) > 0
WriteLn(nFH, sStr);
Close(nFH);
Execute(sDatei);
Else
Message("Datei kann nicht erstellt werden!", "Fehler");
End;
EndProc;
|
Procedure Str2TmpFile(nArt : Real; sTmpfile, sStr : String); ..#kopiert einen string in eine tempdatei. ..#auch wenn sstr leer ist wird eine datei erstellt (dann aber 0 byte) VarDef nFI : REAL; ..speicherdatei anlegen oder anhängen ?nArt = 1 / nFI := Rewrite(sTmpfile); ?nArt = 2 / nFI := TAppend(sTmpfile); ?nFI = 0 / Return ?sStr <> "" / WriteLn(nFI, sStr); Close(nFI); Endproc |
Write(Ln) Write(Zahl: Real; Zeichenkette: String) WriteLn(Zahl: Real, Zeichenkette: String) |
Write(0, $1) gibt Fehlermeldung "Typen stimmen nicht überein" Lösung: Write(0, $Feldname); |
Mittels Write(Ln) werden Zeichenketten in Gänzefüßen dargestellt.
Beispiel:
WriteLn("Hallo");
Um das Zeichen " mittels Write(Ln) auszugeben, die Funktion CHRverwenden.
Beispiel:
WriteLn("Jetzt wird das Zeichen " + Chr(34) + " ausgegeben.");
Man beachte, daß als Code den ANSI-Code angegeben werden muß. Ist denANSI-Code nicht bekannt,
dann kann diese mittels der Funktion Asc("zeichen") ermittelt werden.
Beispiel:
Message("ANSI-Zeichencode:"+Str(Asc(""")));
|
Procedure Hex2StrOEM(sHex: string): string; ..#wandelt ein hexwert in ein dezimalstring um. diese kann dann mittels der VAL funktion in ..#ein wert umgewandelt werden. ..#Parameter: ..#sHex = Hexstring Vardef x : Real; x := xWert(Asc(sHex[2]) - 48,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,0,10,11,12,13,14,15) * 16 ; x := x + xWert(Asc(sHex[3]) - 48,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,0,10,11,12,13,14,15); Return AnsiToOEM( Chr(x) ) Endproc; |
XWert(Selektor: Integer; Ausdruck1, Ausdruck2, ..., AusdruckN): Variant; |
XWert erwartet als Rückgabe einen Integer Wert. Bei der Verwendung von VAL, wo einen Real zurückgegeben wird, muss diesen Wert mittels INT in ein Integer umgewandelt werden. Val(Zeichenkette: String): Real XWert(Selektor: Integer; Ausdruck1, Ausdruck2, ..., AusdruckN): Variant; Vardef nReal : Real; Vardef nInteger: Integer; nInteger := xWert(Int(Val(nReal)), '', '', '', '', '', '', '', "Hallo Welt", '', '') |
Procedure Volltextsuche;
SetAccess( TITEL, "AUTOR.IND")
MarkTable( TITEL.DAT, VOLLTITEL.DAT,"Suchbegriff","","",0,SCHLAGWO.REL)
Run("TITEL.Titelsuche");
Endproc;
Sortierreihenfolge kann mittels SortMark gesetzt werden.
|
PROCEDURE Volltextsuche
..#Beispiel einer Volltextsuche
..##
ACCESS(ADRESSEN, "ADRESSEN.ID");
DelMarks(ADRESSEN);
T-Eingabe := ""
IF INPUT("Bitte geben Sie Ihren Suchbegriff ein:")=1
T-Eingabe := UPPER(T-Eingabe)
MarkTable(ADRESSEN.DAT, STICHWOR.DAT, T-Eingabe,"","",0, STICHWOR.REL)
IF nMarks( ADRESSEN)>0
Showwait(STR( nMarks( ADRESSEN))+" Eintrag gefunden!")
ACCESS( ADRESSEN,"Markierung")
ATTACH;
SetSortOrder("ADRESSEN.ID",2)
SetView(2)
ELSE
Message("Keinen passenden Datensatz gefunden");
END
END:
Endproc;
|
Beispiel: gesucht wird der Inhalt String sStr in der Tabelle VTINDEX. Die gefunde Einträge werden dann in Tabelle TIPPS markiert.
Die Tabelle STICHWORT enthält die Relation zwischen der Tabelle TIPPS und der Volltextindex Tabelle VTINDEX.
Vardef nRT : Integer; ..#Rückgabewert.
nRT := MarkTable($TIPPS, $VTINDEX, sStr, '', '', 0, $STICHWORT);
..#fehler?
Vardef sHStr : String;
If nRT >= 201 And nRT <= 204
?nRT = 201 / sHStr := "Ungültige Index-Tabelle";
?nRT = 202 / sHStr := "Ungültige Relation"
?nRT = 203 / sHStr := "Schließende Klammer erwartet"
?nRT = 204 / sHStr := "Ungültiges Zeichen"
Message(sHStr, "Fehler Volltextsuche"););
Return
End;
|
Beispiel Volltext aktualisieren für die Tabelle Tipps. Die Stichworte werden in der Tabelle VTINDEX gespeichert und die Relation zwischen der Tabelle TIPPS und VTINDEX mittels STICHWORT.REL. Die Angabe der Felder, Fields, sollte der Tabellennamen vorangestellt werden. Das Dollar ($) Zeichen dabei nicht vergessen. Vardef nCnt : Integer; ..#die Anzahl der gefunden Einträge. nCnt := ScanRecs($TIPPS, $VTINDEX, $STICHWORT, Fields($TIPPS.Beschreibung, $TIPPS.Tipp), "", 100, BaseDir+"stiwono.txt", 0); |
Wenn ein Volltextindex statt über die TurboDB Studio Oberfläche mit der TurboPL-Funktion ScanRecs erzeugt wird, kann ein erweitertes Alphabet angeben (Parameter ExtABC) werden und dort Zahlen mit aufnehmen. Nachdem der Volltextindex mit ScanRecs unter Verwendung von ExtABC erzeugt wurde, muß bei der Suche nun ebenfalls das erweiterte Alphabet angegeben werden. Es ist deshalb besser für die Suche die Funktion MarkTable zu verwenden. |