Posted: Thu Jan 25, 2007 11:39 pm
I've uploaded a new zip, nothing changed - just different size... (!!) 

http://www.purebasic.com
https://www.purebasic.fr/english/
DoubleDutch wrote:I've uploaded a new zip, nothing changed - just different size... (!!)
I don't understand.Am i the only one to have pb (see my previous post)
Possibly. Its not unicode compatible (yet).Also, the text seemed really garbled in the examples. Could this be because my Win OS is in Japanese?
I'll take a look at that over the weekend.I've tried the lib and noticed that I couldn't run the program with EnableExplicit on. Is this normal?
Code: Select all
#MyBlack=0
#MyBlue=1
#MyGreen=2
#MyCyan=3
#MyRed=4
#MyMagenta=5
#MyBrown=6
#MyLGrey=7
#MyGrey=8
#MyLBlue=9
#MyLGreen=10
#MyLCyan=11
#MyLRed=12
#MyLMagenta=13
#MyYellow=14
#MyWhite=15
Global FullScreen,FontH,FontW,RealFontH,FColour,BColour,mywindow,myfont,mysprite1,mysprite2,CursorX,CursorY,Intensity,CX,CY,DisplayChanged,Drawing,Flags
Global InitDB
Procedure GetColour(colour)
Select (colour & $f)
Case #MyBlack
rgb=RGB(0,0,0)
Case #MyBlue
rgb=RGB(0,0,180)
Case #MyGreen
rgb=RGB(0,180,0)
Case #MyCyan
rgb=RGB(0,180,180)
Case #MyRed
rgb=RGB(0,0,180)
Case #MyMagenta
rgb=RGB(180,0,180)
Case #MyBrown
rgb=RGB(180,180,0)
Case #MyLGrey
rgb=RGB(120,120,120)
Case #MyGrey
rgb=RGB(64,64,64)
Case #MyLBlue
rgb=RGB(64,64,255)
Case #MyLGreen
rgb=RGB(64,255,64)
Case #MyLCyan
rgb=RGB(64,255,255)
Case #MyLRed
rgb=RGB(255,64,64)
Case #MyLMagenta
rgb=RGB(255,64,255)
Case #MyYellow
rgb=RGB(255,255,64)
Case #MyWhite
rgb=RGB(255,255,255)
EndSelect
ProcedureReturn rgb
EndProcedure
Procedure GetTextHeight(hdc)
tm.textmetric
PrevMapMode=SetMapMode_(hdc,#MM_TEXT)
GetTextMetrics_(hdc,tm)
If PrevMapMode
SetMapMode_(hdc,PrevMapMode)
EndIf
ProcedureReturn tm\tmHeight
EndProcedure
Procedure XGlobalCloseConsole()
If mywindow
CloseWindow(mywindow)
mywindow=0
EndIf
If mysprite1
FreeSprite(mysprite1)
mysprite1=0
EndIf
If mysprite2
FreeSprite(mysprite2)
mysprite2=0
EndIf
CloseScreen()
If myfont
FreeFont(myfont)
myfont=0
EndIf
EndProcedure
Procedure CheckUpdateDisplay()
If DisplayChanged
Drawing=#True
DisplaySprite(mysprite1,0,0)
DisplayTranslucentSprite(mysprite2,CursorX,CursorY,Intensity)
FlipBuffers()
DisplayChanged=#False
Drawing=#False
EndIf
EndProcedure
Procedure MyWindowCallback(WindowID,Message,wParam,lParam)
Result=#PB_ProcessPureBasicEvents
If (Message=#WM_MOVE) Or (Message=#WM_SIZE) Or (Message=#WM_PAINT)
DisplayChanged=#True
EndIf
If Message=#WM_ERASEBKGND
Result=-1
EndIf
If DisplayChanged And Drawing=#False
DisplaySprite(mysprite1,0,0)
DisplayTranslucentSprite(mysprite2,CursorX,CursorY,Intensity)
FlipBuffers()
DisplayChanged=#False
EndIf
ProcedureReturn Result
EndProcedure
Procedure XGlobalOpenConsole(OpenX,OpenY,OpenW,OpenH,Name$)
XGlobalCloseConsole()
result=0
myfont=LoadFont(#PB_Any,"Terminal",FontH,#PB_Font_HighQuality)
If myfont
If InitSprite()
mywindow=OpenWindow(#PB_Any,OpenX,OpenY,OpenW,OpenH,Name$,Flags)
If mywindow
If OpenWindowedScreen(WindowID(mywindow),0,0,40,40,#True,0,0)
hdc=StartDrawing(WindowOutput(mywindow))
DrawingFont(FontID(myfont))
FontW=TextWidth(" ")
RealFontH=TextHeight(" ")
StopDrawing()
CloseScreen()
Else
FontW=8
RealFontH=8
EndIf
SizeX=(CX*FontW)+(FontW/2)
SizeY=(CY*RealFontH)+(RealFontH/2)
If OpenWindowedScreen(WindowID(mywindow),0,0,SizeX,SizeY,#True,0,0)
mysprite1=CreateSprite(#PB_Any,SizeX,SizeY,#PB_Sprite_Texture) ; screen sprite
If mysprite1
mysprite2=CreateSprite(#PB_Any,FontW,RealFontH,#PB_Sprite_Texture) ; cursor sprite
If mysprite2
StartDrawing(SpriteOutput(mysprite2))
Box(0,0,FontW,RealFontH,RGB(255,255,255))
StopDrawing()
Drawing=#False
SetWindowCallback(@MyWindowCallback(),mywindow)
result=mywindow ; all has passed test!
FullScreen=#False
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
If result=0
XGlobalCloseConsole()
EndIf
ProcedureReturn result
EndProcedure
Procedure XFullOpenConsole(OpenX,OpenY,OpenD,FontN$,FontD,Name$)
XGlobalCloseConsole()
result=0
myfont=LoadFont(#PB_Any,FontN$,FontD)
If myfont
If InitSprite()
If InitKeyboard()
If OpenScreen(OpenX,OpenY,OpenD,Name$)
hdc=StartDrawing(ScreenOutput())
DrawingFont(FontID(myfont))
FontW=TextWidth(" ")
RealFontH=GetTextHeight(hdc)
StopDrawing()
CX=OpenX/FontW
CY=OpenY/RealFontH
SizeX=(CX*FontW)+(FontW/2)
SizeY=(CY*RealFontH)+(RealFontH/2)
mysprite1=CreateSprite(#PB_Any,SizeX,SizeY,#PB_Sprite_Texture) ; screen sprite
If mysprite1
mysprite2=CreateSprite(#PB_Any,FontW,RealFontH,#PB_Sprite_Texture) ; cursor sprite
If mysprite2
StartDrawing(SpriteOutput(mysprite2))
Box(0,0,FontW,RealFontH,RGB(255,255,255))
StopDrawing()
Drawing=#False
result=#True ; all has passed test!
FullScreen=#True
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
If result=0
XGlobalCloseConsole()
EndIf
ProcedureReturn result
EndProcedure
Procedure XGlobalPrint(string$)
If myfont
Drawing=#True
StartDrawing(SpriteOutput(mysprite1))
BackColor(RGB(BColour,BColour,BColour))
FrontColor(RGB(FColour,FColour,FColour))
DrawingFont(FontID(myfont))
DrawText(CursorX,CursorY,string$)
StopDrawing()
Drawing=#False
CursorX+(Len(string$)*FontW)
DisplayChanged=#True
EndIf
EndProcedure
Procedure XGlobalConsoleColor(colour1,colour2)
BColour=GetColour(colour2)
FColour=GetColour(colour1)
EndProcedure
Procedure XGlobalClearConsole()
If myfont
Drawing=#True
StartDrawing(SpriteOutput(mysprite1))
Box(0,0,(CX+1)*FontW,(CX+1)*RealFontH,BColour)
StopDrawing()
Drawing=#False
CursorX=0
CursorY=0
DisplayChanged=#True
EndIf
EndProcedure
Procedure.s XGlobalInkey()
CheckUpdateDisplay()
Ascii$=""
Ascii2$=""
Delay(1) ; use a 1 millisecond delay, because not using WaitWindowEvent()!!!
If FullScreen
ExamineKeyboard()
Ascii$=KeyboardInkey()
If Ascii$=""
If KeyboardReleased(#PB_Key_Back)
Ascii$=Chr(#BS)
EndIf
If KeyboardReleased(#PB_Key_Return)
Ascii$=Chr(#CR)
EndIf
If KeyboardReleased(#PB_Key_PadEnter)
Ascii$=Chr(#CR)
EndIf
EndIf
Else
EventID=WindowEvent()
Select EventID
Case #WM_KEYDOWN
Ascii2$=Chr(EventwParam()-53) ; convert function keys to the same as that produced by inkey function
Case #WM_CHAR
Ascii$=Chr(EventwParam()) ; hack to get windows key
Case #PB_Event_CloseWindow
End
EndSelect
EndIf
If Ascii$=""
If Ascii2$<>""
Ascii$=Chr($ff)+Ascii2$
EndIf
Else
Ascii$=Ascii$+Chr($ff)
EndIf
ProcedureReturn Ascii$
EndProcedure
ProcedureDLL XClearConsole()
XGlobalClearConsole()
EndProcedure
ProcedureDLL XOpenConsole()
Flags=#PB_Window_TitleBar|#PB_Window_SystemMenu|#PB_Window_BorderLess|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget
CX=80
CY=25
FontH=24
Intensity=128
result=XGlobalOpenConsole(50,50,640,480,"ConsoleX")
XGlobalConsoleColor(#MyWhite,#MyBlack)
XGlobalClearConsole()
ProcedureReturn result
EndProcedure
ProcedureDLL XOpenConsole2(sizex,sizey)
Flags=#PB_Window_TitleBar|#PB_Window_SystemMenu|#PB_Window_BorderLess|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget
CX=sizex
CY=sizey
FontH=24
Intensity=128
result=XGlobalOpenConsole(50,50,640,480,"ConsoleX")
XGlobalConsoleColor(#MyWhite,#MyBlack)
XGlobalClearConsole()
ProcedureReturn result
EndProcedure
ProcedureDLL XOpenConsole3(sizex,sizey,sized,fontname$,fontsize,title$)
Itensity=128
result=XFullOpenConsole(sizex,sizey,sized,fontname$,fontsize,title$)
XGlobalConsoleColor(#MyWhite,#MyBlack)
XGlobalClearConsole()
ProcedureReturn result
EndProcedure
ProcedureDLL XOpenConsole4(sizex,sizey,x,y,w,h,title$)
Flags=#PB_Window_TitleBar|#PB_Window_SystemMenu|#PB_Window_BorderLess|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget
CX=sizex
CY=sizey
FontH=24
Intensity=128
result=XGlobalOpenConsole(x,y,w,h,title$)
XGlobalConsoleColor(#MyWhite,#MyBlack)
XGlobalClearConsole()
ProcedureReturn result
EndProcedure
ProcedureDLL XOpenConsole5(sizex,sizey,x,y,w,h,title$,Flgs)
Flags=Flgs
CX=sizex
CY=sizey
FontH=24
Intensity=128
result=XGlobalOpenConsole(x,y,w,h,title$)
XGlobalConsoleColor(#MyWhite,#MyBlack)
XGlobalClearConsole()
ProcedureReturn result
EndProcedure
ProcedureDLL XCloseConsole()
XGlobalCloseConsole()
EndProcedure
ProcedureDLL XConsoleColor(fgnd,bgnd)
XGlobalConsoleColor(fgnd,bgnd)
EndProcedure
ProcedureDLL XPrint(string$)
XGlobalPrint(string$)
EndProcedure
ProcedureDLL XPrintN(string$)
XGlobalPrint(string$)
CursorX=0
CursorY+RealFontH
EndProcedure
ProcedureDLL XConsoleLocate(x,y)
CursorX=x*FontW
CursorY=y*RealFontH
DisplayChanged=#True
EndProcedure
ProcedureDLL XConsoleTitle(string$)
If mywindow ; keep as mywindow for the time being
SetWindowTitle(mywindow,string$)
EndIf
EndProcedure
ProcedureDLL.s XInkey()
Ascii$=XGlobalInkey()
ProcedureReturn Ascii$
EndProcedure
ProcedureDLL.s XInput()
string$=""
Done=#False
Repeat
Ascii$=XGlobalInkey()
If Ascii$>""
Ascii$=Left(Ascii$,1)
If Ascii$<>Chr($ff)
Select Ascii$
Case Chr(#CR)
Done=#True
Case Chr(#BS)
If string$<>""
string2$=Left(string$,Len(string$)-1)
string$=string2$
CursorX-FontW
XGlobalPrint(" ")
CursorX-FontW
EndIf
Default
XGlobalPrint(Ascii$)
string$+Ascii$
EndSelect
EndIf
EndIf
Until Done
ProcedureReturn string$
EndProcedure
ProcedureDLL XConsoleCursor(size)
EndProcedure
ProcedureDLL XDelay(time)
CheckUpdateDisplay()
If time<2
time=2
EndIf
For n=1 To time/2
Delay(1) ; use a 1 millisecond delay, because not using WaitWindowEvent()!!!
If FullScreen=0
EventID=WindowEvent()
Select EventID
Case #PB_Event_CloseWindow
End
EndSelect
EndIf
Next
EndProcedure
ProcedureDLL XGetConsoleCX()
ProcedureReturn CX
EndProcedure
ProcedureDLL XGetConsoleCY()
ProcedureReturn CY
EndProcedure
ProcedureDLL XSetConsoleColorF(colour)
FColour=colour
EndProcedure
ProcedureDLL XSetConsoleColorB(colour)
BColour=colour
EndProcedure
Code: Select all
; ConsoleX test
; This example is a modified version of the example given with purebasic
IncludeFile "XConsole.pbi"
;
text$="Feel the Power of PureBasic!" ; just a small text$ string
dlay=4000 ; delay will set to 4000
;
;-------- Open our Console --------
;
XOpenConsole() ; First we must open a console
XConsoleTitle("PureBasic - Console Example:") ; Now we can give the opened console a Titlename ;)
;
;-------- Ask and display the UserName --------
;
XConsoleLocate(18,12) ; x y position
XPrint("Please enter your name:") ; Ask for name
name$=XInput() ; Wait for user input
XClearConsole() ; This will clean the ConsoleScreen
XConsoleLocate(24,10) ; x y position
XPrintN("Welcome "+name$) ; Print our text and the UserName
XConsoleLocate (24,12) ; x y position
XPrintN (text$) ; Print our text
XDelay(dlay) ; Waits for moment
;
;-------- Cls and Cycle the Text-BG-Color 0 to 15 --------
;
XClearConsole() ; This will clean the ConsoleScreen
; Info: Standard colors are (8 for text, 0 for backround)
For i = 0 To 15
XConsoleColor(0,i) ; Change BackGround text color (max 15) in every loop
XConsoleLocate(24,4+i) ; x y position
XPrint(text$) ; Print our text
Next i
XDelay(dlay) ; Waits for moment
;
;-------- Cls and Cycle the Text-FG-Color 0 to 15 --------
;
XConsoleColor(0,0) ; Set back to black (0,0) for complete background...
XClearConsole() ; This will clean the ConsoleScreen
; Info: Standard colors are (8 for text, 0 for backround)
For i = 0 To 15
XConsoleColor(i,0) ; Change ForGround text color (max 15) in every loop
XConsoleLocate(24,4+i) ; x y position
XPrint(text$) ; Print our text
Next i
XDelay(dlay) ; Waits for moment
;
;-------- Cls and Cycle the Background-Color 0 to 15 --------
;
For a = 1 To 15
XConsoleColor(a,a) ; Cycle background color...
XClearConsole() ; This will clean the ConsoleScreen
; Info: Standard colors are (8 for text, 0 for backround)
For i = 0 To 15
XConsoleColor(i,a) ; Change ForGround text color (max 15) in every loop
XConsoleLocate(24,4+i) ; x y position
XPrint(text$) ; Print our text
Next i
;
XDelay(dlay/10) ; Waits for moment
Next a
;-------- Exit --------
XCloseConsole()
Code: Select all
Procedure XGlobalCloseConsole()
If mywindow
CloseWindow(mywindow)
mywindow=0
EndIf
If mysprite1
FreeSprite(mysprite1)
mysprite1=0
EndIf
If mysprite2
FreeSprite(mysprite2)
mysprite2=0
EndIf
;Is this unnecessary?
;--------------------> CloseScreen()
If myfont
FreeFont(myfont)
myfont=0
EndIf
EndProcedure