I've written a small tool for my wife:
She is a mod in a dog forum and this year she had the task to collect the votes
for the next year picture calendar. Every user was possible to add 2 pictures in the thread.
At least round about 100 pictures where available. Now every user was able to select 6 pictures
and this numbers were sent to my wife. She had to collect the votes and to find out the ranking.
In the forum software you can only give one vote and not more.
I thougth: Nice stuff for a small program
And the program growth.
First I used SQLite for it, but when I noticed that the exe is > 400k big, and it was not
possible to update the database during a select loop, I changed the program to use a normal
csv text file as 'database'.
Than I thougt it would be nice if she can click on the ranking and see the picture.
At least she want to show the results in the forum. So I added a copy to clipboard function.
Now it is a nice small program and I thought it is a god idea when someone else can use it.
here it is:
(sorry, the texts are in german, but I think you can find out how it works
)Code: Select all
#BildX = 320
#BildY = 240
Structure Umfrage
PictureNo.b
Counts.w
Rank.b
EndStructure
Global CSVFile.s = ""
Global PicturesPerChoice = 0
Global HighlightedPictures = 0
Global ResultSize = 0
Global Dim Result.Umfrage(ResultSize)
Global ClipBoard$ = ""
Procedure AddEntry()
NotFound = #True
If OpenFile(0, CSVFile)
No = 1
While Eof(0) = 0 And NotFound
Line$ = ReadString(0)
No + 1
; If FindString(Line$, GetGadgetText(10), 1) = 1
Name$ = StringField(Line$, 2, ",")
If Name$ = GetGadgetText(10)
MessageRequester("Info", "Diesen Namen gibt es bereits!")
NotFound = #False
EndIf
Wend
If NotFound
Text$ = Str(No) + ","
Text$ + GetGadgetText(10)
For i = 11 To 10 + PicturesPerChoice
If GetGadgetText(i)
Text$ + "," + GetGadgetText(i)
EndIf
Next i
;Debug Text$
WriteStringN(0, Text$)
EndIf
CloseFile(0)
EndIf
EndProcedure
Procedure CheckIt()
For i = 0 To ResultSize
Result(i)\PictureNo = i
Result(i)\Counts = 0
Result(i)\Rank = 0
Next i
If OpenFile(0, CSVFile)
Count = 0
While Eof(0) = 0
Line$ = ReadString(0)
i = 3
Repeat
PictureNo = Val(StringField(Line$, i, ","))
i + 1
If PictureNo
If PictureNo > ResultSize
ReDim Result(PictureNo)
For j = ResultSize + 1 To PictureNo
Result(j)\PictureNo = j
Result(j)\Counts = 0
Result(j)\Rank = 0
Next j
ResultSize = PictureNo
EndIf
Result(PictureNo)\Counts + 1
EndIf
Until PictureNo = 0
Wend
CloseFile(0)
EndIf
SortStructuredArray(Result(), #PB_Sort_Descending, OffsetOf(Umfrage\Counts), #PB_Sort_Word)
Platz = 0
PlatzCounter = 1
LastCount = 0
For i = 0 To ResultSize
If Result(i)\Counts
If Result(i)\Counts <> LastCount
Platz + PlatzCounter
PlatzCounter = 1
LastCount = Result(i)\Counts
Else
PlatzCounter + 1
EndIf
Result(i)\Rank = Platz
EndIf
Next i
ClearGadgetItems(40)
j = 0
ClipBoard$ = "Platz" + Chr(9) + "Bild" + Chr(9) + "Stimmen" + Chr(13) + Chr(10)
For i = 0 To ResultSize
If Result(i)\Counts
; Debug Str(Result(i)\PictureNo) + " : " + Str(Result(i)\Counts)
Text$ = Str(Result(i)\Rank) + Chr(10)
Text$ + Str(Result(i)\PictureNo) + Chr(10)
Text$ + Str(Result(i)\Counts)
AddGadgetItem(40, -1, Text$)
ReplaceString(Text$, Chr(10), Chr(9), #PB_String_InPlace)
ClipBoard$ + Text$ + Chr(13) + Chr(10)
If j < HighlightedPictures
SetGadgetItemColor(40, j, #PB_Gadget_BackColor, $DF00FF)
EndIf
j + 1
EndIf
Next i
EndProcedure
UseJPEGImageDecoder()
PicturesPerChoice = Val(ProgramParameter(0))
If PicturesPerChoice = 0 : PicturesPerChoice = 6 : EndIf
If PicturesPerChoice > 6 : PicturesPerChoice = 6 : EndIf
HighlightedPictures = Val(ProgramParameter(1))
If HighlightedPictures = 0 : HighlightedPictures = 12 : EndIf
ProgramName.s = Left(GetFilePart(ProgramFilename()), Len(GetFilePart(ProgramFilename())) - 4)
CSVFile = ProgramName + ".csv"
;CSVFile = "KalenderUmfrage2010.csv"
OpenWindow(0, 0, 0, 590, 260, ProgramName, #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
TextGadget(0, 10, 10, 40, 20, "Name :")
For i = 1 To PicturesPerChoice
TextGadget(i, 10 + (40 * (i - 1)), 50, 30, 20, "Bild " + Str(i))
Next i
StringGadget(10, 50, 10, 190, 20, "")
For i = 11 To 10 + PicturesPerChoice
StringGadget(i, 10 + (40 * (i - 11)), 75, 30, 20, "", #PB_String_Numeric)
Next i
ButtonGadget(30, 10, 110, 230, 20, "Hinzufügen")
DisableGadget(30, 1)
ListIconGadget(40, 10, 145, 230, 106, "Platz", 40, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
AddGadgetColumn(40, 1, "Bild", 40)
AddGadgetColumn(40, 2, "Stimmen", 125)
ImageGadget(50, 260, 10, #BildX, #BildY, 0, #PB_Image_Border)
Text$ = Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "Bilderauswahl V1.00" + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "(c) 2009"
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "Hilfe zum Programm mit F1"
TextGadget(51, 260, 10, #BildX, #BildY, Text$, #PB_Text_Center|#PB_Text_Border)
HideGadget(50, 0)
Exit = #False
CheckIt()
AddKeyboardShortcut(0, #PB_Shortcut_Control | #PB_Shortcut_C, 1)
AddKeyboardShortcut(0, #PB_Shortcut_F1, 2)
Repeat
EventID = WaitWindowEvent()
If EventID = #PB_Event_Menu
Select EventMenu()
Case 1
SetClipboardText(ClipBoard$)
Case 2
Text$ = "Aufruf: Programmname [n [h]]" + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "Der Programmname kann und soll geändert werden." + Chr(13) + Chr(10)
Text$ + "z.B. in Kalenderumfrage2012.exe" + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "Die Parameter n und h sind optional." + Chr(13) + Chr(10)
Text$ + "Der Parameter h kann nur mit dem Parameter n zusammen angegeben" + Chr(13) + Chr(10)
Text$ + "werden." + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + " n : Anzahl der angezeigten Eingabefelder (1...6), Vorgabe ist 6." + Chr(13) + Chr(10)
Text$ + " h : Anzahl der hervorgehobenen Einträge. Vorgabe ist 12." + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "Beispiel: Programmname 2 3" + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "Die Anzahl der Bilder wird nur durch den Arbeitspeicher begrenzt." + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "Die eingegebenen Daten werden in einer Datei mit gleichem Namen," + Chr(13) + Chr(10)
Text$ + "jedoch mit der Endung CSV anstatt EXE abgespeichert," + Chr(13) + Chr(10)
Text$ + "und kann mit jedem Textbearbeitungsprogramm geöffnet werden." + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "Die Bilder müssen die Bildnummer als Dateinamen besitzen (z.B. 8.jpg)" + Chr(13) + Chr(10)
Text$ + "und im gleichen Verzeichnis wie das Programm stehen. Die Bilder" + Chr(13) + Chr(10)
Text$ + "werden angezeigt, wenn man auf den Eintrag in der Liste 'klickt'." + Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + "Mit Strg+C kann das Ergebnis in die Zwischenablage kopiert werden."+ Chr(13) + Chr(10)
Text$ + Chr(13) + Chr(10)
Text$ + " (c) 2009 by Scanner"
MessageRequester(ProgramName, Text$)
EndSelect
EndIf
If EventID = #PB_Event_Gadget
Select EventGadget()
Case 10
If Len(GetGadgetText(10))
DisableGadget(30, 0)
Else
DisableGadget(30, 1)
EndIf
Case 30
AddEntry()
CheckIt()
SetGadgetText(10, "")
For i = 11 To 10 + PicturesPerChoice
SetGadgetText(i, "")
Next i
DisableGadget(30, 1)
Case 40
If EventType() = #PB_EventType_LeftClick
PictureFile$ = GetGadgetItemText(40, GetGadgetState(40), 1) + ".jpg"
; Debug GetGadgetItemText(40, GetGadgetState(40), 1)
If LoadImage(0, PictureFile$)
HideGadget(50, 0)
HideGadget(51, 1)
x = ImageWidth(0)
y = ImageHeight(0)
If x > #BildX Or y > #BildY
xf.f = x / #BildX
yf.f = y / #BildY
If xf > yf
ResizeImage(0, x / xf, y / xf)
Else
ResizeImage(0, x / yf, y / yf)
EndIf
EndIf
SetGadgetState(50, ImageID(0))
Else
SetGadgetText(51, "Bild " + PictureFile$ + " nicht vorhanden !")
HideGadget(50, 1)
HideGadget(51, 0)
EndIf
EndIf
EndSelect
EndIf
If EventID = #PB_Event_CloseWindow : Exit = #True : EndIf
Until Exit
RemoveKeyboardShortcut(0, #PB_Shortcut_All)Best regards,
Bernd