VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Main 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Font Reader"
   ClientHeight    =   4665
   ClientLeft      =   45
   ClientTop       =   735
   ClientWidth     =   7890
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4665
   ScaleWidth      =   7890
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Exita 
      Caption         =   "&Beenden"
      Height          =   300
      Left            =   6600
      TabIndex        =   5
      TabStop         =   0   'False
      ToolTipText     =   "Programm beenden"
      Top             =   4320
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "Wilkommen zum Font Reader"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4095
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   7695
      Begin VB.PictureBox Picture1 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         ForeColor       =   &H80000008&
         Height          =   3495
         Left            =   120
         ScaleHeight     =   3465
         ScaleWidth      =   2625
         TabIndex        =   4
         Top             =   360
         Width           =   2655
         Begin VB.CommandButton Command4 
            Caption         =   "Refresh"
            Enabled         =   0   'False
            Height          =   300
            Left            =   120
            TabIndex        =   13
            Top             =   3120
            Width           =   1215
         End
         Begin ComctlLib.ListView ListView1 
            Height          =   2175
            Left            =   120
            TabIndex        =   12
            Top             =   840
            Width           =   2415
            _ExtentX        =   4260
            _ExtentY        =   3836
            View            =   3
            Arrange         =   1
            LabelEdit       =   1
            LabelWrap       =   -1  'True
            HideSelection   =   0   'False
            _Version        =   327682
            ForeColor       =   -2147483640
            BackColor       =   -2147483643
            BorderStyle     =   1
            Appearance      =   1
            NumItems        =   2
            BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
               Key             =   ""
               Object.Tag             =   ""
               Text            =   "Font"
               Object.Width           =   2082
            EndProperty
            BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
               SubItemIndex    =   1
               Key             =   ""
               Object.Tag             =   ""
               Text            =   "Size"
               Object.Width           =   530
            EndProperty
         End
         Begin VB.CommandButton Command2 
            Caption         =   "Font Löschen"
            Enabled         =   0   'False
            Height          =   300
            Left            =   1440
            TabIndex        =   10
            Top             =   3120
            Width           =   1095
         End
         Begin VB.CommandButton Command1 
            Caption         =   "..."
            Height          =   285
            Left            =   2165
            TabIndex        =   9
            Top             =   480
            Width           =   375
         End
         Begin VB.TextBox Text2 
            Height          =   285
            Left            =   120
            Locked          =   -1  'True
            TabIndex        =   8
            Text            =   "Output-Ordner"
            Top             =   480
            Width           =   2055
         End
         Begin VB.Label Lab 
            Appearance      =   0  'Flat
            BackColor       =   &H80000005&
            BackStyle       =   0  'Transparent
            Caption         =   "Optionen:"
            BeginProperty Font 
               Name            =   "Tahoma"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00800000&
            Height          =   255
            Index           =   71
            Left            =   120
            TabIndex        =   7
            Top             =   120
            Width           =   1455
         End
         Begin VB.Image Img 
            Height          =   3120
            Index           =   0
            Left            =   1080
            Picture         =   "Form1.frx":058A
            Top             =   1800
            Width           =   1785
         End
      End
      Begin VB.PictureBox Picture2 
         Appearance      =   0  'Flat
         BackColor       =   &H00FFFFFF&
         ForeColor       =   &H80000008&
         Height          =   3495
         Left            =   3000
         ScaleHeight     =   3465
         ScaleWidth      =   4425
         TabIndex        =   2
         Top             =   360
         Width           =   4455
         Begin VB.PictureBox pics 
            Appearance      =   0  'Flat
            AutoRedraw      =   -1  'True
            AutoSize        =   -1  'True
            BackColor       =   &H00FFFFFF&
            ForeColor       =   &H80000008&
            Height          =   330
            Left            =   3960
            ScaleHeight     =   300
            ScaleWidth      =   300
            TabIndex        =   16
            Top             =   2760
            Visible         =   0   'False
            Width           =   330
         End
         Begin VB.PictureBox Picture4 
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            ForeColor       =   &H80000008&
            Height          =   520
            Left            =   120
            ScaleHeight     =   525
            ScaleWidth      =   735
            TabIndex        =   14
            Top             =   2160
            Visible         =   0   'False
            Width           =   735
            Begin VB.Shape Shape1 
               FillColor       =   &H00FFFFFF&
               FillStyle       =   0  'Solid
               Height          =   375
               Left            =   130
               Top             =   120
               Width           =   375
            End
            Begin VB.Line Line2 
               X1              =   600
               X2              =   600
               Y1              =   0
               Y2              =   600
            End
            Begin VB.Image Image3 
               Height          =   585
               Left            =   0
               Picture         =   "Form1.frx":0B0E
               Top             =   0
               Width           =   645
            End
         End
         Begin VB.TextBox Text1 
            Height          =   285
            Left            =   120
            MaxLength       =   80
            TabIndex        =   3
            Text            =   "Demonstration"
            Top             =   3120
            Width           =   4215
         End
         Begin VB.PictureBox Picture3 
            Appearance      =   0  'Flat
            AutoRedraw      =   -1  'True
            AutoSize        =   -1  'True
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            FillColor       =   &H00FFFFFF&
            ForeColor       =   &H00FFFFFF&
            Height          =   2175
            Left            =   360
            MouseIcon       =   "Form1.frx":1F6C
            ScaleHeight     =   2175
            ScaleWidth      =   3855
            TabIndex        =   15
            Top             =   360
            Width           =   3855
         End
         Begin VB.Label Label2 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "Text:"
            ForeColor       =   &H00800000&
            Height          =   195
            Left            =   120
            TabIndex        =   11
            Top             =   2880
            Width           =   360
         End
         Begin VB.Image Img 
            Height          =   3120
            Index           =   20
            Left            =   2640
            Picture         =   "Form1.frx":2836
            Top             =   2760
            Width           =   1785
         End
         Begin VB.Image Image2 
            Height          =   585
            Left            =   3720
            Picture         =   "Form1.frx":2DBA
            Top             =   2160
            Width           =   645
         End
         Begin VB.Image Image1 
            Height          =   585
            Left            =   120
            Picture         =   "Form1.frx":4218
            Top             =   120
            Width           =   645
         End
         Begin VB.Line Line1 
            X1              =   3820
            X2              =   120
            Y1              =   2690
            Y2              =   2690
         End
         Begin VB.Line Line4 
            X1              =   4370
            X2              =   720
            Y1              =   165
            Y2              =   165
         End
         Begin VB.Line Line5 
            X1              =   165
            X2              =   165
            Y1              =   600
            Y2              =   2760
         End
         Begin VB.Line Line6 
            X1              =   4305
            X2              =   4305
            Y1              =   120
            Y2              =   2280
         End
      End
      Begin VB.PictureBox Trans 
         AutoRedraw      =   -1  'True
         BackColor       =   &H00FFFFFF&
         Height          =   855
         Left            =   3360
         ScaleHeight     =   795
         ScaleWidth      =   915
         TabIndex        =   1
         Top             =   600
         Visible         =   0   'False
         Width           =   975
      End
   End
   Begin VB.Label Maus 
      Caption         =   "Font Reader © by R-PG Maker "
      Height          =   255
      Index           =   7
      Left            =   120
      TabIndex        =   6
      Top             =   4320
      Width           =   4575
   End
   Begin VB.Menu data 
      Caption         =   "&Datei"
      Index           =   1
      Begin VB.Menu dat 
         Caption         =   "Ordner wählen"
         Index           =   0
      End
      Begin VB.Menu dat 
         Caption         =   "Einstellungen"
         Index           =   1
      End
      Begin VB.Menu dat 
         Caption         =   "-"
         Index           =   2
      End
      Begin VB.Menu dat 
         Caption         =   "&Beenden"
         Index           =   3
      End
   End
   Begin VB.Menu data 
      Caption         =   "&Bearbeiten"
      Index           =   2
      Begin VB.Menu be 
         Caption         =   "Refresh"
         Enabled         =   0   'False
         Index           =   1
      End
      Begin VB.Menu be 
         Caption         =   "Font löschen"
         Enabled         =   0   'False
         Index           =   2
      End
      Begin VB.Menu be 
         Caption         =   "-"
         Index           =   4
      End
      Begin VB.Menu be 
         Caption         =   "Pixel-Selector"
         Index           =   6
      End
   End
   Begin VB.Menu data 
      Caption         =   "&?"
      Index           =   3
      Begin VB.Menu about 
         Caption         =   "Über..."
      End
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub InitCommonControls Lib "comctl32" ()

Private Declare Function TransparentBlt Lib "msimg32.dll" ( _
  ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, _
  ByVal nWidth As Long, ByVal nHeight As Long, _
  ByVal hSrcDC As Long, ByVal XSrc As Long, _
  ByVal YSrc As Long, ByVal nSrcWidth As Long, _
  ByVal nSrcHeight As Long, _
  ByVal crTransparent As Long) As Boolean

Private Declare Function GetPixel Lib "gdi32" ( _
 ByVal hdc As Long, ByVal X As Long, _
 ByVal Y As Long) As Long
 
Private Const Delt As String = ","
Private Const SRCCOPY = &HCC0020
Private Vars() As String
Private Pos As Long, Counta As Long
Private Svar As Long

Private Sub Form_Initialize()
  Call InitCommonControls
End Sub

Private Sub about_Click()
  frmAbout.Show , Me
End Sub

Public Sub be_Click(Index As Integer)

 Select Case Index
   Case 1: Call Fontf(Temp)
   Case 2: Call Command2_Click
   Case 6
   be(6).Checked = Not be(6).Checked
   Picture4.Visible = be(6).Checked
   If be(6).Checked = True Then
   Picture3.MousePointer = 99
   Else
   Picture3.MousePointer = 0
   End If
 End Select

End Sub

Private Sub Command1_Click()
Dim Path As String

  Path = Dialog("Bitte Output-Ordner wählen", Me)
  
  If Path <> vbNullString Then
    be(1).Enabled = True
    Command4.Enabled = True
    Text2.Text = CompactPath(Main, Path, Text2)
    Text2.SelStart = 1
    Text2.ToolTipText = Path
    SavePfad = Path
    Call Fontf(Path)
    Temp = Path
  End If
  
End Sub

Private Sub Command2_Click()
On Error GoTo Fehler
Dim S As Long, BF As String, TF As String

  S = MsgBox("Font wirklich löschen?", vbQuestion + vbYesNo, "Font löschen")
  
  If S = vbYes Then
  BF = Teile(ListView1.SelectedItem.Index - 1).BPfad
  TF = Teile(ListView1.SelectedItem.Index - 1).Real
  
  If File(BF) Then Kill BF
  If File(TF) Then Kill TF
  Call Fontf(Temp)
  End If
  Exit Sub

Fehler:
Call Fontf(Temp)
MsgBox "Konnte Font nicht löschen!", vbCritical, "Fehler"
End Sub

Private Sub dat_Click(Index As Integer)
  Select Case Index
  Case 0: Call Command1_Click
  Case 1: config.Show , Me
  Case 3: Call EndProg
  End Select
End Sub

Private Sub Exita_Click()
Call EndProg
End Sub

Private Sub Command4_Click()
Call Fontf(Temp)
End Sub

Sub FontAdd(Index As Long)
'If InStr(Teile(Index).Content, vbCrLf) = 0 Then
 '  GoTo Fehler
 ' End If
  
  Dim Token As Long
  Token = InitGDIPlus
  pics.Picture = LoadPictureGDIPlus(Teile(Index).BPfad)
  FreeGDIPlus Token

  Vars = Split(Teile(Index).Content, vbCrLf)
  Text1.Enabled = True
  Svar = Index
  Exit Sub

Fehler:
  Text1.Enabled = False
  MsgBox "Fehlerhafte Font-Datei!", vbCritical, "Fehler"
End Sub

Public Sub Draw()
 On Error Resume Next
 Dim i As Long, Zeichen As Long
 Pos = 0: Counta = 0: Pos2 = 0
 Picture3.Cls
 For i = 1 To Len(Text1.Text)
  Zeichen = Asc(Mid(Text1.Text, i, 1))
  If Zeichen >= 33 Then Zeichen = Zeichen - 33
  If Mid(Text1.Text, i, 1) = "!" Then Zeichen = 1
  If Mid(Text1.Text, i, 1) = " " Then Zeichen = 0
  Call PrintF(Zeichen)
 Next i
End Sub

Public Sub DrawXtra()
On Error Resume Next
Dim i As Long, Zeichen As String
Pos = 0: Counta = 0: Pos2 = 0
Picture3.Cls

 For i = 1 To Len(Text1.Text)
 Zeichen = Mid(Text1.Text, i, 1)
 Zeichen = ",""" & Zeichen & """"

 If InStr(Teile(Svar).Content, Zeichen) > 0 Then
 Zeichen = Left(Teile(Svar).Content, InStr(Teile(Svar).Content, Zeichen) + 3)
 If InStrRev(Zeichen, vbCrLf) > 0 Then
 Zeichen = (Mid$(Zeichen, InStrRev(Zeichen, vbCrLf) + 2))
 End If
 Call PrintF(0, Zeichen, 2)
 End If

Next i
End Sub

Private Sub PrintF(Zeichen As Long, Optional Zf$, Optional Modus&)

Dim X As String, Y As String
Dim H As String, B As String
Dim Var As String, Zahl As Long

 If Modus = 2 Then
 Var = Zf
 Else
 Var = Vars(Zeichen)
 End If

 X = Mid(Var, 1, InStr(Var, Delt) - 1)
 Y = Mid(Var, InStr(Var, Delt) + 1)
 B = Mid(Y, InStr(Y, Delt) + 1)
 H = Mid(B, InStr(B, Delt) + 1)

 Y = Mid(Y, 1, InStr(Y, Delt) - 1)
 B = Mid(B, 1, InStr(B, Delt) - 1)

 If InStr(H, Delt) > 0 Then
 H = Mid(H, 1, InStr(H, Delt) - 1)
 End If

 Picture3.ScaleMode = 3
 
 If Pos <> 0 Then
 If (Picture3.ScaleWidth - Pos) <= 20 Then
 Counta = Counta + 1
 Pos = 0
 End If
 End If
 
 If Counta <> 0 Then
 Zahl = H * Counta
 End If

 TransparentBlt Picture3.hdc, Pos, Zahl, B, H + Fixt, _
                pics.hdc, X, Y, B, H + 2, GetPixel(pics.hdc, 0, 0)
                

 Pos = Pos + B
 Picture3.Refresh
End Sub

Private Sub Form_Load()
Call LoadSettings
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call EndProg
End Sub

Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem)
  Call FontAdd(Item.Index - 1)
   If Comp = 0 Then
    Call Draw
    Else
    Call DrawXtra
   End If
  Command2.Enabled = True
  be(2).Enabled = True
End Sub

Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Color As Long
Color = GetPixel(Picture3.hdc, X, Y)

If Color <> -1 Then
Shape1.FillColor = Color
End If
End Sub

Private Sub Text1_Change()
  If ListView1.ListItems.Count <> 0 Then
   If ListView1.SelectedItem.Selected Then
    If Comp = 0 Then
    Call Draw
    Else
    Call DrawXtra
    End If
   End If
  End If
End Sub

Private Sub EndProg()
  Dim i As Integer
  Call SaveSettings
  While Forms.Count > 1
  i = 0
  While Forms(i).Caption = Me.Caption
  i = i + 1
  Wend: Unload Forms(i)
  Wend: Unload Me
  End
End Sub
