Article View: pl.comp.lang.vbasic
Article #104418Re: Nie mały problem dla grafika
From: Marek
Date: Mon, 21 Dec 2009 19:23
Date: Mon, 21 Dec 2009 19:23
145 lines
6139 bytes
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-mailReferences:
<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