LoremIpsum-Generator ergänzen

Fehlerberichte, Hilfe und Anregungen zu BasicMaker 2016 für Windows

Moderator: SoftMaker Team

Antworten
Carsten Goellnitz
Beiträge: 192
Registriert: 31.05.2004 23:07:48
Wohnort: Hamburg
Kontaktdaten:

LoremIpsum-Generator ergänzen

Beitrag von Carsten Goellnitz » 09.05.2016 15:46:03

Von Hoffi und pbk gibt es ein Skript, das einen Blindtext erzeugt,
für den man in einer Dialogbox, Angaben zur Länge, zu Absätzen
und dazu machen kann, ob der Text Sätze ausgeben soll.

Ich möchte eine zusätzliche Auswahl einbauen, mit der ich den
zu verwendenden Blindtext auswählen kann. Ich habe mir dazu
aus dem Internet eine deutsche Fassung von lorem.txt, eine
weitere, die blindtext.txt heisst und dann noch verschieden-
sprachige wortberge.txt

Bisher trage ich den zu verwendenden Blindtext händisch in das
Dialogfeld ein und habe dort die vorhandenen Texte aufgeführt.
Das sieht so aus:
lorem_dialog.PNG
lorem_dialog.PNG (7.97 KiB) 2846 mal betrachtet

Carsten Goellnitz
Beiträge: 192
Registriert: 31.05.2004 23:07:48
Wohnort: Hamburg
Kontaktdaten:

Re: LoremIpsum-Generator ergänzen

Beitrag von Carsten Goellnitz » 09.05.2016 15:50:06

Das lange Skript habe ich mit eigenen Kommentaren am Anfang
versehen, die sich auf meine Frage beziehen:

Code: Alles auswählen

'Lorem Ipsum Generator
'(c) by pbk 2008, für private Verwendung frei
'------------------------------------------------------------------
'2008-11-11 Hoffie // Etwas gekürzt. 
'2011-12-15 Hoffie // Ermittlung Ordner der Datendatei "Lorem.txt" geändert.
'  (Seit SMO2010 steht die BasicMaker Dokumentliste nicht mehr zur 
'   Verfügung wenn BM nur im Hintergrund zur Skriptausführung läuft)

Option Explicit

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Hier wir der Pfad der Datei Lorem.txt (die Lorem Ipsum Wortliste) vorgegeben.
'Der Pfad muss innerhalb der Eigenen Dateien liegen.
'Der Pfad muss ab "Eigene Dateien" angegeben werden, und mit "\" beginnen.
'Beispiel: Lorem.txt in meinem Unterordner Skripte von Softmaker. 
'Const LoremPfad$ = "\SoftMaker\Skripte\Lorem.txt" oder z. B. blindtext.txt" oder lorem_de.txt"
'(Die Datei sollte natürlich auch dort existieren... ;-)

'Hier anpassen: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Const LoremPfad$ = "\SoftMaker\Skripte\blindtext.txt"  ' ?? soll durch Dialogbox geändert werden
'                                                        ?? und muss deshalb vielleicht nach unten
'Weiter:                                                 ?? verschoben werden (?)

Const MAX_PATH& = &H104
Const CSIDL_PERSONAL& = &H5

Declare Function SHGetSpecialFolderPathA Lib "shell32.dll" ( _
	ByVal hwndOwner As Long, _
	ByVal lpszPath As String, _
	ByVal csidl As Long, _
	ByVal fCreate As Long _
	) As Long

Begin Dialog PARAMETERABFRAGE 180,100, 200, 100, "Lorem Ipsum Generator - Ausgabeoptionen"
	OKButton 150,16,40,14
	CancelButton 150,31,40,14
	Text 10,9,52,8, "Absatze:"
	TextBox 64,8,20,10, .Absaetze, 1+128
	Text 10,29,52,8, "Wörter pro Absatz:"
	TextBox 64,27,20,10, .WoerterMin, 1+128
	Text 93,29,10,8, "bis"
	TextBox 108,27,20,10, .WoerterMax, 1+128
	CheckBox 10,48,80,8, "Erzeuge Sätze in Absätzen", .Saetze
	Text 178,50,10,8, "1.1"
	Text 8,62,184,34, "x", .Id, 18
	Text 12,64,176,8, "Name des Textes (blindtext/lorem/lorem_de.txt):"  ' ?? hier sollte eine Auswahl über
	TextBox 12,74,176,10, .LoremWortListe                                ' ?? eine list box oder check list box
	Text 12,86,176,8, "auch: wortberge/wortberge_eng/wortberge_frz.txt"  ' ?? ermöglicht werden, die den zu
End Dialog                                                              ' ?? verwendenden Blindtext in die
'                                                                         ?? Const LoremPfad$ = .... .txt
Sub Main                                                                ' ?? einträgt, die Textzeilen können
	'TextMaker vorbereiten                                                 ?? dann entfallen 
	Dim tm as Object
	Set tm = CreateObject("TextMaker.Application")
	If tm.Documents.Count = 0 Then tm.Documents.Add
	tm.Application.Visible = True

	'Status der Rechtschreibkorrektur auslesen
	Dim SpellCheck As Boolean
	SpellCheck = tm.Application.Options.CheckSpellingAsYouType

 	'Pfad von Eigene Dateien und den vollen Namen der Datei lorem.txt ermitteln
	Dim personalFolder$ 'Voller Name des Ordners Eigene Dateien
	Dim IpsumFile$ 'Voller Name der Datei lorem.txt
	personalFolder = Space(MAX_PATH)
	If SHGetSpecialFolderPathA(0, personalFolder, CSIDL_PERSONAL, 0) = 0 Then
		MsgBox "Eigene Dateien nicht gefunden mit SHGetSpecialFolderPathA", 16, "Lorem Ipsum Generator - ABBRUCH"
		Exit Sub
	End If
	IpsumFile = personalFolder & LoremPfad

	'Optionen per Dialog abfragen
DIALOGAUSGABEOPTIONEN:

	Dim Ausgabeoptionen As ParameterAbfrage
	Dim ErLev%

	Ausgabeoptionen.Absaetze = 4
	Ausgabeoptionen.WoerterMin = 20
	Ausgabeoptionen.WoerterMax = 70
	Ausgabeoptionen.Saetze = 1
	Ausgabeoptionen.LoremWortListe = IpsumFile

	ErLev% = Dialog(Ausgabeoptionen)
	If ErLev%=0 Then
		Set tm = Nothing
		Exit Sub
	End If

	'Eingaben prüfen
	If Int(Ausgabeoptionen.Absaetze)=0 or Int(Ausgabeoptionen.WoerterMin)=0 or Int(Ausgabeoptionen.WoerterMax)=0 Then
		MsgBox "Es wurden keine oder fehlerhafte Zahlen eingegeben", MB_ICONSTOP, "Lorem Ipsum Generator - Fehler"
		Goto DIALOGAUSGABEOPTIONEN
	ElseIf Int(Ausgabeoptionen.WoerterMin) > Int(Ausgabeoptionen.WoerterMax) Then
		MsgBox "Minimum ist größer als Maximum", MB_ICONSTOP, "Lorem Ipsum Generator - Fehler"
		Goto DIALOGAUSGABEOPTIONEN
	End If
	IpsumFile = Ausgabeoptionen.LoremWortListe

	'Datei zum lesen öffnen
	Open IpsumFile For Input As #1
	Dim LineCount
	Dim MaxLine
	Dim InLine$
	Dim TMOutput$
	Dim ParagraphCount
	Dim MaxBuffer

	'Pufferspeicher an Programmbugs anpassen
	If tm.Build <= 494 Then
		MaxBuffer = 256
	else
		MaxBuffer = 65000
	End If

	'Blindtext einfügen
	Dim SatzZeichen

	'Rechtschreibprüfung aus
	tm.Application.Options.CheckSpellingAsYouType = False

	'Absatzroutine
	Do while ParagraphCount < Int(Ausgabeoptionen.Absaetze)
		
		'Wörter pro Absatz berechnen
		MaxLine=Int(Int(Ausgabeoptionen.WoerterMin)+rnd()*(Int(Ausgabeoptionen.WoerterMax)-Int(Ausgabeoptionen.WoerterMin)))

		'Wörter pro Absatz Routine
		LineCount = 0
		SatzZeichen = 1

		Do while LineCount < MaxLine
			If EOF(1) Then
				close #1
				open IpsumFile For Input As #1
			End If

			Line Input #1, InLine

			If Ausgabeoptionen.Saetze = 1 then	'Sätze erzeugen abgewahlt?
				SatzZeichen = LineCount mod (8+Int(rnd()*3))	'Position Satzzeichen ermitteln
			End If

			If LineCount = 0 or SatzZeichen = 0 then
				InLine=UCase(Left(Inline,1))+Right(Inline,len(Inline)-1) 'Erstes Zeichen Großbuchstabe
			End If

			If LineCount>0 Then
				InLine = " " + InLine	'Leerzeichen nicht vergessen
				If SatzZeichen = 0 and (MaxLine - LineCount) >= 8 Then
					InLine = "." + InLine	'Satz mit Punkt abschließen
				End If
			End If


			'Puffer
			If (len(TMOutput$) + len(InLine)) > MaxBuffer Then
				tm.ActiveDocument.Selection.TypeText (TMOutput$)
				TMOutput$ = ""
			End If

			TMOutput = TMOutput$ + InLine
			LineCount=LineCount+1
		Loop

		if right(TMOutput$,1) <> "." Then TMOutput$ = TMOutput$ + "."	'Absatz ordentlich abschließen

		tm.ActiveDocument.Selection.TypeText (TMOutput$)	'Puffer leeren und Satzende
		TMOutput$ = ""
		tm.ActiveDocument.Selection.TypeParagraph
		tm.ActiveDocument.Selection.TypeParagraph
		
		ParagraphCount = ParagraphCount + 1

	Loop

	tm.Application.Options.CheckSpellingAsYouType = SpellCheck

	close #1
	Set tm = Nothing

End Sub
Na ja meine Kommentare mit ?? markiert zerreißen die Zeilen vielleicht
ein wenig ... aber ich hoffe, es bleibt verständlich

Eierlein
Beiträge: 154
Registriert: 01.02.2010 19:38:04

Re: LoremIpsum-Generator ergänzen

Beitrag von Eierlein » 11.05.2016 21:20:41

Hier ein Beispiel.

Code: Alles auswählen

'--------------------------------------------------------------------
''Lorem Ipsum Generator
'--------------------------------------------------------------------
''(c) by pbk 2008, für private Verwendung frei
''------------------------------------------------------------------
''2008-11-11 Hoffie // Etwas gekürzt.
''2011-12-15 Hoffie // Ermittlung Ordner der Datendatei "Lorem.txt" geändert.
''  (Seit SMO2010 steht die BasicMaker Dokumentliste nicht mehr zur
''   Verfügung wenn BM nur im Hintergrund zur Skriptausführung läuft)
'    Option Explicit
'
'    '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'    'Hier wir der Pfad der Datei Lorem.txt (die Lorem Ipsum Wortliste) vorgegeben.
'    'Der Pfad muss innerhalb der Eigenen Dateien liegen.
'    'Der Pfad muss ab "Eigene Dateien" angegeben werden, und mit "\" beginnen.
'    'Beispiel: Lorem.txt in meinem Unterordner Skripte von Softmaker.
'    'Const LoremPfad$ = "\SoftMaker\Skripte\Lorem.txt" oder z. B. blindtext.txt" oder lorem_de.txt"
'    '(Die Datei sollte natürlich auch dort existieren... ;-)
'    'Hier anpassen: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'    'Const LoremPfad$ = "\SoftMaker\Skripte\blindtext.txt"  ' ?? soll durch Dialogbox geändert werden
'    '                                                        ?? und muss deshalb vielleicht nach unten
'    'Weiter:                                                 ?? verschoben werden (?)
'    Const MAX_PATH& = &H104
'    Const CSIDL_PERSONAL& = &H5
'
'Declare Function SHGetSpecialFolderPathA Lib "shell32.dll" ( _
'ByVal hwndOwner As Long, _
'ByVal lpszPath As String, _
'ByVal csidl As Long, _
'ByVal fCreate As Long _
') As Long

'--------------------------------------------------------------------
'--------------------------------------------------------------------
'--------------------------------------------------------------------
' Ab hier ein Beispiel mit fester Pfadangabe
'--------------------------------------------------------------------

SUB main

   DIM Pfad AS STRING
   DIM Datei AS STRING

   Pfad = "d:\##\" 'fester Pfad -> anpassen "\" am Ende!

'Array für die Auswahlnamen

   DIM t( 6 ) AS STRING

   t( 0 ) = "LoremIpsum"
   t( 1 ) = "BavariaIpsum"
   t( 2 ) = "Noch ein Ipsum"
   t( 3 ) = "Ipsum 4"
   t( 4 ) = "Ipsum 5 "
   t( 5 ) = "Ipsum 6 "

   Begin DIALOG PARAMETERABFRAGE 511, 89, 200, 140, "Lorem Ipsum Generator - Ausgabeoptionen"
   OKButton 150, 16, 40, 14
   CancelButton 150, 31, 40, 14
   Text 10, 9, 52, 8, "Absätze:"
   TextBox 64, 8, 20, 10, .Absaetze
   Text 10, 29, 52, 8, "Wörter pro Absatz:"
   TextBox 64, 27, 20, 10, .WoerterMin
   Text 93, 29, 10, 8, "bis"
   TextBox 108, 27, 20, 10, .WoerterMax
   CheckBox 10, 48, 80, 8, "Erzeuge Sätze in Absätzen", .Saetze
   Text 178, 50, 10, 8, "1.1"
   Text 8, 62, 184, 34, ""
   ListBox 12, 70, 136, 64, t(), .list1
   END DIALOG



    '
    'TextMaker vorbereiten
   DIM tm AS OBJECT

   SET tm = CreateObject( "TextMaker.Application" )
   IF tm.Documents.Count = 0 THEN tm.Documents.Add
   tm.Application.Visible = True

    'Status der Rechtschreibkorrektur auslesen
   DIM SpellCheck AS Boolean



	' Dialog anzeigen
   DIM Dlg AS PARAMETERABFRAGE
   DIM ErLev%
   DIM Ausgabeoptionen AS ParameterAbfrage

   DIALOGAUSGABEOPTIONEN:
   Ausgabeoptionen.Absaetze = 4
   Ausgabeoptionen.WoerterMin = 20
   Ausgabeoptionen.WoerterMax = 70
   Ausgabeoptionen.Saetze = 1

   ErLev% = DIALOG( Ausgabeoptionen )
   IF ErLev% = 0 THEN
      SET tm = NOTHING
      EXIT SUB
   END IF




   SELECT CASE Ausgabeoptionen.List1
      CASE 0
         datei = "lorem.txt"                '---> Deine Dateinamen eintragen
      CASE 1
         datei = "bavaria.txt"
      CASE 2
         Datei = "" 
      CASE 3
         Datei = ""
      CASE 4
         Datei = ""
      CASE 5
         Datei = ""
   END SELECT

  ' MSGBOX "Datei = " & STR( Ausgabeoptionen.list1 ) & "  " & Pfad & datei   '---> Nur zur Info

    'Eingaben pr_fen
   IF INT( Ausgabeoptionen.Absaetze ) = 0 or INT( Ausgabeoptionen.WoerterMin ) = 0 or INT( Ausgabeoptionen.WoerterMax ) = 0 THEN
      MSGBOX "Es wurden keine oder fehlerhafte Zahlen eingegeben", MB_ICONSTOP, "Lorem Ipsum Generator - Fehler"
      GOTO DIALOGAUSGABEOPTIONEN
   ElseIf INT( Ausgabeoptionen.WoerterMin ) > INT( Ausgabeoptionen.WoerterMax ) THEN
      MSGBOX "Minimum ist größer als Maximum", MB_ICONSTOP, "Lorem Ipsum Generator - Fehler"
      GOTO DIALOGAUSGABEOPTIONEN
   END IF

   IpsumFile = Pfad & Datei
    'Datei zum lesen öffnen
   OPEN IpsumFile FOR INPUT AS #1

   DIM LineCount
   DIM MaxLine
   DIM InLine$
   DIM TMOutput$
   DIM ParagraphCount
   DIM MaxBuffer

   IF tm.Build <= 494 THEN
      MaxBuffer = 256
   ELSE
      MaxBuffer = 65000
   END IF


    'Blindtext einfügen
   DIM SatzZeichen

    'Rechtschreibprüfung aus
   tm.Application.Options.CheckSpellingAsYouType = False
    'Absatzroutine
   DO WHILE ParagraphCount < INT( Ausgabeoptionen.Absaetze )
        'W”rter pro Absatz berechnen
      MaxLine = INT( INT( Ausgabeoptionen.WoerterMin ) + RND() * ( INT( Ausgabeoptionen.WoerterMax ) - INT( Ausgabeoptionen.WoerterMin )))

        'Wörter pro Absatz Routine
      LineCount = 0
      SatzZeichen = 1
      DO WHILE LineCount < MaxLine
         IF EOF( 1 ) THEN
            SEEK #1, 1
         END IF

         LINE INPUT #1, InLine
         IF Ausgabeoptionen.Saetze = 1 THEN 'S"tze erzeugen abgewahlt?
            SatzZeichen = LineCount mod ( 8 + INT( RND() * 3 )) 'Position Satzzeichen ermitteln
         END IF
         IF LineCount = 0 or SatzZeichen = 0 THEN
            InLine = UCASE( LEFT( Inline, 1 )) + RIGHT( Inline, LEN( Inline ) - 1 ) 'Erstes Zeichen Großbuchstabe
         END IF
         IF LineCount > 0 THEN
            InLine = " " + InLine 'Leerzeichen nicht vergessen
            IF SatzZeichen = 0 and ( MaxLine - LineCount ) >= 8 THEN

               InLine = "." + InLine 'Satz mit Punkt abschlie en
            END IF
         END IF
            'Puffer
         IF ( LEN( TMOutput$ ) + LEN( InLine )) > MaxBuffer THEN
            tm.ActiveDocument.Selection.TypeText( TMOutput$ )
            TMOutput$ = ""
         END IF
         TMOutput = TMOutput$ + InLine
         LineCount = LineCount + 1
      LOOP
      IF RIGHT( TMOutput$, 1 ) <> "." THEN TMOutput$ = TMOutput$ + "." 'Absatz ordentlich abschlie en
      tm.ActiveDocument.Selection.TypeText( TMOutput$ ) 'Puffer leeren und Satzende
      TMOutput$ = ""
      tm.ActiveDocument.Selection.TypeParagraph
      tm.ActiveDocument.Selection.TypeParagraph
      ParagraphCount = ParagraphCount + 1
   LOOP
   tm.Application.Options.CheckSpellingAsYouType = SpellCheck
   CLOSE #1
   SET tm = NOTHING

END SUB




Carsten Goellnitz
Beiträge: 192
Registriert: 31.05.2004 23:07:48
Wohnort: Hamburg
Kontaktdaten:

Re: LoremIpsum-Generator ergänzen

Beitrag von Carsten Goellnitz » 12.05.2016 12:51:34

Eierlein hat geschrieben:Hier ein Beispiel.

Code: Alles auswählen

'--------------------------------------------------------------------
''Lorem Ipsum Generator

...
   Pfad = "d:\##\" 'fester Pfad -> anpassen "\" am Ende!
...
Läuft!

Und gerade wollte ich sorgfältig berichten, dass es nicht läuft und wie ich die
Anpassungen vorgenommen habe und welche Fehlermeldung BM lieferte, als ich
dabei bemerkte - trotz des deutlichen Hinweises - dass ich den abschließenden
Backslash bei der Pfadeingabe vergessen hatte.

Thank you, merci, tessekür ederim usw.

Carsten :D =D>

Antworten

Zurück zu „BasicMaker 2016 für Windows“