Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 10
#Compile Exe
#Debug Display On
#Debug Error On
#Dim All
%Unicode = 1
#Include "Win32API.inc"
Enum Equates Singular
IDC_Build = 500
IDC_Extract
IDC_ShowResults
IDC_StatusBar
IDC_Graphic
End Enum
Type MonthData
Month(12) As String * 10000
End Type
Global hDlg,hThread,hFont As Dword, temp$, FileData() As String, x0, y0, MsgCount, PostCount As Long
Global ThreadNameList(), PostNameList() As MonthData
Function PBMain() As Long
Dialog Default Font "Tahoma",10,0
ReDim ThreadNameList(2000 To 2016), PostNameList(2000 To 2016)
Dialog New Pixels, 0, "PowerBASIC Forums History",300,50,1200,950, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_Build,"Build Array", 50,20,100,20
Control Add Button, hDlg, %IDC_Extract,"Extract Info", 50,50,100,20
Control Add Button, hDlg, %IDC_ShowResults,"Show Results", 50,80,100,20
Control Add Graphic, hDlg, %IDC_Graphic,"Show Results", 170,20,1000,860, %WS_Border
Font New "Tahoma",10,0 To hFont
Graphic Set Font hFont
Control Add Statusbar, hDlg, %IDC_StatusBar,"", 0,0,0,0
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Build : ReadData 'read in the data
Case %IDC_Extract : ExtractData 'must run MakeSmall first
Case %IDC_ShowResults : ShowResults 'must run MakeSmall first
End Select
End Select
End Function
Sub ReadData
Statusbar Set Text hDlg, %IDC_StatusBar,1,0, "Started ... " + Time$
Open "all.txt" For Binary As #1
Get$ #1, Lof(1), temp$
Close #1
ReDim FileData(ParseCount(temp$,Chr$(10)))
Parse temp$, FileData(), Chr$(10)
Statusbar Set Text hDlg, %IDC_StatusBar,1,0, "Done ... " + Time$
Beep
End Sub
Sub ExtractData
On Error GoTo ExtractError
Local i,iYear,iMonth As Long, tempDate, tempName As String
Statusbar Set Text hDlg, %IDC_StatusBar,1,0, "Started at ... " + Time$
MsgCount = 0 : PostCount = 0
Open "small.txt" For Output As #1
For i = 0 To UBound(FileData)
If Left$(FileData(i),5) = "'NAME" Then
tempName = FileData(i) : Print #1, tempName
tempDate = FileData(i+1) : Print #1, tempDate
tempName = Mid$(tempName,10)
iYear = Val(Mid$(tempDate,10,4))
iMonth = Val(Mid$(tempDate,15,2))
If iYear < LBound(ThreadNameList) Or iYear > UBound(ThreadNameList) Then Iterate For '? "Error" + $CrLf + tempName + $CrLf + tempDate
If iMonth < 1 Or iMonth > 12 Then Iterate For '? "Error" + $crlf + tempName + $crlf + tempDate
ThreadNameList(iYear).Month(iMonth) = tempName + $CrLf + ThreadNameList(iYear).Month(iMonth)
Incr MsgCount
End If
If Left$(FileData(i),10) = "'FOLLOW-UP" Then
tempName = FileData(i+1) : Print #1, tempName
tempDate = FileData(i+2) : Print #1, tempDate
tempName = Mid$(tempName,2)
iYear = InStr(tempDate,",") 'position of "," in tempDate
iYear = Val(Mid$(tempDate,iYear+1,5))
iMonth = InStr("JanFebMarAprMayJunJulAugSepOctNovDec",Mid$(tempDate,2,3))/3 + 1
If iYear < LBound(PostNameList) Or iYear > UBound(PostNameList) Then Iterate For '? "Error" + $CrLf + tempName + $CrLf + tempDate
If iMonth < 1 Or iMonth > 12 Then Iterate For '? "Error" + $CrLf + tempName + $CrLf + tempDate
PostNameList(iYear).Month(iMonth) = tempName + $CrLf + PostNameList(iYear).Month(iMonth)
Incr PostCount
End If
Next i
Close #1
Beep
Statusbar Set Text hDlg, %IDC_StatusBar,1,0, "MsgCount: " + Str$(MsgCount) + " PostCount: " + Str$(PostCount) + " " + Time$
Exit Sub
ExtractError:
? tempName + $CrLf + tempDate + $CrLf + Str$(iYear) + $CrLf + Str$(iMonth)
End Sub
Sub ShowResults
Local i,j,x,y,w,h,iCount As Long, temp$, pID As Dword
Graphic Get Client To w,h
x0 = 50 : y0 = h - 50
Graphic Line (x0,y0)-(x0,50), %Black
Graphic Line (x0,y0)-(w-20,y0), %Black
Graphic Set Pos (w-100,y0-50) : Graphic Print "New Threads"
Graphic Set Pos (w-100,y0-250) : Graphic Print "Total Posts"
For i = 1 To 14 : Graphic Set Pos (x0,y0-i*50) : Graphic Print Str$(i * 100) : Next i '100 pixel = 200 thread
For i = LBound(ThreadNameList) To UBound(ThreadNameList)
Graphic Set Pos (x0 + iCount,y0+20) : Graphic Print Trim$(Str$(i))
If i = 2012 Then Graphic Line (x0 + iCount,y0)-(x0 + iCount,y0-450),%Red
iCount += 48
Next i
iCount = 0
For i = LBound(ThreadNameList) To UBound(ThreadNameList)
For j = 1 To 12
x = x0 + (iCount * 12 + j) * 4
y = y0 - ParseCount(ThreadNameList(i).Month(j),$CrLf) / 2
Graphic Ellipse (x-2,y-2)-(x+2,y+2), %Blue
y = y0 - ParseCount(ThreadNameList(i).Month(j),$CrLf)/2 - ParseCount(PostNameList(i).Month(j),$CrLf)/2
Graphic Ellipse (x-2,y-2)-(x+2,y+2), %Red
temp$ += Str$(i) + MonthName$(j) + Str$(ParseCount(ThreadNameList(i).Month(j),$CrLf)) + Str$(ParseCount(PostNameList(i).Month(j),$CrLf)) + $CrLf
Next i
Incr iCount
Next i
Open "results.txt" For Output As #1
Print #1, temp$
Close #1
pID = Shell("notepad.exe " + Exe.Path$ + "results.txt", 1) 'does not wait
End Sub
http://www.garybeene.com/sw/gbsnippets.htm