🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: pl.comp.lang.vbasic
Article #104417

Re: Nie mały problem dla grafika

#104417
From: Janusz Rychter
Date: Mon, 21 Dec 2009 14:24
136 lines
5920 bytes
Cala trudnosc to sprecyzowanie linijki tekstu ktory spowoduje zapis
nowego wiersza, w wypadku zalacznego przekladu bedzie to czas ktory
moze wystepowac w dwoch formatach:
    vPatern1 = "^\d{2} \d{2}:\d{2}"     '<--dwie cyfry spacja dwie
cyfry : dwie cyfry
albo
    vPatern2 = "^\d{2}:\d{2}"             '<--dwie cyfry : dwie cyfry

Program czytajac wiersz po wierszu ze zbioru wejciowego spradza czy
ustalony patern egzystuje w danym wierszu, jesli tak to poprzednio
utworzony wiersz jest zapisuwany do nowego zbiory i budowa nowego
wiersza jest rozpoczeta. Aby to dzialalo nalezy dodac referencje do (w
VB6 PROJECT | REFERENCES):
- Microsoft Scripting Runtime
- Microsoft VBScript Regular Expressions 5.5

Do formy dodaj Button in w Click event uruchaniaj pfFixFile:

Private Sub Command1_Click()
    Call pfFixFile("D:\tv2.txt")
End Sub

Private Function pfFixFile(vFileName As String) As String
    Dim oFSO As Scripting.FileSystemObject
    Dim oFile As Object
    Dim oTextStream As Scripting.TextStream
    Dim oRegExp As RegExp
    Dim vMatches As MatchCollection

    Dim vPatern1 As String
    Dim vPatern2 As String
    Dim vTextLine As String
    Dim vLineCounter As Long
    Dim vTempLine As String

    On Error GoTo errTrap
    Set oRegExp = New RegExp
    oRegExp.IgnoreCase = True
    oRegExp.Global = True
    vPatern1 = "^\d{2} \d{2}:\d{2}"
    vPatern2 = "^\d{2}:\d{2}"

    Set oFSO = New Scripting.FileSystemObject
    Set oTextStream = oFSO.OpenTextFile(vFileName, ForReading)

    Do While oTextStream.AtEndOfStream <> True
        vTextLine = oTextStream.ReadLine
        If vLineCounter = 0 Then
            Set oFile = oFSO.CreateTextFile(vFileName & ".txt", True)
            Call oFile.WriteLine(Trim(vTextLine))
        Else
            oRegExp.Pattern = vPatern1
            Set vMatches = oRegExp.Execute(vTextLine)
            If vMatches.Count > 0 And Len(Trim(vTextLine)) = 8 Then
                If Len(Trim(vTempLine)) > 0 Then Call oFile.WriteLine
(Trim(vTempLine & vbCrLf))
                vTempLine = ""

                vTempLine = vTempLine & Mid(Trim(vTextLine), 3) & " "
            Else
                oRegExp.Pattern = vPatern2
                Set vMatches = oRegExp.Execute(vTextLine)
                If vMatches.Count > 0 And Len(Trim(vTextLine)) = 5
Then
                    If Len(Trim(vTempLine)) > 0 Then Call
oFile.WriteLine(Trim(vTempLine & vbCrLf))
                    vTempLine = ""

                    vTempLine = vTempLine & Trim(vTextLine) & " "
                Else
                    vTempLine = vTempLine & Trim(vTextLine) & " "
                End If
            End If

        End If
        vLineCounter = vLineCounter + 1
    Loop
    If Len(Trim(vTempLine)) > 0 Then Call oFile.WriteLine(Trim
(vTempLine))

    pfFixFile = vFileName & ".txt"

errTrap:
    If Err.Number <> 0 Then
        Call MsgBox(Err.Number & " - " & Err.Description)
    End If
    Set oFSO = Nothing
    Set oTextStream = Nothing
    Set oFile = Nothing
End Function

On Dec 18, 8:44 pm, "Marek" <ec...@interia.pl> wrote:
> Witam
> Mam nie mały problem. Pracując na programach graficznych często otrzymuję
> pliki tekstowe. Pliki te zanim użyję do obróbki graficznej wcześniej po
> kolei wiersz po wierszu ręcznie je odpowiednio ustawiam. Zajmuje mi ta
> operacja mnóstwo czasu. Nie znam się zbytnio na programie VB tym bardziej
> jeśli ktoś podpowiedziałby w jaki sposób winien być skonstruowany algorytm,
> aby te pliki tekstowe tak ustawić, żeby od razu można ich używać w
> programach graficznych, byłbym szczerze wdzięczny.
>
> Pozdrawiam
> Marek
>
> Pliki tekstowe tak wyglądają przed moją ręczną obróbką (przykładowo)
>  tv2
> 06:25
> Twoja pamięć, moja miłość
> - dokument, Francja 2006
>
> 07 07:25
> Przygód kilka wróbla Ćwirka
> (14) - serial, Polska 1986
> 07:35
> Kropelka - przygody z wodą
> (9) - serial, Hiszpania 2002
>
> 08 08:10
> Barwy szczęścia
> (183) - serial, Polska 2008
> 08:45
> Pytanie na śniadanie
>
> Tekst po przeczytaniu algorytmem powinien wyglądać tak:
> tv2
> 06:25 Twoja pamięć, moja miłość  - dokument, Francja 2006
>
> 07:25 Przygód kilka wróbla Ćwirka (14) - serial, Polska 1986
>
> 07:35 Kropelka - przygody z wodą (9) - serial, Hiszpania 2002
>
> 08:10 Barwy szczęścia (183) - serial, Polska 2008
>
> 08:45 Pytanie na śniadanie
>
> Gdyby ktoś mógł podać kod, który będzie czytał ten plik będę wdzięczny.
Technical Details
Message-ID: <56120087-1bdc-4224-9ba4-ab20b75b5b29@n13g2000vbe.googlegroups.com>
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!newsfeed.gazeta.pl!feed.news.interia.pl!news.nask.pl!news.nask.org.pl!news.uni-stuttgart.de!news.belwue.de!newsfeed01.sul.t-online.de!t-online.de!proxad.net!feeder1-2.proxad.net!74.125.64.134.MISMATCH!postnews.google.com!n13g2000vbe.googlegroups.com!not-for-mail
References: <hghc1a$e5j$1@nemesis.news.neostrada.pl>

Show Full Headers
Complete Article Headers
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!newsfeed.gazeta.pl!feed.news.interia.pl!news.nask.pl!news.nask.org.pl!news.uni-stuttgart.de!news.belwue.de!newsfeed01.sul.t-online.de!t-online.de!proxad.net!feeder1-2.proxad.net!74.125.64.134.MISMATCH!postnews.google.com!n13g2000vbe.googlegroups.com!not-for-mail
From: Janusz Rychter <najyer@hotmail.com>
Newsgroups: pl.comp.lang.vbasic
Subject: Re: Nie mały problem dla grafika
Date: Mon, 21 Dec 2009 06:24:49 -0800 (PST)
Organization: http://groups.google.com
Lines: 144
Message-ID: <56120087-1bdc-4224-9ba4-ab20b75b5b29@n13g2000vbe.googlegroups.com>
References: <hghc1a$e5j$1@nemesis.news.neostrada.pl>
NNTP-Posting-Host: 76.68.78.139
Mime-Version: 1.0
X-Trace: posting.google.com 1261405489 23398 127.0.0.1 (21 Dec 2009 14:24:49 GMT)
X-Complaints-To: groups-abuse@google.com
NNTP-Posting-Date: Mon, 21 Dec 2009 14:24:49 +0000 (UTC)
Complaints-To: groups-abuse@google.com
Injection-Info: n13g2000vbe.googlegroups.com; posting-host=76.68.78.139;  posting-account=mUWrkwoAAACCgah6ceXbZIsjKiFWP67A
User-Agent: G2/1.0
X-HTTP-UserAgent: Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10_6_2; en-us)  AppleWebKit/531.21.8 (KHTML, like Gecko) Version/4.0.4 Safari/531.21.10,gzip(gfe),gzip(gfe)
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit