home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / veryea1a / form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-10-06  |  17.3 KB  |  534 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  5. Begin VB.Form Form1 
  6.    Caption         =   "Easy Writer"
  7.    ClientHeight    =   10410
  8.    ClientLeft      =   2010
  9.    ClientTop       =   630
  10.    ClientWidth     =   10995
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   10410
  13.    ScaleWidth      =   10995
  14.    Begin VB.CommandButton Command10 
  15.       BackColor       =   &H00FFFFFF&
  16.       Caption         =   "Exit"
  17.       BeginProperty Font 
  18.          Name            =   "Arial"
  19.          Size            =   12
  20.          Charset         =   0
  21.          Weight          =   700
  22.          Underline       =   0   'False
  23.          Italic          =   0   'False
  24.          Strikethrough   =   0   'False
  25.       EndProperty
  26.       Height          =   375
  27.       Left            =   2880
  28.       Style           =   1  'Grafisch
  29.       TabIndex        =   13
  30.       Top             =   600
  31.       Width           =   1095
  32.    End
  33.    Begin VB.CommandButton Command9 
  34.       BackColor       =   &H00FFFFFF&
  35.       Caption         =   "New"
  36.       BeginProperty Font 
  37.          Name            =   "Arial"
  38.          Size            =   12
  39.          Charset         =   0
  40.          Weight          =   700
  41.          Underline       =   0   'False
  42.          Italic          =   0   'False
  43.          Strikethrough   =   0   'False
  44.       EndProperty
  45.       Height          =   375
  46.       Left            =   2880
  47.       Style           =   1  'Grafisch
  48.       TabIndex        =   12
  49.       Top             =   120
  50.       Width           =   1095
  51.    End
  52.    Begin MSComDlg.CommonDialog CommonDialog1 
  53.       Left            =   240
  54.       Top             =   1800
  55.       _ExtentX        =   847
  56.       _ExtentY        =   847
  57.       _Version        =   393216
  58.    End
  59.    Begin MSComctlLib.Slider Slider1 
  60.       Height          =   375
  61.       Left            =   0
  62.       TabIndex        =   10
  63.       Top             =   1080
  64.       Width           =   11055
  65.       _ExtentX        =   19500
  66.       _ExtentY        =   661
  67.       _Version        =   393216
  68.    End
  69.    Begin VB.CommandButton Command8 
  70.       BackColor       =   &H00FFFFFF&
  71.       Caption         =   "Color"
  72.       BeginProperty Font 
  73.          Name            =   "Arial"
  74.          Size            =   12
  75.          Charset         =   0
  76.          Weight          =   700
  77.          Underline       =   0   'False
  78.          Italic          =   0   'False
  79.          Strikethrough   =   0   'False
  80.       EndProperty
  81.       Height          =   375
  82.       Left            =   1680
  83.       Style           =   1  'Grafisch
  84.       TabIndex        =   9
  85.       Top             =   600
  86.       Width           =   1095
  87.    End
  88.    Begin VB.CommandButton Command7 
  89.       BackColor       =   &H00FFFFFF&
  90.       Caption         =   "Font"
  91.       BeginProperty Font 
  92.          Name            =   "Arial"
  93.          Size            =   12
  94.          Charset         =   0
  95.          Weight          =   700
  96.          Underline       =   0   'False
  97.          Italic          =   0   'False
  98.          Strikethrough   =   0   'False
  99.       EndProperty
  100.       Height          =   375
  101.       Left            =   1680
  102.       Style           =   1  'Grafisch
  103.       TabIndex        =   8
  104.       Top             =   120
  105.       Width           =   1095
  106.    End
  107.    Begin VB.CommandButton Command6 
  108.       Height          =   375
  109.       Left            =   1080
  110.       Picture         =   "Form1.frx":0000
  111.       Style           =   1  'Grafisch
  112.       TabIndex        =   7
  113.       Top             =   600
  114.       Width           =   375
  115.    End
  116.    Begin VB.CommandButton Command5 
  117.       Height          =   375
  118.       Left            =   600
  119.       Picture         =   "Form1.frx":038E
  120.       Style           =   1  'Grafisch
  121.       TabIndex        =   6
  122.       Top             =   120
  123.       Width           =   375
  124.    End
  125.    Begin VB.CommandButton Command4 
  126.       Height          =   375
  127.       Left            =   600
  128.       Picture         =   "Form1.frx":06EA
  129.       Style           =   1  'Grafisch
  130.       TabIndex        =   5
  131.       Top             =   600
  132.       Width           =   375
  133.    End
  134.    Begin VB.CommandButton Command3 
  135.       Height          =   375
  136.       Left            =   120
  137.       Picture         =   "Form1.frx":0A31
  138.       Style           =   1  'Grafisch
  139.       TabIndex        =   4
  140.       Top             =   600
  141.       Width           =   375
  142.    End
  143.    Begin VB.CommandButton Command2 
  144.       Height          =   375
  145.       Left            =   1080
  146.       Picture         =   "Form1.frx":0D38
  147.       Style           =   1  'Grafisch
  148.       TabIndex        =   3
  149.       Top             =   120
  150.       Width           =   375
  151.    End
  152.    Begin VB.CommandButton Command1 
  153.       Height          =   375
  154.       Left            =   120
  155.       Picture         =   "Form1.frx":10F6
  156.       Style           =   1  'Grafisch
  157.       TabIndex        =   2
  158.       Top             =   120
  159.       Width           =   375
  160.    End
  161.    Begin RichTextLib.RichTextBox RichTextBox1 
  162.       Height          =   8655
  163.       Left            =   0
  164.       TabIndex        =   0
  165.       Top             =   1440
  166.       Width           =   11055
  167.       _ExtentX        =   19500
  168.       _ExtentY        =   15266
  169.       _Version        =   393217
  170.       Enabled         =   -1  'True
  171.       ScrollBars      =   2
  172.       TextRTF         =   $"Form1.frx":1449
  173.    End
  174.    Begin MSComctlLib.StatusBar StatusBar1 
  175.       Align           =   2  'Unten ausrichten
  176.       Height          =   300
  177.       Left            =   0
  178.       TabIndex        =   1
  179.       Top             =   10110
  180.       Width           =   10995
  181.       _ExtentX        =   19394
  182.       _ExtentY        =   529
  183.       _Version        =   393216
  184.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  185.          NumPanels       =   3
  186.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  187.             Style           =   5
  188.             TextSave        =   "18:39"
  189.          EndProperty
  190.          BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  191.             Style           =   6
  192.             TextSave        =   "06.10.99"
  193.          EndProperty
  194.          BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  195.             Style           =   2
  196.             Enabled         =   0   'False
  197.             TextSave        =   "NUM"
  198.          EndProperty
  199.       EndProperty
  200.    End
  201.    Begin VB.Label Label1 
  202.       BeginProperty Font 
  203.          Name            =   "MS Sans Serif"
  204.          Size            =   12
  205.          Charset         =   0
  206.          Weight          =   700
  207.          Underline       =   0   'False
  208.          Italic          =   0   'False
  209.          Strikethrough   =   0   'False
  210.       EndProperty
  211.       Height          =   855
  212.       Left            =   4680
  213.       TabIndex        =   11
  214.       Top             =   120
  215.       Width           =   6255
  216.    End
  217.    Begin VB.Menu mnufile 
  218.       Caption         =   "File"
  219.       Begin VB.Menu mnunew 
  220.          Caption         =   "New"
  221.       End
  222.       Begin VB.Menu mnuen 
  223.          Caption         =   "Open encrypted File"
  224.       End
  225.       Begin VB.Menu mnuun 
  226.          Caption         =   "Open unencrypted File"
  227.       End
  228.       Begin VB.Menu mnusave1 
  229.          Caption         =   "Save and encrypt"
  230.       End
  231.       Begin VB.Menu mnuwithout 
  232.          Caption         =   "Save without encrypting"
  233.       End
  234.       Begin VB.Menu mnuprint 
  235.          Caption         =   "Print"
  236.          Shortcut        =   ^P
  237.       End
  238.       Begin VB.Menu mnuexit 
  239.          Caption         =   "Exit"
  240.       End
  241.    End
  242.    Begin VB.Menu mnuedit 
  243.       Caption         =   "Edit"
  244.       Begin VB.Menu mnucopy 
  245.          Caption         =   "Copy"
  246.          Shortcut        =   ^C
  247.       End
  248.       Begin VB.Menu mnucut 
  249.          Caption         =   "Cut"
  250.          Shortcut        =   ^X
  251.       End
  252.       Begin VB.Menu mnupaste 
  253.          Caption         =   "Paste"
  254.          Shortcut        =   ^V
  255.       End
  256.       Begin VB.Menu mnufinditem 
  257.          Caption         =   "Search"
  258.       End
  259.    End
  260.    Begin VB.Menu mnuinsert 
  261.       Caption         =   "Insert"
  262.       Begin VB.Menu mnudate 
  263.          Caption         =   "Insert Date"
  264.       End
  265.       Begin VB.Menu mnuTime 
  266.          Caption         =   "Insert Time"
  267.       End
  268.    End
  269.    Begin VB.Menu mnuhelp 
  270.       Caption         =   "Help"
  271.       Begin VB.Menu mnuabout 
  272.          Caption         =   "About"
  273.       End
  274.    End
  275. Attribute VB_Name = "Form1"
  276. Attribute VB_GlobalNameSpace = False
  277. Attribute VB_Creatable = False
  278. Attribute VB_PredeclaredId = True
  279. Attribute VB_Exposed = False
  280. Private Sub Command1_Click()
  281. RichTextBox1.SelBold = Not RichTextBox1.SelBold
  282. End Sub
  283. Private Sub Command10_Click()
  284. Prompt = "Do you really want to quit?"
  285.         Reply = MsgBox(Prompt, vbYesNo)
  286.         If Reply = vbYes Then
  287.         End
  288.         ElseIf vbNo Then
  289.         Form1.Show
  290.         End If
  291.         End Sub
  292. Private Sub Command2_Click()
  293. RichTextBox1.SelText = LCase(RichTextBox1.SelText)
  294. End Sub
  295. Private Sub Command3_Click()
  296. RichTextBox1.SelItalic = Not RichTextBox1.SelItalic
  297. End Sub
  298. Private Sub Command4_Click()
  299. RichTextBox1.SelStrikeThru = Not RichTextBox1.SelStrikeThru
  300. End Sub
  301. Private Sub Command5_Click()
  302. RichTextBox1.SelUnderline = Not RichTextBox1.SelUnderline
  303. End Sub
  304. Private Sub Command6_Click()
  305. RichTextBox1.SelText = UCase(RichTextBox1.SelText)
  306. End Sub
  307. Private Sub Command7_Click()
  308.  'Fehlerbedingung erzwingen, falls der Anwender auf Abbrechen klickt
  309.     CommonDialog1.CancelError = True
  310.     On Error GoTo errhandler:
  311.     'Flags f
  312. r Spezialeffekte und alle verf
  313. gbaren Schriften setzen
  314.     CommonDialog1.Flags = cdlCFEffects Or cdlCFBoth
  315.     'Dialogfeld Schriftart anzeigen
  316.     CommonDialog1.ShowFont
  317.     'Benutzereingaben in Formateigenschaften 
  318. bernehmen:
  319.     RichTextBox1.SelFontName = CommonDialog1.FontName
  320.     RichTextBox1.SelFontSize = CommonDialog1.FontSize
  321.     RichTextBox1.SelColor = CommonDialog1.Color
  322.     RichTextBox1.SelBold = CommonDialog1.FontBold
  323.     RichTextBox1.SelItalic = CommonDialog1.FontItalic
  324.     RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
  325.     RichTextBox1.SelStrikeThru = CommonDialog1.FontStrikethru
  326. errhandler:
  327. End Sub
  328. Private Sub Command8_Click()
  329. CommonDialog1.CancelError = True
  330. On Error GoTo errhandler:
  331. CommonDialog1.ShowColor
  332. RichTextBox1.SelColor = CommonDialog1.Color
  333. errhandler:
  334. End Sub
  335. Private Sub Command9_Click()
  336. Label1.Caption = ""
  337. RichTextBox1.Text = ""
  338. End Sub
  339. Private Sub Form_Load()
  340. Slider1.Left = RichTextBox1.Left
  341. Slider1.Width = RichTextBox1.Width
  342. Slider1.Max = RichTextBox1.Width
  343. Slider1.TickFrequency = Slider1.Max * 0.1
  344. Slider1.LargeChange = Slider1.Max * 0.1
  345. Slider1.SmallChange = Slider1.Max * 0.01
  346. End Sub
  347. Private Sub mnuabout_Click()
  348. frmabout.Show
  349. End Sub
  350. Private Sub mnucopy_Click()
  351. Clipboard.SetText RichTextBox1.SelText
  352. End Sub
  353. Private Sub mnucut_Click()
  354. Clipboard.SetText RichTextBox1.SelText
  355. RichTextBox1.SelText = ""
  356. End Sub
  357. Private Sub mnudate_Click()
  358. Wrap$ = Chr$(13) & Chr$(10)
  359.     RichTextBox1.Text = Date & Wrap$ & RichTextBox1.Text
  360. End Sub
  361. Private Sub mnuen_Click()
  362. CommonDialog1.CancelError = True
  363. Wrap$ = Chr$(13) + Chr$(10) 'Zeilenumbruchzeichen definieren
  364.      With CommonDialog1
  365.              .Filter = "Textdateien (*.TXT)|*.TXT|"
  366.              .Filter = .Filter & "RTF (*.RTF)|*.RTF"
  367.  Label1.Caption = CommonDialog1.FileName
  368. On Error GoTo errhandler:
  369.     CommonDialog1.ShowOpen      'Dialogfeld 
  370. ffnen anzeigen
  371.     If CommonDialog1.FileName <> "" Then
  372.         Form1.MousePointer = 11 'Stundenglas anzeigen
  373.         Open CommonDialog1.FileName For Input As #1 'Datei 
  374. ffnen
  375.         On Error GoTo Problem:  'Fehlerbehandlungsroutine angeben
  376.         Do Until EOF(1)         'einzelne Textzeilen in
  377.             Line Input #1, LineOfText$  'AllText$ kopieren
  378.             AllText$ = AllText$ & LineOfText$ & Wrap$
  379.         Loop
  380.         'Zeichenfolge entschl
  381. sseln, indem 1 vom ASCII-Code subtrahiert wird
  382.         decrypt$ = ""   'Variable f
  383. r entschl
  384. sselte Zeichenfolge initialisieren
  385.         charsInFile = Len(AllText$)  'L
  386. nge der Zeichenfolge ermitteln
  387.         For i% = 1 To charsInFile    'einzelne Zeichen in Schleife bearbeiten
  388.             letter$ = Mid(AllText$, i%, 1)  'Zeichen mit Hilfe von Mid lesen
  389.             decrypt$ = decrypt$ & Chr$(Asc(letter) - 3) '1 subtrahieren
  390.         Next i%                       'und neue Zeichenfolge erstellen
  391.         RichTextBox1.Text = decrypt$ 'umgewandelte Zeichenfolge dann anzeigen
  392.         RichTextBox1.Enabled = True  'und Bildlaufleisten aktivieren
  393.         Label1.Caption = CommonDialog1.FileName 'Dateiname der Eigenschaft Caption zuweisen
  394. CleanUp:                        'nachdem die Datei entschl
  395. sselt wurde...
  396.         Form1.MousePointer = 0  'Mauszeigerdarstellung zur
  397. cksetzen
  398.         Close #1                'Datei schlie
  399.        CommonDialog1.FileName = ""   'Dateiname l
  400. schen
  401.        Label1.Caption = CommonDialog1.FileName
  402. errhandler:
  403. 'Falls Abbrechen angeklickt wird, Prozedur verlassen.
  404. Label1.Caption = CommonDialog1.FileName
  405.     End If
  406.     Exit Sub
  407. Problem:  'Falls ein Problem auftritt, eine entsprechende Fehlermeldung anzeigen
  408.     MsgBox "Fehler beim 
  409. ffnen der Datei", , Err.Description
  410.     Label1.Caption = ""        'Wert der Eigenschaft Caption l
  411. schen
  412.     RichTextBox1.Text = ""           'Textfeld l
  413. schen
  414.     Resume CleanUp:   'mit CleanUp-Routine beenden
  415.     Label1.Caption = CommonDialog1.FileName
  416.     End With
  417. End Sub
  418. Private Sub mnuexit_Click()
  419. Prompt = "Do you really want to quit?"
  420.         Reply = MsgBox(Prompt, vbYesNo)
  421.         If Reply = vbYes Then
  422.         End
  423.         ElseIf vbNo Then
  424.         Form1.Show
  425.         End If
  426. End Sub
  427. Private Sub mnufinditem_Click()
  428.  Dim SearchStr As String  'Gesuchter Text
  429.     Dim FoundPos As Integer  'Fundstelle
  430.     SearchStr = InputBox("Insert a word", "Find")
  431.     If SearchStr <> "" Then  'Falls SearchStr nicht leer ist
  432.         'erstes Vorkommen des ganzen Wortes suchen
  433.         FoundPos = RichTextBox1.Find(SearchStr, , , _
  434.             rtfWholeWord)
  435.         'falls Wort gefunden wird (falls nicht -1)
  436.         If FoundPos <> -1 Then
  437.         '
  438. ber Span-Methode Wort ausw
  439. hlen (Vorw
  440. rtssuche)
  441.             RichTextBox1.Span " ", True, True
  442.         Else
  443.             MsgBox "Couldn't find the word", , "Suchen"
  444.         End If
  445.     End If
  446. End Sub
  447. Private Sub mnunew_Click()
  448. Label1.Caption = ""
  449. RichTextBox1.Text = ""
  450. End Sub
  451. Private Sub mnupaste_Click()
  452. RichTextBox1.SelText = Clipboard.GetText
  453. End Sub
  454. Private Sub mnuprint_Click()
  455. RichTextBox1.SelPrint (Printer.hDC)
  456. End Sub
  457. Private Sub mnusave1_Click()
  458. CommonDialog1.CancelError = True
  459. On Error GoTo errhandler:
  460.  With CommonDialog1
  461.              .Filter = "Textdateien (*.TXT)|*.TXT|"
  462.              .Filter = .Filter & "RTF (*.RTF)|*.RTF"
  463.              CommonDialog1.CancelError = True
  464.              
  465.      CommonDialog1.ShowSave           'Dialogfeld speichern anzeigen
  466.        If CommonDialog1.FileName <> "" Then
  467.         Form1.MousePointer = 11      'Stundenglas anzeigen
  468.         
  469.         'Text unter Verwendung des Verschl
  470. sselungsschemas speichern (ASCII-Code + 1)
  471.         encrypt$ = ""  'Variable f
  472. r verschl
  473. sselte Zeichenfolge initialisieren
  474.         charsInFile% = Len(RichTextBox1.Text) 'L
  475. nge der Zeichenfolge ermitteln
  476.         For i% = 1 To charsInFile%   'f
  477. r jedes Zeichen der Datei
  478.             letter$ = Mid(RichTextBox1.Text, i%, 1) 'n
  479. chstes Zeichen lesen
  480.             'ASCII-Code des Zeichens ermitteln und 1 dazu addieren
  481.             encrypt$ = encrypt$ & Chr$(Asc(letter$) + 3)
  482.         Next i%
  483.         Open CommonDialog1.FileName For Output As #1 'Datei 
  484. ffnen
  485.         Print #1, encrypt$           'verschl
  486. ssselten Text in Datei speichern
  487.         RichTextBox1.Text = encrypt$
  488.         Close #1                     'Datei schlie
  489.         CommonDialog1.FileName = ""  'Dateinamen l
  490. schen
  491.         Form1.MousePointer = 0       'Mauszeigerdarstellung zur
  492. cksetzen
  493. errhandler:
  494.     End If
  495. End With
  496. End Sub
  497. Private Sub mnuTime_Click()
  498. Wrap$ = Chr$(13) & Chr$(10)
  499.     RichTextBox1.Text = Time & Wrap$ & RichTextBox1.Text
  500. End Sub
  501. Private Sub mnuun_Click()
  502. CommonDialog1.CancelError = True
  503. With CommonDialog1
  504.              .Filter = "Textdateien (*.TXT)|*.TXT|"
  505.              .Filter = .Filter & "RTF (*.RTF)|*.RTF"
  506. On Error GoTo errhandler:
  507. CommonDialog1.Flags = cd10FNFileMustExist
  508. CommonDialog1.ShowOpen
  509. RichTextBox1.LoadFile CommonDialog1.FileName, rtfText
  510. errhandler:
  511. 'Falls Abbrechen angeklickt wird, Prozedur verlassen.
  512. Label1.Caption = CommonDialog1.FileName
  513. End With
  514. End Sub
  515. Private Sub mnuwithout_Click()
  516. On Error GoTo errhandler
  517. CommonDialog1.CancelError = True
  518.     With CommonDialog1
  519.              .Filter = "Textdateien (*.TXT)|*.TXT|"
  520.              .Filter = .Filter & "RTF (*.RTF)|*.RTF"
  521.            
  522.     CommonDialog1.ShowSave      'Dialogfeld anzeigen
  523.     If CommonDialog1.FileName <> "" Then
  524.         Open CommonDialog1.FileName For Output As #1
  525.         Print #1, RichTextBox1.Text  'Text in die Datei schreiben
  526.         Close #1                'Datei schlie
  527.     End If
  528. errhandler:
  529. End With
  530. End Sub
  531. Private Sub Slider1_Scroll()
  532. RichTextBox1.SelIndent = Slider1.Value
  533. End Sub
  534.