PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Bilderauswahl or Picturechoice/voting

https://www.purebasic.fr/english/viewtopic.php?t=39840

Page 1 of 1

Bilderauswahl or Picturechoice/voting

Posted: Sat Nov 07, 2009 11:32 pm
by infratec
Hi together,

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 :mrgreen:

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 :D )

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)
I hope someone can use it.


Best regards,

Bernd
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited