HI PB´s!
If you need a Programm that runs in Windows and Dos-Console you can Display Messages in both Know!
WICHTEL and DANILO from the German Forum solved the Problem that a Programm detect if the start caller was DOS or WINDOWS.
Code Looks like:
Code: Select all
Procedure.b Con_or_Win()
; Detects if the Programmcaller is the DOSconsole (=0) or Windows (=1)
; if exist the Environment Variable %Promt% then it is the DOSconsole
buff$ = Space(255)
If GetEnvironmentVariable_("PROMPT",@buff$,255) ; reading the Environment Variable %Promt%
ProcedureReturn 0 ; Called from Console
EndIf
FreeConsole_() ; free Willy... oh no the Console!
ProcedureReturn 1 ; Called from Windows true doublecklick or Start -> Run...
EndProcedureIt display´s Messages in DOS-Box like a normal MessageRequester and you can use it so!
The Globale "WinCon" with the Procedurecall behind must be the first in your Main-Programm !!!!
Code: Select all
;*******************************************************
; 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)
; This Globale with the Procedurecall behind must be the first in your Main-Programm !!!!
Global WinCon.b ; Globale for Windows or Console
WinCon = Con_or_Win() ; Windows or Console ?
; LinkedList who collects the Rows for the Message (one Listentry = one Textrow )
Global NewList Message.s()
; Mainprocedur
Procedure.b MsgBox(Title.s,strText.s,Flags.l)
;Displays Textrows from the LinkedList in a PB-MessageRequester or DOS-BOX
; If is Text in the strText Variable it Works equal to the PB-MessageRequester
If strText > "" ;Is Text in strText ?
ClearList(Message()) ; Empty the LinkedList
MsgAdd(strText) ; fill the strText in the LinkedList
EndIf
RetCode.b = 0
ResetList(Message()) ; LinkedList to Start
If WinCon ;If the Caller is WINDOWS
While NextElement(Message()) ; crowl through the List
Text.s = Text.s + mkEOL(Message(),1) ; ListElement + End of Line
Wend
RetCode = MessageRequester(Title,Text,Flags) ; Display Text
Else ;If the Caller is the Console
myPrintN("---------------------------------------------------------------------------") ; alternative for Windowheadline
If Title > "" ; Console-Title
myPrintN(UCase(Title)) ; Display Title BIG
EndIf
If Flags ; Console-ICON
console_Icon(Flags) ; Display Icon as Text
EndIf
myPrintN("---------------------------------------------------------------------------") ; alternative for Windowheadline
While NextElement(Message()) ; crowl through the List
myPrintN(Message()) ; Display Text from LinkedList in Console
Wend
If Flags ; Buttons as Text
RetCode = ask_console(Flags) ; ask Question
EndIf
If RetCode = 0 ; Programmablauf unterbrechen bis User Reagiert hat
myPrintN("") ; ;Spacerow
myPrint("To resume press ENTER:")
myInkey()
EndIf
EndIf
ClearList(Message()) ; Empty LinkedList (free Willy... oh no! Free memory)
ProcedureReturn RetCode
EndProcedure
Procedure.b Con_or_Win()
; Detects if the Programmcaller is the DOSconsole (=0) or Windows (=1)
; if exist the Environment Variable %Promt% then it is the DOSconsole
buff$ = Space(255)
If GetEnvironmentVariable_("PROMPT",@buff$,255) ; reading the Environment Variable %Promt%
ProcedureReturn 0 ; Called from Console
EndIf
FreeConsole_() ; free Willy... oh no the Console!
ProcedureReturn 1 ; Called from Windows true doublecklick or Start -> Run...
EndProcedure
Procedure MsgAdd(strString.s)
; Collect Rows for the Message
; (one Listelement = one Textrow)
AddElement(Message()) ; add Textrow to LinkedList
Message() = strString ;Fill the Text in LinkedList
EndProcedure
Procedure.b ask_console(Flags.l)
; Translate the Flags from the PB-MessageRequester in Consolen-notices
; (Like the PB-MessageRequester Flags to select the Displayed Buttons)
Select 15 & Flags ; Check the Bits (0000000000001111)
Case 1 ; Button_OK_Cancel
myPrintN("") ;Spacerow
myPrintN("Select:")
myPrintN("1 = OK")
myPrintN("2 = Cancel")
Case 2 ; Button_Abort_Retry_Ignor
myPrintN("") ;Spacerow
myPrintN("Select:")
myPrintN("3 = Abort")
myPrintN("4 = Retry")
myPrintN("5 = Ignore")
Case 3 ; Button_Yes_NO_Cancel
myPrintN("") ;Spacerow
myPrintN("Select:")
myPrintN("2 = Cancel")
myPrintN("6 = Yes")
myPrintN("7 = No")
Case 4 ; Button_Yes_No
myPrintN("") ;Spacerow
myPrintN("Select:")
myPrintN("6 = Yes")
myPrintN("7 = No")
Case 5 ; Button_Retry_Cancel
myPrintN("") ;Spacerow
myPrintN("Select:")
myPrintN("2 = Cancel")
myPrintN("4 = Retry")
Default
ProcedureReturn 0
EndSelect
; Check the User-Input
; When (Input_OK = 1 ) the User is right
myPrintN("") ;Spacerow
Input_OK.b = 0
While Input_OK = 0 ; as long as the User-Input is False
myPrint("Input:")
Input = Val(myInkey())
Select 15 & Flags ; Check bits (0000000000001111)
Case 1 ; Button_OK_Cancel
Select Input ; is the User right ?
Case #IDOK
Input_OK = 1
Case #IDCANCEL
Input_OK = 1
EndSelect
Case 2 ; Button_Abort_Retry_Ignor
Select Input; is the User right ?
Case #IDABORT
Input_OK = 1
Case #IDRETRY
Input_OK = 1
Case #IDIGNORE
Input_OK = 1
EndSelect
Case 3 ; Button_Yes_NO_Cancel
Select Input; is the User right ?
Case #IDYES
Input_OK = 1
Case #IDNO
Input_OK = 1
Case #IDCANCEL
Input_OK = 1
EndSelect
Case 4 ; Button_Yes_No
Select Input; is the User right ?
Case #IDYES
Input_OK = 1
Case #IDNO
Input_OK = 1
EndSelect
Case 5 ; Button_Retry_Cancel
Select Input; is the User right ?
Case #IDRETRY
Input_OK = 1
Case #IDCANCEL
Input_OK = 1
EndSelect
EndSelect
If Input_OK = 0
myPrintN("Input was wrong! Next try!")
EndIf
Wend
ProcedureReturn Input ; Returncode like PureBasic MessageRequester
EndProcedure
Procedure console_Icon(Flags.l)
; Translate the Flags from the PB-MessageRequester in Consolen-notices
; (Like the PB-MessageRequester Flags to select the ICON)
Select 240 & Flags ; check Bits (0000000011110000)
Case 16 ; ICON_Error
myPrintN("ERROR !") ; ICON as Text
Case 32 ; ICON_Question
myPrintN("QUESTION ?") ; ICON as Text
Case 48 ; ICON_Warning
myPrintN("WARNING !") ; ICON as Text
Case 64 ; ICON_Information
myPrintN("INFORMATION !") ; ICON as Text
EndSelect
EndProcedure
Procedure.b console_Modality(Flag.l)
; Translate the Flags from the PB-MessageRequester in Consolen-notices
; (Like the PB-MessageRequester Flags to select the Modality)
; DONT KNOW HOW THIS WORKS !!!!
Select 61440 & Flags ; check bits (1111000000000000)
Case 0 ; Application-Modal
;Code...
Case 4096 ; System-Modal
; Code .....
Case 8192 ; Task-Modal
; Code.....
EndSelect
EndProcedure
Procedure myPrint(Text.s)
; Print a Text to Console (Print) without End of Line
size.l=Len(Text)
bWritten.l
Text = mkEOL(Text,0) ; delete End of Line
stdout.l = GetStdHandle_(#STD_OUTPUT_HANDLE) ; Get Console Standart Out
size =Len(Text)
If stdout
WriteConsole_(stdout,@Text,size, @bWritten, #Null) ;Write to Console
EndIf
EndProcedure
Procedure myPrintN(strRow.s)
; Print a Row to Console (Print) witht End of Line
strRow = mkEOL(strRow,1) ;appand End of Line
stdout.l = GetStdHandle_(#STD_OUTPUT_HANDLE) ; Get Console Standart Out
If stdout
WriteConsole_(stdout,@strRow.s,Len(strRow.s),@retval,0);Write to Console
EndIf
EndProcedure
Procedure.s myInkey()
; Read Input from Console and wait for pressing Enter
stdin.l = GetStdHandle_(#STD_INPUT_HANDLE); Get Console Standart in
If stdin
oldmode.l
GetConsoleMode_(stdin,@oldmode) ; remember the old Console Settings
; Set new Console Settings, to work like Inkey
SetConsoleMode_(stdin,oldmode | #ENABLE_PROCESSED_INPUT)
input$=Space(256)
bRead.l
ReadConsole_(stdin,@input$,Len(input$), @bRead, #Null) ; read from Console
EndIf
ProcedureReturn input$ ; relay
EndProcedure
Procedure.s mkEOL(strRow.s,Flag.b)
;sort out existent End of Line ( Chr(13) + Chr(10) )
;if Flag = 1 then append End of Line ( Chr(13) + Chr(10) )
While Right(strRow,1) = Chr(10) Or Right(strRow,1) = Chr(13) ; erase Chr(13) or Chr(10)
size.l = Len(strRow)
strRow = Left(strRow,size-1) ; delete 1 Sign
Wend
If Flag = 1 ; append End of Line
strRow.s = strRow + Chr(13) + Chr(10); append End of Line
EndIf
ProcedureReturn strRow ; to hand on
EndProcedure
;*****************************
; Examples
;*****************************
;Call with multiple rows:
MsgAdd("That is a message")
MsgAdd("that runs in Windows ")
MsgAdd("or in Console")
MsgBox("Title of the Message","",0) ; Text must be empty !!! ("") !
; Like the Normal PB-MessageRequester
MsgBox("Title of the Message","Text of the Message",0)
;Call with multiple rows and Flags and Asking:
MsgAdd("That is a message")
MsgAdd("that runs in Windows ")
MsgAdd("or in Console")
Select MsgBox("Title of the Message","",#MB_ABORTRETRYIGNORE|#MB_ICONERROR) ; Text must be empty !!! ("") !
Case #IDABORT
; code to Abort
Case #IDRETRY
; code to Retry
Case #IDIGNORE
; code to Ignore
EndSelect Test it in Dos-Box an windows! Please!!!!