VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form CreateLink 
   Caption         =   "Text-Datei erstellen"
   ClientHeight    =   9540
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   13380
   BeginProperty Font 
      Name            =   "Verdana"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form2"
   ScaleHeight     =   9540
   ScaleWidth      =   13380
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtdatei 
      Height          =   285
      Left            =   1800
      TabIndex        =   13
      Text            =   "Text1"
      Top             =   9000
      Visible         =   0   'False
      Width           =   180
   End
   Begin VB.ComboBox cmbFarbe 
      Height          =   315
      Left            =   6720
      TabIndex        =   12
      Top             =   7560
      Width           =   2295
   End
   Begin MSComDlg.CommonDialog cmSave 
      Left            =   1080
      Top             =   9000
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "Textdatei (*.txt)|*.txt"
   End
   Begin MSComDlg.CommonDialog cmBild 
      Left            =   360
      Top             =   9000
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "Formatierte Bilder (*.b8)|*.b8"
   End
   Begin VB.CommandButton cmdBild 
      Caption         =   "Bild Pfad"
      Height          =   375
      Left            =   360
      TabIndex        =   10
      Top             =   8400
      Width           =   1455
   End
   Begin VB.CommandButton cmdHell 
      Caption         =   "Hell"
      Height          =   375
      Left            =   1440
      TabIndex        =   8
      Top             =   7560
      Width           =   975
   End
   Begin VB.CommandButton cmdKursiv 
      Caption         =   "Kursiv"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2520
      TabIndex        =   7
      Top             =   7560
      Width           =   975
   End
   Begin VB.CommandButton cmdUntersrichen 
      Caption         =   "Untersrichen"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3600
      TabIndex        =   6
      Top             =   7560
      Width           =   1575
   End
   Begin VB.CommandButton cmdFett 
      Caption         =   "Fett"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   360
      TabIndex        =   4
      Top             =   7560
      Width           =   975
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "Speichern und Verlassen"
      Height          =   495
      Left            =   3840
      TabIndex        =   3
      Top             =   8880
      Width           =   5655
   End
   Begin VB.TextBox txtText 
      Height          =   5775
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   1200
      Width           =   12855
   End
   Begin VB.Label lblFarbe 
      Caption         =   "Textfarbe:"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   5400
      TabIndex        =   11
      Top             =   7560
      Width           =   1095
   End
   Begin VB.Label lblEinfühgen 
      Caption         =   "Bild bei Cursor einfügen:"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   9
      Top             =   8040
      Width           =   2895
   End
   Begin VB.Label lblBearbeiten 
      Caption         =   "Markierter Text bearbeiten:"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   5
      Top             =   7200
      Width           =   2895
   End
   Begin VB.Label lblText 
      Caption         =   "Text:"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   840
      Width           =   1095
   End
   Begin VB.Label lblTitel 
      Alignment       =   2  'Center
      Caption         =   "Datei Erstellung:"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   18
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4560
      TabIndex        =   0
      Top             =   240
      Width           =   4215
   End
   Begin VB.Menu mnuDatei 
      Caption         =   "Datei"
      Begin VB.Menu mnuSave 
         Caption         =   "Speichern"
      End
      Begin VB.Menu mnuSaveAs 
         Caption         =   "Speichern unter..."
      End
      Begin VB.Menu mnuLaden 
         Caption         =   "Laden"
      End
      Begin VB.Menu mnuleer1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEnd 
         Caption         =   "Schliessen"
      End
   End
End
Attribute VB_Name = "CreateLink"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Variablen Definieren
Dim Pfahd       As String
Dim File        As String
Dim Gespeichert As Integer
Dim lodet       As Integer

'Bei änderung der Textfarbe:
Private Sub cmbFarbe_Click()
    'Kontrolieren welche Farbe ausgewählt wurde und dann einfühgen
    If cmbFarbe.text = "Weiss" Then
        Call einfügen("©C1", "©C0")
    ElseIf cmbFarbe.text = "Rot" Then
        Call einfügen("©C2", "©C0")
    ElseIf cmbFarbe.text = "Orange" Then
        Call einfügen("©C3", "©C0")
    ElseIf cmbFarbe.text = "Gelb" Then
        Call einfügen("©C4", "©C0")
    ElseIf cmbFarbe.text = "Grün" Then
        Call einfügen("©C5", "©C0")
    ElseIf cmbFarbe.text = "Cyan" Then
        Call einfügen("©C6", "©C0")
    ElseIf cmbFarbe.text = "Blau" Then
        Call einfügen("©C7", "©C0")
    ElseIf cmbFarbe.text = "Königsblau" Then
        Call einfügen("©C8", "©C0")
    ElseIf cmbFarbe.text = "Violett" Then
        Call einfügen("©C9", "©C0")
    ElseIf cmbFarbe.text = "Rosa" Then
        Call einfügen("©Ca", "©C0")
    ElseIf cmbFarbe.text = "Schwarz" And lodet = 1 Then
        Call einfügen("©Cf", "©C0")
    End If
End Sub

'Einfügen eines Bildes:
Private Sub cmdBild_Click()
    'Explorer zur dateiwahl öffnen
    cmBild.ShowOpen
    
    'Wenn eine Datei ausgewählt wurde
    If cmBild.CancelError <> True And cmBild.FileTitle <> "" Then
        'Linkt in Text einfühgen
        txtText.SelText = "#" & cmBild.FileTitle & "#"
    End If
End Sub

'Markierter text  soll Fett angezeigt werden:
Private Sub cmdFett_Click()
    Call einfügen("©G1", "©G0")
End Sub

'Markierter Text soll Hell angezeigt werden:
Private Sub cmdHell_Click()
    Call einfügen("©G3", "©G0")
End Sub

'Markierter Text sol Kursuf angezeigt werden:
Private Sub cmdKursiv_Click()
    Call einfügen("©I1", "©I0")
End Sub

'Speichern und Verlassen
Private Sub cmdOK_Click()
    'Speicherroutine aufrufen
    Call speichern
    
    'From Beenden
    Unload Me
End Sub

'Markierter Text sol Unterstrichen angezeigt werden
Private Sub cmdUntersrichen_Click()
    Call einfügen("©S1", "©S0")
End Sub

'Beim laden der Form
Private Sub Form_Load()
    'Variablen Definieren
    Gespeichert = 0
    Pfahd = ""
    lodet = 0       ' Schwerz am anfang nicht einfügen
    
    'Farben in ComboBox ladan
    cmbFarbe.AddItem ("Weiss")
    cmbFarbe.AddItem ("Rot")
    cmbFarbe.AddItem ("Orange")
    cmbFarbe.AddItem ("Gelb")
    cmbFarbe.AddItem ("Grün")
    cmbFarbe.AddItem ("Cyan")
    cmbFarbe.AddItem ("Blau")
    cmbFarbe.AddItem ("Königsblau")
    cmbFarbe.AddItem ("Violett")
    cmbFarbe.AddItem ("Rosa")
    cmbFarbe.AddItem ("Schwarz")
    
    'Erste wahl anzeigen
    cmbFarbe.ListIndex = 10
    
    'Schwarz Freigeben
    lodet = 1
End Sub

'Bei Beenden der Form
Private Sub Form_Unload(Cancel As Integer)
    'Link Form anzeigen und Aktivieren
    Link.Enabled = True
    Link.Visible = True
    
    'Kontrolle ob daten abgespeichert wurden bevor verädnerungen  gemacht wurden
    If Gespeichert <> 1 Then
        'wenn nicht gespeichert: Benützer Fragen ob er nicht doch apspeichern will
        If vbYes = MsgBox("ACHTUNG, Änderungen wurden nicht gespeichert ! Sollen Daten Gespeichert Werden ?", vbYesNo, "Speichern ?") Then
            'Speicherungsrutine aufrufen
            Call speichern
        End If
    End If
    
    'File Forhanden
    If File <> "" Then
        'File name in Link Form eintragen
        Link.txtdatei.text = File
    End If
End Sub

'Routine des Einfügen des Text-Modus um den markierten text
Sub einfügen(modus As String, modus_n As String)
    'Variablen Deklarieren
    Dim Start As Integer
    Dim länge As Integer
    
    'Variablen Deviniren
    Start = txtText.SelStart
    
    'wenn kein Text selektioniert ist einfach zeichen setzen und Cursor in der mite setzen
    If txtText.SelLength = 0 Then
        txtText.SelText = modus & modus_n
        txtText.SelStart = Start + 3
    Else
        länge = txtText.SelLength
        
        'am anfang und ende die Textmoduserkenung einfühgen
        txtText.SelText = modus & txtText.SelText & modus_n
        
        'Text markieren mit Text modus
        txtText.SelStart = Start
        txtText.SelLength = länge + 6
        
    End If
    
    'Coursor dem Text übergeben und text èbermahlen
    txtText.SetFocus
End Sub

'Speicherroutine
Sub speichern()
    'Variablen Deklarieren
    Dim F           As Integer
    
    'Variablen Devinieren
    F = FreeFile
    Gespeichert = 1 'Variable zur erkennung das schon gespeicher ist auf 1 setzen (bei beenden)
    
    'Wenn kein Pfahd Forhanden
    If Pfahd = "" Then
        'öffnen des Fenster um eine datei zu bestimmen, kreieren
        cmSave.ShowSave
        'Zur barbeitung Pfad in Text-opiekt einlesen
        txtdatei.text = cmSave.FileName
        
        'Pfahd und Dateiname Speichern
        Pfahd = cmSave.FileName
        File = cmSave.FileTitle
    Else
        'Pfad in Textbox zur bearbeitung abspeichern
        txtdatei.text = Pfahd
    End If
    
    'Bei Erfolgter eingabe:
    If Pfahd <> "" Then
    
        '--------------------- File Name -----------------------
        'Textende Makieren
        txtdatei.SelStart = Len(txtdatei.text) - 4
        txtdatei.SelLength = 4
        
        'Letzen zwei Buchstaben des Pfahdes = ".h" dann so abspeichern und Dokument öffnen
        If txtdatei.SelText = ".txt" Then
            Open Pfahd For Output As #F
        'Sonnst .h anfügen und Dokument öffnen
        Else
            Open Pfahd & ".txt" For Output As #F
        End If
        
        ' Text in Datei einlesen
        Print #F, txtText.text
        
        'Datei Schliesen
        Close #F
    End If
    
End Sub

'Beenden der Form
Private Sub mnuEnd_Click()
    Unload Me
End Sub

'Textdatei laden
Private Sub mnuLaden_Click()
    'Variablen Deklarieren
    Dim F As Integer
    Dim AllText As String
    Dim LineOfText As String
    
    'Fenster zur auswahl der Datei öffnen
    cmSave.ShowOpen

    'Wenn datei ausgewählt wurde
    If cmSave.FileName <> "" Then
      
      'Pfahd und Dateiname in dazugehörie variabel speichern
      Pfahd = cmSave.FileName
      File = cmSave.FileTitle
      
      'Pointer Setzen
      F = FreeFile
      
      'Datei öffnen
      Open cmSave.FileName For Input As #F
      ' Zeilen aus Textdatei einlesen und in Variable AllText speichern
      Do Until EOF(F)
        Line Input #F, LineOfText
        AllText = AllText & LineOfText & vbCrLf
      Loop
      'Datei Schliesen
      Close #F
      
      ' Inhalt der Variable AllText im Textfeld txtText ausgeben
      txtText.text = AllText
    End If

End Sub

'Speichern
Private Sub mnuSave_Click()
    'Routine der Speicherung aufrufen
    Call speichern
End Sub

'Speichern unter
Private Sub mnuSaveAs_Click()
    'Pfad inizalisieren
    Pfahd = ""
    'Speicherroutine aufrufen
    Call speichern
End Sub

'Bei Veränderung des textes
Private Sub txtText_Change()
    ' Text ist nicht mehr gespeichert, bei nächster beendigung ohne vorheriges Speichern wird der Benützer gefragt ob er doch speichern will
    Gespeichert = 0
End Sub
