🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

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

Re: Nie mały problem dla grafika

#104418
From: Marek
Date: Mon, 21 Dec 2009 19:23
145 lines
6139 bytes
Bardzo dziękuję za algorytm sprawdza się w stu procentach.
Mój nadgarstek od ciągłego klikania wreszcie będzie odciążony.
Jeszcze raz dziękuję.
Pozdrawiam, Wesołych Świąt i Szczęśliwego Nowego Roku.
Marek

Użytkownik "Janusz Rychter" <najyer@hotmail.com> napisał w wiadomości
news:56120087-1bdc-4224-9ba4-ab20b75b5b29@n13g2000vbe.googlegroups.com...
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: <hgoidd$6em$1@nemesis.news.neostrada.pl>
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.rmf.pl!agh.edu.pl!news.agh.edu.pl!news.onet.pl!news.nask.pl!news.nask.org.pl!newsfeed00.sul.t-online.de!newsfeed01.sul.t-online.de!t-online.de!newsfeed.neostrada.pl!unt-exc-01.news.neostrada.pl!atlantis.news.neostrada.pl!news.neostrada.pl!not-for-mail
References: <hghc1a$e5j$1@nemesis.news.neostrada.pl> <56120087-1bdc-4224-9ba4-ab20b75b5b29@n13g2000vbe.googlegroups.com>

Show Full Headers
Complete Article Headers
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.rmf.pl!agh.edu.pl!news.agh.edu.pl!news.onet.pl!news.nask.pl!news.nask.org.pl!newsfeed00.sul.t-online.de!newsfeed01.sul.t-online.de!t-online.de!newsfeed.neostrada.pl!unt-exc-01.news.neostrada.pl!atlantis.news.neostrada.pl!news.neostrada.pl!not-for-mail
From: "Marek" <echyt@interia.pl>
Newsgroups: pl.comp.lang.vbasic
Subject: Re: Nie mały problem dla grafika
Date: Mon, 21 Dec 2009 20:23:21 +0100
Organization: TP - http://www.tp.pl/
Lines: 147
Message-ID: <hgoidd$6em$1@nemesis.news.neostrada.pl>
References: <hghc1a$e5j$1@nemesis.news.neostrada.pl> <56120087-1bdc-4224-9ba4-ab20b75b5b29@n13g2000vbe.googlegroups.com>
NNTP-Posting-Host: abn179.internetdsl.tpnet.pl
X-Trace: nemesis.news.neostrada.pl 1261423854 6614 83.16.39.179 (21 Dec 2009 19:30:54 GMT)
X-Complaints-To: usenet@news.neostrada.pl
NNTP-Posting-Date: Mon, 21 Dec 2009 19:30:54 +0000 (UTC)
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 6.00.2800.1478
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1478
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit