ich muss aus den o.g. Fontarten den Fontnamen auslesen um ihn in der Registry ablegen zu können.
Habe etwas für OTF gefunden, bin aber leider beim Portiern gescheitert. Könnte mir bitte jemand auf die Sprünge helfen?
Für Tipps zum Thema *.pfm wäre ich dankbar
Code: Alles auswählen
; --------------------------------------------------------------------------------------------------
; Original VB Code.....
;
; Private Sub Command1_Click()
; MsgBox OpenTypeFontReadFileName("L:\pixie-serif.otf")
; End Sub
;
; Function OpenTypeFontReadFileName$(OTF_FileName$)
; Dim hFile&, Buffer$, iPos&
; hFile = FreeFile
; Open OTF_FileName For Binary Access Read As hFile
; Buffer = Space(Lof(hFile))
; Get hFile, , Buffer
; iPos = InStr(1, Buffer, Chr(1) & Chr(0) & Chr(4) & Chr(2)) + 9
; OpenTypeFontReadFileName = Mid(Buffer, iPos, InStr(iPos, Buffer, vbNullChar) - iPos)
; Close hFile
; End Function
; --------------------------------------------------------------------------------------------------
;
; Mein Versuch der Umsetzung.....mit Sicherheit nicht besonders gut.
;
OTF_FileName$="g:\MercuryDisplay-Roman.otf"
If OpenFile(0, OTF_FileName$)
length = Lof(0) ; Länge der geöffneten Datei ermitteln
*MemoryID = AllocateMemory(length+1) ; Reservieren des benötigten Speichers
PokeS(*memoryid,Space(length)) ; mir Leerzeichen füllen
If *MemoryID
bytes = ReadData(0, *MemoryID, length) ; Einlesen aller Daten in den Speicherblock
Debug "Anzahl der gelesenen Bytes: " + Str(bytes)
EndIf
CloseFile(0)
*suchstr=AllocateMemory(4)
*suchstr1=AllocateMemory(1)
PokeS(*suchstr,Chr(1) + Chr(0) + Chr(4) + Chr(2))
For i=0 To length-4
If CompareMemoryString(*memoryid+i, *suchstr)=#PB_String_Equal
Debug "Gefunden "+Str(i)
Break
EndIf
Next
PokeS(*suchstr1,Chr(0))
For j=i To length-1
If CompareMemoryString(*memoryid+j, *suchstr1)=#PB_String_Equal
Debug "Gefunden "+Str(j)
Break
EndIf
Next
; hier sollte dann sowas der ausgelesene Wert stehen, zwischen Position i und j.
; leider erscheint dort aber kein Name
EndIfCode-Tags hinzugefügt
18.04.2013
RSBasic
