PureBoard

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
      
      

      
    EndIf

Code: Alles auswählen

Procedure EnumFontProc(*lpelfe.LOGFONT, *lpntme.TEXTMETRIC, fontType, lParam)
  Debug PeekS(@*lpelfe\lfFaceName)
  ProcedureReturn 1
EndProcedure

LF.LOGFONT

OpenWindow(0,0,0,0,0,"", #PB_Window_Invisible)
EditorGadget(0,0,0,0,0)

EnumFontFamiliesEx_(GetDC_(GadgetID(0)), LF, @EnumFontProc() ,0 ,0)