; Schnittstelle zu anderen Modulen:
;
; INPUT und INPUTRESTRIKTIONEN
; ============================
;
; Parameter    :
;
; Typ    Variablename      Variablebeschreibung [Wertebereich]
; str    ctxtstilup        Textstil
;
; OUTPUT und OUTPUTRESTRIKTIONEN
; ==============================
;
; Parameter    :
;
; Typ    Variablenname     Variablenbeschreibung  [Wertebereich]
; str    cschrdat          Schriftdatei (z.B. M.ttf)
;
;----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
;
(defun schriftdatei_ermitteln ( ctxtstilup
                                / 
                                cpfad cschrdat ctxtstil
                                ilpos
                                lschrdat lstil lfontslist lreg  )

; Die Übergabevariablen in lokale Variablen übernehmen
  (setq ctxtstil ctxtstilup)
  
; Die Schriftdatei des Textstils ermitteln
  (setq lstil (tblsearch "style" ctxtstil))
  (setq lschrdat (assoc 3 lstil))
  (setq cschrdat (cdr lschrdat))


  (if (= cschrdat "") ; wegen Arial Narrow Standard
    (progn

      (setq lobjtxtstil (entget (tblobjname "STYLE" ctxtstil) '("*")))
      (setq lxdata (assoc -3 lobjtxtstil))
      (setq lacad (nth 0 (cdr lxdata)))
      (setq l1000 (nth 1 lacad))
      (setq cschrname (cdr l1000))
      
      (setq lfontslist nil)
      (setq lreg nil)
      (foreach lreg (vl-registry-descendents  "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts"  "")
	(setq lfontslist (cons (cons (strcase(vl-registry-read "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts" lreg)) lreg) lfontslist))
      ) ; foreach

      (setq ianzfontslist (length lfontslist))
      (setq izlerfontslist 0)
      (while (and (< izlerfontslist ianzfontslist) (= cschrdat ""))
	(setq lschl (nth izlerfontslist lfontslist))
	(setq cschrdatschl (car lschl))
	(setq cschrnameschl (cdr lschl))
	(setq ispos (strpos cschrnameschl cschrname 1))
	(if (/= ispos nil)
	  (setq cschrdat cschrdatschl)
	) ; if
	(setq izlerfontslist (+ izlerfontslist 1))
       ) ; while

    ) ; progn
  ) ; if

  

; Den möglichen Pfad der Schriftdatei entfernen
  (setq cpfad (dateipfad_ermitteln cschrdat))
  (setq ilpos (+ (strlen cpfad) 1))
  (setq cschrdat (substr cschrdat ilpos (strlen cschrdat)))
  
; Rückgabewert
  cschrdat

) ; Modulende