Universal MessageRequester egal für DOS -Box oder Windows

PAMKKKKK · Beitrag von **PAMKKKKK** » 01.07.2005 20:36

Hallo PB verückte.....

Ich habe mal wieder was zusammengeklaut und was neues draus gestrickt.

Ich brauchte eine brauchbare Textausgabe in der Windows - DOS -Box....
Und ein Programm das unter Windows und in der Dos-Box gleich gut läuft.

Da bin ich auf den Tread von Wichtel und Danilo gestossen:
http://forums.purebasic.com/german/arch ... c&start=20

Danilo hat Rausgekriegt wie man zwischen DOS-Box und Windows unterscheidet. Verkürzt sieht das so aus:

Code: Alles auswählen

Procedure.b Con_or_Win()
; Festellen ob das Programm von der (Dos)konsole (=0) oder von Windows (=1) gestartet wurde  
; wenn die Umgebungsvarible %Promt%  nicht Existiert dann wurde von Windows gestartet
buff$ = Space(255)
If GetEnvironmentVariable_("PROMPT",@buff$,255) ; Windows API Umgebungsvariable %Promt% lesen
  ProcedureReturn 0 ; Von Konsole gestartet
EndIf
FreeConsole_() ; Konsole freigeben
ProcedureReturn 1 ; Von Windows durch Doppelcklick oder Ausführen... gestartet 
EndProcedure

Da kam mir im laufe meines Programmes der Gedanke man müsste einen MessageRequester haben der sich in WIN und DOS gleich verhält.
Nebenbei kann mann ihn benutzen wie den Originalen MessageRequester.
(Ich nutze den ja auch in dem Proggy)

28.Juni.2005 EDIT:
1. Die Globale "WinCon" für die Enscheidung ob das Prog von WIN oder DOS aus gestartet wurde muss an den Anfang eures Hauptprogrammes.
2. Die Übergabe Flags auf Long umgestellt
3. Procedure console_Modality() eingefügt (wird nicht benutzt)

Code: Alles auswählen

;******************************************************* 
; Universal Message Requester V.1.0 
; by Pamkkkkk 26.June.2005 
; 
;Shows Messages like MessageRequester but it shows it in 
;DOS-Box (32Bit Dos) or in Windows 
; 
; Compile it to CONSOLE !!!!!! 
; PureBasic V.3.93 
; Operating System = Windows 
;******************************************************* 
Declare.b MsgBox(Title.s,strText.s,Flags.l)
Declare.b Con_or_Win()
Declare MsgAdd(strString.s)
Declare myPrint(Text.s)
Declare myPrintN(strRow.s)
Declare .s myInkey()
Declare.s mkEOL(strRow.s,Flag.b)
Declare.b console_Modality(Flag.l)
Declare console_Icon(Flags.l)
Declare.b ask_console(Flags.l)

; Diese Globale mit dem Aufruf muss an den Anfang des Haupt-Programmes !!!!
Global WinCon.b ; Globale für Windows oder Konsole 
WinCon = Con_or_Win() ; Windows oder Konsole ?

; Linked List die die Nachrichten Sammelt (ein listeneintrag = eine Zeile Text )
NewList Message.s() 


; Hauptprocedur 
Procedure.b MsgBox(Title.s,strText.s,Flags.l) 
; Textzeilen aus der LinkedList durch Messagerequester oder in der Konsole ausgeben 
; Wenn Text.s übergeben wird dann ist der aufruf  wie beim PureBasic MessageRequester 
If strText > "" ; Wurde strText übergeben 
  ClearList(Message()) ; LinkedList Inhalt löschen 
  MsgAdd(strText)  ; strText in die LinkedList füllen 
EndIf 
RetCode.b = 0
ResetList(Message()) ; Liste an den Anfang setzen (eigentlich vor den anfang) 
If WinCon; Wenn das Programm von Windows gestartet wurde, dann... 
    While NextElement(Message()) ; Solange elemente in der Liste, sind nächstes element 
    Text.s = Text.s + mkEOL(Message(),1) ; Inhalt aus Listenelement in + Zeilenende 
    Wend 
    RetCode = MessageRequester(Title,Text,Flags) ; Text ausgeben 
; Wenn das Programm von der Konsole gestartet wurde, dann .... 
Else 
    myPrintN("---------------------------------------------------------------------------") ; ersatz für Fensterleiste 
    If Title > "" ; Consolen-Titel 
      myPrintN(UCase(Title)) ; Titelzeile GROSS ausgeben 
    EndIf 
    If Flags  ; Consolen-ICON 
      console_Icon(Flags) ; Icon als Text ausgeben 
    EndIf 
    myPrintN("---------------------------------------------------------------------------") ; ersatz für Fensterleiste 
    While NextElement(Message()) ; Solange elemente in der Liste, sind nächstes element 
      myPrintN(Message()) ; Inhalt aus Listenelement in Konsole ausgeben 
    Wend 
    If Flags ; Buttons als Text darstellen 
      RetCode = ask_console(Flags) ; Fragen stellen 
    EndIf 
    If RetCode = 0 ; Programmablauf unterbrechen bis User Reagiert hat 
      myPrintN("") ; Leerzeile 
      myPrint("Weiter mit der Eingabetaste:") 
      myInkey() 
    EndIf 
  EndIf 
  ClearList(Message()) ; Inhalt wieder löschen (Speicher freigeben)
ProcedureReturn RetCode 
EndProcedure 

Procedure.b Con_or_Win() 
; Festellen ob das Programm von der (Dos)konsole (=0) oder von Windows (=1) gestartet wurde  
; wenn die Umgebungsvarible %Promt%  nicht Existiert dann wurde von Windows gestartet 
buff$ = Space(255) 
If GetEnvironmentVariable_("PROMPT",@buff$,255) ; Windows API Umgebungsvariable %Promt% lesen 
  ProcedureReturn 0 ; Von Konsole gestartet 
EndIf 
FreeConsole_() ; Konsole freigeben 
ProcedureReturn 1 ; Von Windows durch Doppelcklick oder Ausführen... gestartet 
EndProcedure 

Procedure MsgAdd(strString.s) 
; Zeilen für die Message ausgabe in der LinkedList sammeln 
; (ein Listenelement =  eine Zeile) 
  AddElement(Message()) ; Element zur Liste zufügen 
  Message() = strString ;Listenelement mit Zeile füllen 
EndProcedure 

Procedure.b ask_console(Flags.l) 
; Die Flags vom MessageRequester in Consolen-Meldungen umsetzen 
; (genau wie bei MessageRequester die Flags zur Button wahl) 
Select 15 & Flags ; auf hintere Bits Prüfen (0000000000001111) 
  Case 1 ; Button_OK_Cancel 
    myPrintN("") ;Leerzeile 
    myPrintN("Waehlen Sie:") 
    myPrintN("1 = OK") 
    myPrintN("2 = Cancel") 
  Case 2 ; Button_Abort_Retry_Ignor 
    myPrintN("") ;Leerzeile 
    myPrintN("Waehlen Sie:") 
    myPrintN("3 = Abort") 
    myPrintN("4 = Retry") 
    myPrintN("5 = Ignore")    
  Case 3 ; Button_Yes_NO_Cancel 
    myPrintN("") ;Leerzeile 
    myPrintN("Waehlen Sie:") 
    myPrintN("2 = Cancel") 
    myPrintN("6 = Yes") 
    myPrintN("7 = No") 
  Case 4 ; Button_Yes_No 
    myPrintN("") ;Leerzeile 
    myPrintN("Waehlen Sie:") 
    myPrintN("6 = Yes") 
    myPrintN("7 = No")  
  Case 5 ; Button_Retry_Cancel 
    myPrintN("") ;Leerzeile 
    myPrintN("Waehlen Sie:") 
    myPrintN("2 = Cancel") 
    myPrintN("4 = Retry") 
  Default 
    ProcedureReturn 0 
EndSelect 
; Input des User erfragen und Prüfen 
; der User hat das richtige eingegeben wenn (Input_OK = 1 ) 
myPrintN("") ; Leerzeile 
Input_OK.b = 0 
While Input_OK = 0 ; solange User was falsches eingibt 
  myPrint("Eingabe:") 
  Input = Val(myInkey()) 
  Select 15 & Flags ; auf hintere Bits Prüfen (0000000000001111) 
    Case 1 ; Button_OK_Cancel 
      Select Input ; Prüfen ob der User was richtiges eingegeben hat 
        Case #IdOK 
         Input_OK = 1 
        Case #IdCancel 
          Input_OK = 1 
      EndSelect 
    Case 2 ; Button_Abort_Retry_Ignor 
      Select Input; Prüfen ob der User was richtiges eingegeben hat 
        Case #IdAbort 
          Input_OK = 1 
        Case #IdRetry 
          Input_OK = 1 
        Case #IdIgnore 
          Input_OK = 1 
      EndSelect 
    Case 3 ; Button_Yes_NO_Cancel 
      Select Input; Prüfen ob der User was richtiges eingegeben hat 
        Case #IdYes 
          Input_OK = 1 
        Case #IdNo 
          Input_OK = 1 
        Case #IdCancel 
          Input_OK = 1 
      EndSelect  
    Case 4 ; Button_Yes_No 
       Select Input; Prüfen ob der User was richtiges eingegeben hat 
        Case #IdYes 
          Input_OK = 1 
        Case #IdNo 
          Input_OK = 1 
      EndSelect 
    Case 5 ; Button_Retry_Cancel 
      Select Input; Prüfen ob der User was richtiges eingegeben hat 
        Case #IdRetry 
          Input_OK = 1 
        Case #IdCancel 
          Input_OK = 1 
      EndSelect 
  EndSelect 
   If Input_OK = 0 
     myPrintN("Eingabe war Falsch Bitte nocheinmal") 
   EndIf 
Wend 
ProcedureReturn Input ; Returncode wie bei PureBasic MessageRequester 
EndProcedure

Procedure console_Icon(Flags.l) 
; Die Flags vom MessageRequester in Consolen-Meldungen umsetzen 
; (genau wie bei MessageRequester die ICON - Flags) 
Select 240 & Flags ; auf vordere Bits Prüfen (0000000011110000) 
  Case 16 ; ICON_Error 
    myPrintN("ERROR !") ; ICON als Text ausgeben 
  Case 32 ; ICON_Question 
    myPrintN("QUESTION ?") ; ICON als Text ausgeben 
  Case 48 ; ICON_Warning 
    myPrintN("WARNING !") ; ICON als Text ausgeben 
  Case 64 ; ICON_Information 
    myPrintN("INFORMATION !") ; ICON als Text ausgeben 
EndSelect 
EndProcedure 

Procedure.b console_Modality(Flag.l)
; Die Flags vom MessageRequester in Consolen-Meldungen umsetzen 
; (genau wie bei MessageRequester die Modalitäts - Flags) 
; Wird noch nicht benutzt weil ich nicht weiss wie das geht !!!!
Select 61440 & Flags ; auf Bits Prüfen (1111000000000000)
  Case 0 ; Application-Modal 
     ;Code...
 Case 4096 ; System-Modal
   ; Code .....
 Case 8192 ; Task-Modal
  ; Code.....
EndSelect
EndProcedure

Procedure myPrint(Text.s) 
; Eine Zeile auf der Konsole ausgeben (Print) ohne Zeilenvorschub 
  size.l=Len(Text) 
  bWritten.l 
  Text = mkEOL(Text,0) ; Zeilenende löschen 
  stdout.l = GetStdHandle_(#STD_OUTPUT_HANDLE) ; Konsolen Standart Out holen 
  size =Len(Text) 
  If stdout 
    WriteConsole_(stdout,@Text,size, @bWritten, #Null) ; Auf die Konsole schreiben 
  EndIf 
EndProcedure 

Procedure myPrintN(strRow.s) 
; Eine Zeile auf der Konsole ausgeben (Print) mit Zeilenvorschub 
strRow = mkEOL(strRow,1) ;Zeilenende anhängen 
stdout.l = GetStdHandle_(#STD_OUTPUT_HANDLE) ; Konsolen Standart Out holen 
If stdout 
  WriteConsole_(stdout,@strRow.s,Len(strRow.s),@retval,0); Auf die Konsole schreiben 
EndIf 
EndProcedure 

Procedure.s myInkey() 
; Zeichen von der Konsole lesen und warten auf die Taste Enter 
stdin.l = GetStdHandle_(#STD_INPUT_HANDLE); Konsolen Standart inn holen 
If stdin 
  oldmode.l 
  GetConsoleMode_(stdin,@oldmode) ; alten mode merken 
   ; neuen mode setzen, damit readconsole wie Inkey arbeitet 
  SetConsoleMode_(stdin,oldmode | #ENABLE_PROCESSED_INPUT) 
  input$=Space(256) 
  bRead.l 
  readconsole_(stdin,@input$,Len(input$), @bRead, #Null) ; Von der Konsole lesen 
EndIf 
ProcedureReturn input$ ; Das von der Konsole gelesene Weiterreichen 
EndProcedure 

Procedure.s mkEOL(strRow.s,Flag.b) 
 ;Vorhandenes Zeilenende bereinigen (löschen) 
 ;Wenn es gewünscht ist (Flag = 1) dann neues Zeilenende anhängen ( Chr(13) + Chr(10) ) 
  While Right(strRow,1) = Chr(10)  Or Right(strRow,1) = Chr(13) ; bei Zeilenende Zeichen 
    size.l = Len(strRow) 
    strRow = Left(strRow,size-1) ; 1 Zeichen löschen 
  Wend 
  If Flag = 1 ; Wenn es gewünscht... 
    strRow.s = strRow + Chr(13) + Chr(10); ...ist Zeilenende und vorschub anhängen 
  EndIf 
  ProcedureReturn strRow ; bearbeiteten String zurückgeben 
EndProcedure
;*****************************
; es folgen Beispiel aufrufe
;*****************************
;Mehrzeiliger aufruf:
MsgAdd("Das ist eine Nachricht die")
MsgAdd("In der Dos-Konsole oder")
MsgAdd("In Windows Funktioniert")
MsgBox("Titel der Nachricht","",0) ; Bei benutzung der MsgAdd muss der Text leer ("") bleiben!

; Einzeiliger (oder im string mit CHR(10)) aufruf
MsgBox("Titel der Nachricht","Text der Nachricht",0)

;Mehrzeiliger aufruf mit Flags und Abfrage:
MsgAdd("Das ist eine Nachricht die")
MsgAdd("In der Dos-Konsole oder")
MsgAdd("In Windows Funktioniert")
Select MsgBox("Titel der Nachricht","",#MB_ABORTRETRYIGNORE|#MB_ICONERROR) ; Bei benutzung der MsgAdd muss der Text leer ("") bleiben!
  Case #IdAbort
    ; Tu was bei Abort
  Case #IdRetry
    ; Tu was bei Retry
  Case #IdIgnore
    ; Tu was bei Ignore
EndSelect

Testet das mal in der DOS-Box und Windows bitte!!

Meine Fragen dazu:

Wie sieht das mit der Modalität aus ??
Was ist System-, Aplication- oder Taskmodalität ??
Wie erzeuge ich diese Modalitäten ??
Bei Application ist das ziemlich klar, denke ich

(läuft ja schon)
Ist Systemmodalität = 100% CPU Burn in??

GIBT ES IN PUREBASIC EINE MÖGLICHKEIT PROCEDURE-PARAMETER OPTIONAL ZU MACHEN ??????
z.B. Beispiel durch überladen der Procedure ???

125 · Beitrag von **125** » 01.07.2005 20:57

Hi,
habs getestet unter Windows aufgerufen -> geht.
unter Console -> Passiert nix, bleibt aber mit 58 % CPU auslastung an.

mfg
125

benny · Beitrag von **benny** » 01.07.2005 21:04

GIBT ES IN PUREBASIC EINE MÖGLICHKEIT PROCEDURE-PARAMETER OPTIONAL
ZU MACHEN ?????? z.B. Beispiel durch überladen der Procedure ???

Nein. AFAIK geht das nicht. Solche OO-Features sind meines Wissens auch
nicht geplant.

PAMKKKKK · Beitrag von **PAMKKKKK** » 01.07.2005 21:05

@125
Danke für den Test !

Bei mir läuft es auf 2 Rechner, mit WinXP

Hast du es mit den Projekt Compiler Optionen --> Konsole Kompeliert??
Und die *.exe. von der Dosbox aus aufgerufen ??

etwa so ?

Code: Alles auswählen

c:> testprog.exe

125 · Beitrag von **125** » 01.07.2005 21:11

Hi,
Ah ich hatte den Console Switch nicht an

Läuft Top

mfg
125