home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / system / callback / enumfont.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-02-27  |  7.6 KB  |  232 lines
  1. VERSION 2.00
  2. Begin Form frmEnumFonts 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "EnumFonts"
  5.    ClientHeight    =   5775
  6.    ClientLeft      =   780
  7.    ClientTop       =   675
  8.    ClientWidth     =   6945
  9.    Height          =   6180
  10.    Left            =   720
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   5775
  13.    ScaleWidth      =   6945
  14.    Top             =   330
  15.    Width           =   7065
  16.    Begin CommandButton cmdZur
  17.       BackColor       =   &H00C0C0C0&
  18.       Caption         =   "Zur
  19.       Height          =   330
  20.       Left            =   5775
  21.       TabIndex        =   12
  22.       Top             =   5340
  23.       Width           =   1065
  24.    End
  25.    Begin Frame fraComment 
  26.       BackColor       =   &H00C0C0C0&
  27.       Height          =   1935
  28.       Left            =   120
  29.       TabIndex        =   8
  30.       Top             =   3360
  31.       Width           =   6735
  32.       Begin Label lblCommentText 
  33.          BackStyle       =   0  'Transparent
  34.          Caption         =   "Zugegeben: 
  35. ber das SCREEN-Objekt kann man auch alle Zeichens
  36. tze eines Forms ermitteln. Beim Drucker m
  37. sste man sich aber schon der hier vorgestellten EnumFonts()-Methode bedienen. Auch wenn nur TrueType-Fonts ermittelt werden sollen m
  38. ssen Sie sich der Hilfe von EnumFonts() versichern. Klicken Sie in der Listbox auf einen Font um eine Kostprobe der Zeichen zu erhalten!"
  39.          FontBold        =   0   'False
  40.          FontItalic      =   0   'False
  41.          FontName        =   "MS Sans Serif"
  42.          FontSize        =   9.75
  43.          FontStrikethru  =   0   'False
  44.          FontUnderline   =   0   'False
  45.          Height          =   1635
  46.          Left            =   60
  47.          TabIndex        =   0
  48.          Top             =   360
  49.          Width           =   6615
  50.       End
  51.       Begin Label lblComment 
  52.          Alignment       =   2  'Center
  53.          BackColor       =   &H00000000&
  54.          Caption         =   " Kommentar:"
  55.          ForeColor       =   &H00FFFFFF&
  56.          Height          =   255
  57.          Left            =   0
  58.          TabIndex        =   1
  59.          Top             =   60
  60.          Width           =   6735
  61.       End
  62.    End
  63.    Begin Frame fraDemo 
  64.       BackColor       =   &H00C0C0C0&
  65.       Height          =   1335
  66.       Left            =   120
  67.       TabIndex        =   5
  68.       Top             =   1980
  69.       Width           =   6735
  70.       Begin Label lblDemoText 
  71.          Alignment       =   2  'Center
  72.          BackStyle       =   0  'Transparent
  73.          Caption         =   "ABCabc0123"
  74.          FontBold        =   0   'False
  75.          FontItalic      =   0   'False
  76.          FontName        =   "MS Sans Serif"
  77.          FontSize        =   13.5
  78.          FontStrikethru  =   0   'False
  79.          FontUnderline   =   0   'False
  80.          Height          =   915
  81.          Left            =   120
  82.          TabIndex        =   7
  83.          Top             =   360
  84.          Width           =   6495
  85.       End
  86.       Begin Label lblDemo 
  87.          Alignment       =   2  'Center
  88.          BackColor       =   &H00000000&
  89.          Caption         =   " Demonstrations-Text:"
  90.          ForeColor       =   &H00FFFFFF&
  91.          Height          =   255
  92.          Left            =   0
  93.          TabIndex        =   6
  94.          Top             =   60
  95.          Width           =   6735
  96.       End
  97.    End
  98.    Begin Frame fraFonts 
  99.       BackColor       =   &H00C0C0C0&
  100.       Height          =   1875
  101.       Left            =   120
  102.       TabIndex        =   2
  103.       Top             =   60
  104.       Width           =   6735
  105.       Begin SSOption optPrinter 
  106.          Caption         =   "PrinterFonts"
  107.          Height          =   255
  108.          Left            =   1680
  109.          TabIndex        =   11
  110.          TabStop         =   0   'False
  111.          Top             =   1560
  112.          Width           =   1455
  113.       End
  114.       Begin SSOption optScreen 
  115.          Caption         =   "ScreenFonts"
  116.          Height          =   255
  117.          Left            =   60
  118.          TabIndex        =   10
  119.          Top             =   1560
  120.          Value           =   -1  'True
  121.          Width           =   1455
  122.       End
  123.       Begin TextBox txtHeader 
  124.          BackColor       =   &H00808080&
  125.          BorderStyle     =   0  'None
  126.          Enabled         =   0   'False
  127.          ForeColor       =   &H00FFFFFF&
  128.          Height          =   255
  129.          Left            =   60
  130.          MultiLine       =   -1  'True
  131.          TabIndex        =   9
  132.          Top             =   300
  133.          Width           =   6555
  134.       End
  135.       Begin ListBox lstEnumFonts 
  136.          Height          =   1005
  137.          Left            =   60
  138.          Sorted          =   -1  'True
  139.          TabIndex        =   3
  140.          Top             =   540
  141.          Width           =   6555
  142.       End
  143.       Begin Label lblFonts 
  144.          Alignment       =   2  'Center
  145.          BackColor       =   &H00000000&
  146.          Caption         =   " Zeichensatzliste:"
  147.          ForeColor       =   &H00FFFFFF&
  148.          Height          =   255
  149.          Left            =   0
  150.          TabIndex        =   4
  151.          Top             =   0
  152.          Width           =   6735
  153.       End
  154.    End
  155.    Begin CBVBX CBVBX1 
  156.       CBType          =   2  ' 2  - EnumFontsProc
  157.       Left            =   0
  158.       Top             =   0
  159.    End
  160. Option Explicit
  161. Dim LogFonts(100) As LogFont
  162. Dim iLogFont
  163. Sub CBVBX1_EnumFontsProc (lpLogFont As Long, lpNewTextMetric As Long, nFontType As Integer, lpData As Long, retval As Integer)
  164. gt jeden aufgez
  165. hlten Zeichensatz in eine Listbox ein
  166.   Dim lf As LogFont
  167.   Dim ntm As NewTextMetric
  168.   'LogFont-Strutktur f
  169. r VB zug
  170. nglich machen:
  171.   TypeAtAdress lf, ByVal lpLogFont, Len(lf)
  172.   LogFonts(iLogFont) = lf
  173.   'NewTextMetric-Struktur f
  174. r VB zug
  175. nglich machen
  176.   'TypeAtAdress ntm, ByVal lpNewTextMetric, Len(ntm)
  177.   lstEnumFonts.AddItem StringAtAdress(lf.lfFaceName) & Chr$(9) & lf.lfWidth & Chr$(9) & lf.lfWeight & Chr$(9) & lf.lfHeight
  178.   lstEnumFonts.ItemData(lstEnumFonts.NewIndex) = iLogFont
  179.   iLogFont = iLogFont + 1
  180.   'Der StringAtAdress Aufruf hilft, aus einem festen String die Zeichen zu extrahieren, die von einem Asc(0)-Zeichen (C-String) beendet werden
  181.   retval = True 'Weitere Fonts aufz
  182. End Sub
  183. Sub cmdZur
  184. ck_Click ()
  185.   Unload Me
  186. End Sub
  187. Sub Form_Load ()
  188.   LoadFonts Me.hDC
  189. End Sub
  190. Sub LoadFonts (ByVal hDC%)
  191.     Dim dummy
  192.     Static TabStops%(10)
  193.     iLogFont = 0
  194.     lstEnumFonts.Clear
  195.     TabStops(0) = 0
  196.     TabStops(1) = 70
  197.     TabStops(2) = 100
  198.     TabStops(3) = 130
  199.     TabStops(4) = 160
  200.     TabStops(5) = 190
  201.     dummy = SendMessage(lstEnumFonts.hWnd, LB_SETTABSTOPS, 10, TabStops(0))
  202.     dummy = SendMessage(txtHeader.hWnd, EM_SETTABSTOPS, 10, TabStops(0))
  203.     txtHeader.Text = "FaceName" & Chr$(9) & "Width" & Chr$(9) & "Weight" & Chr$(9) & "Height"
  204.     dummy = EnumFonts(hDC, ByVal 0&, CBVBX1.CBAdress, 0&)
  205. End Sub
  206. Sub lstEnumFonts_Click ()
  207.   Dim fn$
  208.   Dim lf As LogFont
  209.   On Error Resume Next
  210.   If lstEnumFonts.ListIndex >= 0 Then
  211.     lf = LogFonts(lstEnumFonts.ItemData(lstEnumFonts.ListIndex))
  212.     fn$ = StringAtAdress(lf.lfFaceName)
  213.     lblDemoText.FontName = fn$
  214.     If Err Then
  215.       MsgBox "Kann Font nicht anzeigen!"
  216.       Exit Sub
  217.     End If
  218.     lblDemoText.FontSize = lf.lfHeight
  219.     If lf.lfWeight <= 400 Then
  220.       lblDemoText.FontBold = False
  221.     Else
  222.       lblDemoText.FontBold = True
  223.     End If
  224.   End If
  225. End Sub
  226. Sub optPrinter_Click (Value As Integer)
  227.   If Value Then LoadFonts Printer.hDC
  228. End Sub
  229. Sub optScreen_Click (Value As Integer)
  230.   If Value Then LoadFonts Me.hDC
  231. End Sub
  232.