PureBoard

Code: Alles auswählen

If MessageRequester("Frage", "Ist Berlin Deutschlands Hauptstadt?", #PB_MessageRequester_YesNo)=#PB_MessageRequester_Yes
MessageRequester("Richtig","Diese Antwort ist richtig!" +  Chr(10)  + "Leider ist mein kleines Quiz hier schon zu Ende!")
Else 
MessageRequester("Falsch", "Ihre Antwort war leider falsch!" +  Chr(10)  + "Versuchen sie es nochmal!")
EndIf

Code: Alles auswählen

; English forum:
; Author: Unknown
; Date: 21. January 2003
; OS: Windows
; Demo: No


; Change dialog box buttons... crashes PBCompiler, but the program itself works!

; Try creating an .exe file -- PB will crash, but the .exe version will work just fine when run :)

#IDOK = 1
#IDCANCEL = 2
#IDABORT = 3
#IDRETRY = 4
#IDIGNORE = 5
#IDYES = 6
#IDNO = 7
#IDPROMPT = $FFFF

Global hHook
Global mbtitle$, mbmsg$, mbopt1$, mbopt2$, mbopt3$

; Have to pre-allocate maximum string length, as the dialog box is created with message/title
; with this many spaces (the width of the box comes from this), then the text is hacked into it.

#StringSpace = 80

Procedure MsgBoxHookProc (uMsg, wParam, lParam)
   If uMsg = #HCBT_ACTIVATE
      SetWindowText_ (wParam, mbtitle$)
      SetDlgItemText_ (wParam, #IDABORT, mbopt1$)
      SetDlgItemText_ (wParam, #IDRETRY, mbopt2$)
      SetDlgItemText_ (wParam, #IDIGNORE, mbopt3$)
      SetDlgItemText_ (wParam, #IDPROMPT, mbmsg$)
      UnhookWindowsHookEx_ (hHook)
   EndIf
   ProcedureReturn #False
EndProcedure

Procedure MessageBoxH (parentWindow, title$, message$, button1$, button2$, button3$)
   mbtitle$ = title$
   mbmsg$ = message$
   mbopt1$ = button1$
   mbopt2$ = button2$
   mbopt3$ = button3$
   hInstance = GetModuleHandle_ (0)
   hThreadId = GetCurrentThreadId_ ()
   hHook = SetWindowsHookEx_ (#WH_CBT, @MsgBoxHookProc (), hInstance, hThreadId)
   ProcedureReturn MessageBox_ (parentWindow, Space (#StringSpace), Space (#StringSpace), #MB_ABORTRETRYIGNORE | #MB_ICONINFORMATION)
EndProcedure

MessageBoxH (0, "Search for program...", "Please select the drive to search...", "Search C:\", "Search D:\", "Cancel")
; IDE Options = PureBasic v4.00 (Windows - x86)
; Folding = -

Code: Alles auswählen

; ------------------------------------------------------------------------------------------
;                                 Coded by PureBasic4.0
;                                 
; Die Datei FragenUndAntworten.txt muss folgende Informationen beinhalten:
; 1. Die Frage als String
; 2. Die Antwort als Byte (1 bedeutet Ja, 0 bedeutet Nein)
; 
; Dieses Quiz kann kostenlos kompiliert und benutzt werden (auch als kommerzielle Version)
; ------------------------------------------------------------------------------------------
#File = "FragenUndAntworten.txt"
Structure Questions
  Frage.s
  Antwort.b
  ID.d
EndStructure
Global AnzahlFragen.d
NewList Fragen.Questions()
If ReadFile(0,#File)
  Repeat
    Frage$ = ReadString(0)
    Antwort = ReadByte(0)
    AddElement(Fragen())
    Fragen()\Frage = Frage$
    Fragen()\Antwort = Antwort
    Fragen()\ID = AnzahlFragen
    AnzahlFragen + 1
  Until Eof(0)
Else
  MessageRequester("Fehler","Die Datei "+#File+" konnte nicht geöffnet werden"+Chr(13)+"Das Programm wird beendet",#MB_ICONSTOP)
  End
EndIf
If AnzahlFragen = 0 Or AnzahlFragen = 1
  MessageRequester("Fehler","Die Datei "+#File+" muss mehr als 1 Frage enthalten",#MB_ICONSTOP)
  End
EndIf
Repeat
  nochmalfrage:
  Repeat
    AktuelleFrage = Random(AnzahlFragen)
  Until AktuelleFrage <> LetzteFrage
  ForEach Fragen()
    If Fragen()\ID = AktuelleFrage
      FrageText$ = Fragen()\Frage
      FrageAntwort = Fragen()\Antwort
      Break
    EndIf
  Next
  If FrageText$ = ""
    Goto nochmalFrage
  EndIf
  Result = MessageRequester("Frage",FrageText$,#PB_MessageRequester_YesNoCancel|#MB_ICONQUESTION)
  If Result = #PB_MessageRequester_Cancel
    End
  ElseIf Result = #PB_MessageRequester_No
    GegebeneAntwort = 1
  Else
    GegebeneAntwort = 2
  EndIf
  If GegebeneAntwort = FrageAntwort
    MessageRequester("Info","RICHTIG!!!",#MB_ICONINFORMATION)
  Else
    MessageRequester("Info","Leider falsch",#MB_ICONEXCLAMATION)
  EndIf
  LetzteFrage = AktuelleFrage
ForEver

Code: Alles auswählen

If OpenFile(0,"FragenUndAntworten.txt")
  OpenConsole()
  PrintN("Tool zum Hinzufuegen von Fragen und Antworten")
  Repeat
    PrintN("")
    Print("Frage: ")
    Frage$ = Input()
    Nochmal:
    PrintN("Antwort: ")
    PrintN("(1) Nein")
    PrintN("(2) Ja")
    Print("Eingabe: ")
    AntwortString$ = Input()
    Antwort = Val(AntwortString$)
    If Antwort = 1 Or Antwort = 2
      WriteString(0,Frage$)
      WriteByte(0,Antwort)
      PrintN("OK. Die Frage wurde gespeichert")
    Else
      PrintN("Ungueltige Eingabe")
      Goto Nochmal
    EndIf
  ForEver
EndIf