|
|
Post by henrik14 on Jul 12, 2012 15:30:42 GMT 1
Greetings from retired programmer!
I want to convert my GFA16 programs to GFA32, and one automated conversion program I have found I cannot make to work because some files are required and not explained nor supplied.
One of things I would need is example how cam program draw in memory
from where it could be StretchBlitted to screen or on paper page.
Next, one example of creating Class in GFA32 and using it. If not possible,
then example how to use classes and Methods from some other OO language. I collected hundreds of GFA32 examples that are in German language that I do not understand much. Some are missing files, some
do not work, so this is not real help.
A book like one that Sjouke Hamstra wrote for GFA16 would be needed.
Using WINDOWS API is also not explained and instructions are not grouped
by their function but listed alphabetically, which do not help if one does not know that instruction exist, and some work only in proper sequences.
Thank You in advance!
|
|
drfjm
New Member
Posts: 13
|
Post by drfjm on Jul 17, 2012 8:03:09 GMT 1
I am working on such a program. It is not yet ready. I can send it as it is now, once I have an email address, preferably in exchange for the program you mention, anyhow, what is the name? perhaps I have it already. I did some research before starting my own.
|
|
|
|
Post by henrik14 on Aug 12, 2012 16:38:26 GMT 1
$NoAutoPostfix
Global Const ChangeBool? = True
@init_global
@main
End
Procedure init_global
Global Zeile$(64000), LSpc%(64000)
Global AnzZeilen%, t%
'
Public NoWordBegS As String = "@_.ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890"
Public NoWordEndS As String = "&|?%!#${(_.ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890"
'
Return
>Procedure main
Local i%
'
OpenW 1
Print "Dateien laden"
@load_lst_files
@make_16to32_variablen
'
t% = Timer
Print "32-Bit-Zeilen aktivieren"
@aktiviere_g32_zeilen
'
Print "Doppelte Variablen ersetzen"
@replace_doppelte_variablen
'
Print "Befehle ersetzen"
@befehle_ersetzen
'
Print "Boolean-Variablen umformen"
@boolean_umformen
'
Print "Dateien speichern und globale Variablen einfügen"
@save_g32("OUTPUT.G32")
Print Round(Timer - t%, 2); " Sekunden"
Beep
KeyGet i%
CloseW 1
Return
'
Procedure load_lst_files
Local Dim flt$(64000), byt$(64000), bit$(64000)
Local anz_flt%, anz_byt%, anz_bit%
Local i%, line$
'
If Exist(App.Path + "\FLT.LST")
Open App.Path + "\FLT.LST" for Input As # 1
Recall # 1, flt$(), -1, anz_flt%
Close # 1
Insert flt$(0) = "" // Erstes Feld immer leer lassen
Else
MsgBox "Datei nicht gefunden:" + Chr$(10) + App.Path + "\FLT.LST" + Chr$(10, 10) + "Diese LST-Datei muss mit der Option" + Chr$(10) + """DefFlt A-Z"" abgespeichert worden sein."
CloseW 1
End
EndIf
'
If Exist(App.Path + "\BYT.LST")
Open App.Path + "\BYT.LST" for Input As # 2
Recall # 2, byt$(), -1, anz_byt%
Close # 2
Insert byt$(0) = "" // Erstes Feld immer leer lassen
Else
MsgBox "Datei nicht gefunden:" + Chr$(10) + App.Path + "\FLT.LST" + Chr$(10, 10) + "Diese LST-Datei muss mit der Option" + Chr$(10) + """DefByt A-Z"" abgespeichert worden sein."
CloseW 1
End
EndIf
'
If Exist(App.Path + "\BIT.LST")
Open App.Path + "\BIT.LST" for Input As # 3
Recall # 3, bit$(), -1, anz_bit%
Close # 3
Insert bit$(0) = "" // Erstes Feld immer leer lassen
Else
MsgBox "Datei nicht gefunden:" + Chr$(10) + App.Path + "\BIT.LST" + Chr$(10, 10) + "Diese LST-Datei muss mit der Option" + Chr$(10) + """DefBit A-Z"" abgespeichert worden sein."
CloseW 1
End
EndIf
'
If anz_flt% <> anz_byt% Or anz_byt% <> anz_bit%
Message "Dateilängen stimmen nicht bei ""FLT, BYT, BIT"" überein."
EndIf
'
For i% = 1 To anz_flt%
line$ = flt$(i%)
If Len(byt$(i%)) > Len(line$)
line$ = byt$(i%)
EndIf
If Len(bit$(i%)) > Len(line$) // längste Zeile suchen
line$ = bit$(i%)
EndIf
Zeile$(i%) = line$
Next i%
'
AnzZeilen% = anz_flt%
If Trim$(Zeile$(AnzZeilen%)) = "" // unten dranhängende Leerzeichen abschneiden
Repeat
Dec AnzZeilen%
Until Zeile$(AnzZeilen%) <> ""
EndIf
'
For i% = 1 To AnzZeilen%
line$ = LTrim$(Zeile$(i%)) // Linke Leerzeichen abschneiden und merken
LSpc%(i%) = Len(Zeile$(i%)) - Len(line$)
Zeile$(i%) = line$
Next i%
'
For i% = 1 To AnzZeilen%
If Left$(Zeile$(i%), 9) = "Function " Or Left$(Zeile$(i%), 11) = "> Function " Or Left$(Zeile$(i%), 10) = "Procedure " Or Left$(Zeile$(i%), 12) = "> Procedure "
MsgBox "Konvertierung nicht möglich:" + Chr$(10) + "Alle Befehle müssen in den LST-Files in Großbuchstaben enthalten sein." + Chr$(10, 10) + "Den GFA16-Interpreter erneut starten, dann auf den Button ""Config"" klicken, unten rechts das letzte Häkchen entfernen und alle LST-Dateien erneut speichern."
CloseW 1
End
EndIf
Next i%
Return
'##B#
Procedure make_16to32_variablen
'##E#
Local Dim var_zei$(50000), anz%, i%, z%
'
If Exist(App.Path + "\GFA16VAR.TXT")
Open App.Path + "\GFA16VAR.TXT" for Input As # 1
'##B#
Recall # 1, var_zei$(), -1, anz%
Close # 1
Insert var_zei$(0) = ""
Else
MsgBox "Datei nicht gefunden:" + Chr$(10) + App.Path + "\GFA16VAR.TXT" + Chr$(10, 10) + "Diese Text-Datei muss alle Variablen der 16-Bit-Datei enthalten, dazu im 16-Bit-Interpreter auf den Button ""Variable"" klicken und dann die Variablen mit ""C+Strg"" aufs Klemmbrett kopieren."
CloseW 1
End
EndIf
'
Open App.Path + "\GB32_VAR.G32" for Output As # 1
For i% = 1 To anz% // Step 5
If Right$(var_zei$(i%)) <> ")"
If var_zei$(i%) <> "dim%" 'And Left$(var_zei$(i%), 2) <> "W_" ' W_GR& usw. jetzt als Constanten
If ChangeBool? = True
If InStr(var_zei$(i%), "!")
var_zei$(i%) = @replace$(var_zei$(i%), "!", "?")
EndIf
EndIf
Print # 1; "GLOBAL " + var_zei$(i%)
Else ' bleibt jetzt leer
Print # 1; "GLOBAL DIM " + var_zei$(i%) // wegen Fehler bei Variable "dim%"
EndIf
Else If Right$(var_zei$(i%), 3) = "!()"
var_zei$(i%) = @replace$(var_zei$(i%), "!()", "?()")
EndIf
Print " "; // Läuft nur mit diesem Print in der Schleife, hängt sonst im Compiler ?!?!
'
Next i%
Close # 1
'
Open App.Path + "\Doppelt_var.txt" for Output As # 1
For i% = 1 To anz%
If Right$(var_zei$(i%)) <> ")" And Right$(var_zei$(i% + 1)) = ")"
If Trim$(var_zei$(i%)) <> ""
' MsgBox var_zei$(i%) + " " + var_zei$(i% + 1)
If Upper$(var_zei$(i%)) = Upper$(Left$(var_zei$(i% + 1), Len(var_zei$(i% + 1)) - 2))
Print # 1, Left$(var_zei$(i% + 1), Len(var_zei$(i% + 1)) - 2)
EndIf
EndIf
EndIf
Next i%
Close # 1
'
Return
Procedure replace_doppelte_variablen
Local line$, line2$, i%, z%
Open App.Path + "\Doppelt_var.txt" for Input As # 1
While EOF(# 1) = False
Line Input # 1, line$
Exit If Trim$(line$) = ""
line2$ = Left$(line$, Len(line$) - 1) + "Ar" + Right$(line$) + "("
line$ = Trim$(line$) + "("
'
z% = 0
For i% = 1 To AnzZeilen%
If InStr(Zeile$(i%), line$) > 0
' Zeile$(i%) = @replace$(Zeile$(i%), line$, line2$)
Zeile$(i%) = @replwordspar(Zeile$(i%), line$, line2$)
Inc z%
EndIf
Next i%
If z% = 0
Message "Feldvariable " + line$ + " nicht gefunden."
EndIf
'
Wend
Close # 1
Return
'
Procedure aktiviere_g32_zeilen
Local i%, anz_spc%
'
For i% = 1 To AnzZeilen%
If Left$(Zeile$(i%), 4) = "//+ "
Zeile$(i%) = Mid$(Zeile$(i%), 5)
If Right$(Trim$(Zeile$(i%)), 2) <> " _" ' Bei umgebrochenen GB32-Zeilen nichts anhängen
Zeile$(i%) = Zeile$(i%) + " //+"
EndIf
Else If Left$(Zeile$(i%), 3) = "//+"
Zeile$(i%) = Mid$(Zeile$(i%), 4)
If Right$(Trim$(Zeile$(i%)), 2) <> " _" ' Bei umgebrochenen GB32-Zeilen nichts anhängen
Zeile$(i%) = Zeile$(i%) + " //+"
EndIf
EndIf
If Right$(Trim$(Zeile$(i%)), 3) = "//-"
Zeile$(i%) = "'° " + Zeile$(i%)
EndIf
'
If InStr(Zeile$(i%), "/*-*/") > 0
Zeile$(i%) = @replace$(Zeile$(i%), "/*-*/", " '°° ")
EndIf
'
If Trim$(Zeile$(i%)) = "//+++"
Message "'//+++' ohne vorher '//---'"
EndIf
'
If Trim$(Zeile$(i%)) = "//---"
anz_spc% = LSpc%(i%)
Repeat
Inc i% // Ganzen Block deaktivieren
Exit If Trim$(Zeile$(i%)) = "//+++"
If Trim$(Zeile$(i%)) = "RETURN" Or Trim$(Zeile$(i%)) = "ENDFUNC"
' Message "RETURN/ENDFUNC nach '//---'" // RETURN/ENDFUNC nicht im Block erlaubt
EndIf
If Left$(Zeile$(i%), 4) = "//+ "
Zeile$(i%) = Mid$(Zeile$(i%), 5) + " //+"
Else If Left$(Zeile$(i%), 3) = "//+" // Im Block können einzelne Zeilen bleiben
Zeile$(i%) = Mid$(Zeile$(i%), 4) + " //+"
Else
If LSpc%(i%) =< anz_spc%
Zeile$(i%) = "'° " + Zeile$(i%)
Else
Zeile$(i%) = "'° " + Space$(LSpc%(i%) - anz_spc%) + Zeile$(i%)
EndIf
EndIf
Until i% => AnzZeilen%
EndIf
'
Next i%
'
Return
Procedure befehle_ersetzen
Local i%
'
For i% = 1 To 25
If Trim$(Zeile$(i%)) = "$CHKA+"
Zeile$(i%) = "'CHKA+"
Else If Left$(Zeile$(i%), 6) = "DEFFLT"
Zeile$(i%) = "// DEFWRD ""a-z"""
EndIf
Next i%
'
For i% = 1 To AnzZeilen%
If Left$(Zeile$(i%), 4) = "DIM "
Zeile$(i%) = "GLOBAL " + Zeile$(i%) // Felddimensionierungen immer Global
'
Else If Trim$(Zeile$(i%)) = "EDIT" // "Edit" gegen "End" ersetzen
Zeile$(i%) = "END"
EndIf
Next i%
'
For i% = 1 To AnzZeilen%
'
If InStr(Zeile$(i%), "MKI$(") > 0
Zeile$(i%) = @replwordspar(Zeile$(i%), "MKI$(", "MKW$(") ' MKI$() => MKW$()
EndIf
If InStr(Zeile$(i%), "CVI(") > 0
Zeile$(i%) = @replwordspar(Zeile$(i%), "CVI(", "CVW(") ' MKI$() => MKW$()
EndIf
'
If InStr(Zeile$(i%), "TIMER") > 0
If InStr(Zeile$(i%), "WM_TIMER") = 0
Zeile$(i%) = @replace$(Zeile$(i%), "TIMER", "oTimer") ' TIMER => oTimer
EndIf
EndIf
'
If InStr(Zeile$(i%), "WinExec(V:") > 0
Zeile$(i%) = @replace$(Zeile$(i%), "WinExec(V:", "WinExec(") ' "V:" rausnehmen
EndIf
'
If InStr(Zeile$(i%), " COLOR ") > 0
Zeile$(i%) = @replace$(Zeile$(i%), " COLOR ", " QBColor ") ' COLOR => QBColor
EndIf
If Left$(Zeile$(i%), 6) = "COLOR "
Zeile$(i%) = "QB" + Zeile$(i%)
EndIf
'
If InStr(Zeile$(i%), "LoadCursor(") > 0
Zeile$(i%) = @replace$(Zeile$(i%), "LoadCursor(", "apiLoadCursor(") ' Constante von Word auf Long ändern
EndIf
If InStr(Zeile$(i%), "GCW_HCURSOR") > 0
Zeile$(i%) = @replace$(Zeile$(i%), "GCW_HCURSOR", "GCL_HCURSOR") ' Constante von Word auf Long ändern
EndIf
'
If Left$(Zeile$(i%), 9) = "FUNCTION " Or Left$(Zeile$(i%), 11) = "> FUNCTION "
Zeile$(i%) = @replace$(Zeile$(i%), "'As Long", "As Long") ' Constante von Word auf Long ändern
EndIf
Next i%
'
Return
Procedure boolean_umformen
Local Dim var_zei$(5000), anz%, i%, j%, z%, neu$, alt$
Local Dim bool_drin%(64000)
'
If ChangeBool? = False Then Exit Sub
'
Open App.Path + "\GFA16VAR.TXT" for Input As # 1
Recall # 1, var_zei$(), -1, anz%
Close # 1
Insert var_zei$(0) = ""
'
For i% = 1 To AnzZeilen%
If InStr(Zeile$(i%), "!") > 0
bool_drin%(i%) = True
EndIf
Next i%
'
For j% = 1 To anz%
If Mod(j%, 100) = 0
Print j% / 100;
EndIf
alt$ = var_zei$(j%)
alt$ = @replace$(alt$, "()", "(")
neu$ = @replace$(alt$, "!", "?")
If Right$(neu$, 2) = "?("
For i% = 1 To AnzZeilen%
If bool_drin%(i%) = True
Zeile$(i%) = @replwordspar(Zeile$(i%), alt$, neu$) '
EndIf
Next i%
Else If Right$(neu$) = "?"
For i% = 1 To AnzZeilen%
If bool_drin%(i%) = True
Zeile$(i%) = @replwordscode(Zeile$(i%), alt$, neu$) '
EndIf
Next i%
EndIf
Next j%
Print ""
Return
Procedure save_g32(f_name$)
Local i%, len%, file$, gesamtCode$, globVariablen$
Local Dim var_zei$(5000), anz%, z%
'
Try
Open App.Path + "\GB32_VAR.G32" for Input As # 1
Recall # 1, var_zei$(), -1, anz%
Close # 1
Insert var_zei$(0) = ""
Catch
MsgBox "File not found:" + Chr$(10) + App.Path + "\GB32_VAR.G32"
EndCatch
'
file$ = App.Path + "\" + f_name$
Open file$ for Output As # 1
Print # 1, "$NoAutoPostfix"
Print # 1, "Mode StrSpace 0"
Print # 1, "@declareglobalvariables"
For i% = 1 To AnzZeilen%
Print # 1, Space$(LSpc%(i%)) + Zeile$(i%)
Next i%
Print # 1, ">Procedure DeclareGlobalVariables"
For i% = 1 To anz%
Print # 1, " " + var_zei$(i%)
Next i%
Print # 1, "Return"
Print # 1, ">Procedure KILLEVENT"
Print # 1, " If Me Is Nothing = False"
Print # 1, " Me.ValidateAll"
Print # 1, " EndIf"
Print # 1, "Return"
Print # 1, ">Procedure TheEmptyProcedureAtTheEnd"
Print # 1, " '"
Print # 1, "Return"
Close # 1
'
Return
'
Function ReplWordsCode(ByVal strngS As String, ByVal rausS As String, ByVal reinS As String) As String
' Replace-Befehl: Zum Ersetzen von Befehlen ohne Parametern im Code-Teil
' oder Einzelvariablen (keine Arrays) sowie Funktionen ohne Parameter.
' ACHTUNG: Marken gleichen Namens werden durchgehend mit ersetzt!
'
If InStr(strngS, rausS) = 0 Then GoTo ReplaceWords 'Zeit sparen: Gleich raus, wenn nichts drin
If Left$(strngS, 5) = "DATA " Then GoTo ReplaceWords ' Keine Datazeilen bearbeiten
'
' Benötigt als Public: NoWordBegS und NoWordEndS
Dim rghtS As String, len_dif As Long, posi As Long, beg As Long
Dim WordBeg?, WordEnd?, AbgesetzteKlammer?
len_dif = Len(reinS) - Len(rausS)
'
posi = InStr(ClrTxt(strngS), rausS) ' Instr. mit auskommentiertem Text
While posi
'
If posi = 1 ' Wort gleich am Zeilenanfang?
WordBeg? = True
ElseIf InStr(NoWordBegS, Mid$(strngS, posi - 1, 1)) = 0
WordBeg? = True ' Suchstring war am Wortanfang
Else
WordBeg? = False ' Suchstring find im Wort an
EndIf
'
If posi + Len(rausS) > Len(strngS) ' Wort ganz am Zeilenende?
WordEnd? = True
ElseIf InStr(NoWordEndS, Mid$(strngS, posi + Len(rausS), 1)) = 0
WordEnd? = True ' Suchstring war am Wortanfang
Else
WordEnd? = False ' Suchstring find im Wort an
EndIf
'
' WordEnd? = True
If WordBeg? = True And WordEnd? = True
'
AbgesetzteKlammer? = False
If Mid$(strngS, posi + Len(rausS), 2) = " (" Or Mid$(strngS, posi + Len(rausS), 3) = " ("
Message "Abgesetzte Klammer, Wort wird daher nicht ersetzt: " + Chr$(10) + Chr$(10) + strngS
AbgesetzteKlammer? = True
EndIf
'
If AbgesetzteKlammer? = False
rghtS = Mid$(strngS, posi + Len(rausS))
If Len(strngS) + len_dif <= 32760 * 32760 * 2 Then
strngS = Left$(strngS, posi - 1) + reinS + rghtS
EndIf
beg = posi + 1 + len_dif
Else
beg = posi + 1
EndIf
Else
beg = posi + 1
EndIf
'
posi = InStr(beg, ClrTxt(strngS), rausS) ' ab ersetztem Wort weitersuchen
Wend
'
ReplaceWords:
Return strngS
'
EndFunc
Function ReplWordsPar(ByVal strngS As String, ByVal rausS As String, ByVal reinS As String) As String
' Replace-Parameter-Befehl: Zum Ersetzen von Befehlen, die mit ( oder { enden,
' oder Feldvariablen (keine Wort-Überprüfung am Ende, nur am Beginn) sowie Funktionen,
' die mit "(" enden, d.h. Parameter übergeben.
' Achtung: die Klammer darf nicht abgesetzt sein, Beispiel: "ClrTxt (zeile$)", sonst
' die Funktion zwei mal aufrufen (einmal mit, einmal ohne Leerzeichen)
'
If InStr(strngS, rausS) = 0 Then GoTo ReplaceEnde 'Zeit sparen: Gleich raus, wenn nichts drin
If Left$(strngS, 5) = "DATA " Then GoTo ReplaceEnde ' Keine Datazeilen bearbeiten
'
' Benötigt als Public: NoWordBegS
Dim rghtS As String, len_dif As Long, posi As Long, beg As Long, WordBeg?
len_dif = Len(reinS) - Len(rausS)
'
posi = InStr(ClrTxt(strngS), rausS)
While posi
'
If posi = 1
WordBeg? = True
ElseIf InStr(NoWordBegS, Mid$(strngS, posi - 1, 1)) = 0
WordBeg? = True
Else
WordBeg? = False
EndIf
'
If WordBeg? = True
rghtS = Mid$(strngS, posi + Len(rausS))
If Len(strngS) + len_dif <= 32760 * 32760 * 2 Then
strngS = Left$(strngS, posi - 1) + reinS + rghtS
EndIf
beg = posi + 1 + len_dif
Else
beg = posi + 1
EndIf
'
posi = InStr(beg, ClrTxt(strngS), rausS)
Wend
'
ReplaceEnde:
Return strngS
'
EndFunc
Function replace$(strng$, raus$, rein$)
'| Aufruf in : img_name_holen-1,schluessel_holen-5,nwp_stamm_dp-2
'| v_konvert_bayern-1,seite_lesen-6,bilanz_name-1,d_drucken-1
'| d_liste_speichern-1,sort_alphabet-4,div_akgew_drucken-4,hilfe-1
'| service-1,
// ProcNr=7400
Local rght$, len_dif%, pos%, beg%
len_dif% = Len(rein$) - Len(raus$)
'
pos% = InStr(strng$, raus$)
While pos%
'
rght$ = Mid$(strng$, pos% + Len(raus$))
If Len(strng$) + len_dif% <= 32760 * 32760 * 2
strng$ = Left$(strng$, pos% - 1) + rein$ + rght$
EndIf
'
beg% = pos% + 1 + len_dif%
pos% = InStr(beg%, strng$, raus$)
Wend
'
Return strng$
'
EndFunc
Function ClrTxt(ByVal zeile As String) As String
' Benötigt als Public: NoWordBegS
If Left$(zeile, 5) = "Data " ' Keine DATA-Zeilen bearbeiten...
zeile = "Data " + Space$(Len(zeile) - 5) '...komplett auskommentieren
EndIf
If InStr(zeile, Chr$(34)) = 0 Then GoTo ClrTxtEnde 'Zeit sparen: Gleich raus, wenn nicht " drin
'
Dim inAZ As Boolean ' Flag "in Anführungszeichen"
Dim i As Long
' Für die korrekte Erkennung von Schlüsselwörtern alles was in Anführungszeichen steht löschen
For i = 2 To Len(zeile) - 1
If Mid$(zeile, i, 1) = Chr$(34) Then
inAZ = Not inAZ
ElseIf inAZ = True Then
Mid$(zeile, i, 1) = " "
EndIf
Next i
'
ClrTxtEnde:
Return zeile
'
End Function
Procedure nichts
Return
$DatFile
$FormVersion = 2
$ExeName = dxa_konv.Exe
$FileDescription = Beschreibung
$Comments = Autor: Peter Harder
$CompanyName = Peter Harder
$LegalCopyright = © 2002 Peter Harder
$LanguageId = 0407
$FileVersion = %d.%d.%d.%d
$ProductVersion = %d.%d.%d.%d
$DatFile
|
|
