Ich würde gerne folgenden Code auf Linux/Mac portieren aber es läuft leider nicht wie ich dachte. Ich verwende alte PB Internals, um auf den Keyboard Buffer direkt zuzugreifen. Bei Windows 32/64 Bit ist die Syntax leicht verschieden (ein Unterstrich bei der Variable), aber wie es bei den anderen Platformen aussieht ist mir vollkommen unbekannt (leider). Vielleicht kann mir jemand helfen: siehe GetKeyboardBuffer().
Was dieser Code kann:
- Anschlagswiederholung mit einstellbarer Wiederholrate und Verzögerung
- zusätzlicher KeyboardHit() Befehl (Erster oder "wiederholter" Anschlag wenn Taste länger gedrückt wird)
- KeyboardInkey() reagiert dadurch sofort auf den Anschlag, und nicht erst wenn eine Taste losgelassen wurde
- keine Windows API (hoffentlich portierbar)
Das macht eine Fullscreen GUI bzw. das Text eintippen etwas intuitiver und flüssiger. Allerdings funktioniert das nur weil gedrückte Tasten "unterdrückt" bzw. ab dem nächsten Frame "losgelassen" werden, daher sollte man das nur während einer Texteingabe (z.B. im EditorGadget3D, Hiscores oder Game Console wenn KeyboardInkey() benutzt wird) nutzen und nicht wenn man durchgehend gedrückte Tasten für sein Programm braucht (z.B. wenn Cursor Tasten eine Spielfigur steuern sollen).
ExamineKeyboard2(Bool) - Wenn #True dann wird die Anschlagswiederholung genutzt, wenn #False gilt normales PB Verhalten.
Mit Anschlagswiederholung könnt Ihr durch einen langen Text schneller durch-scrollen z.B., wenn ihr die Bild auf/ab Tasten gedrückt haltet, oder schneller Text löschen mit Backspace etc. Daher liegt auch ein kleiner Demo Code bei, der aber auch nicht perfekt ist (wenn der Cursor ausserhalb des Sichtfeldes liegt, Bild auf/ab benutzen oder das Mausrad benutzen; man kann nicht mit Cursor Tasten durch den Text navigieren etc. geht um den Anschlag und nicht um ein voll funktionsfähigen EditorGadget Ersatz). Einfach die Backspace Taste gedrückt halten wenn die Demo startet oder Text eingeben wie ihr es gewohnt seit, "klimpern"...
Code: Alles auswählen
; Keyboardbuffer lib ex
; =====================
;
; KeyboardBufferRelease.pb
;
; (c) benubi, 2010-2012,2020-2022
; --------------------------
;
;
;
; IntitKeyboard2(ReleaseTime,RepeatTime) ; initialize Keyboard. Releasetime (first hit)=time between first key stroke and repeat. RepeatTime=time between simulated key stroke repetitions
;
; ExamineKeyboard2(boolRelease) ; if #True will release keys, if #False it won't change anything (normal ExamineKeyboard())
;
; KeyboardHit(#PB_Key_*) ; checks if the key has been hit "for the first time" or is "repeatedly" hit. ExamineKeyboard2(#True) must be called first
;
; ReleaseKeyboardKeys(ReleaseDelay, RepeatDelay) ; This procedure will be called internaly.
EnableExplicit
#Keyboard_Max = 256
Dim _Keyboard_LastPressed.i(#Keyboard_Max) ; Array enthält Zeitstempel für jede gedrückte Taste
Define _KeyboardReleaseTime,_KeyboardRepeatTime
Structure __KeyboardBuffer
B.B[#Keyboard_Max]
EndStructure
; GetKeyboardBuffer() :
Procedure.i GetKeyboardBuffer() ; Returns a pointer to the current PureBasic KeyboardBuffer (256 Bytes)
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
!extrn _PB_Keyboard_KeyboardBuffer
!MOV DWORD EAX, _PB_Keyboard_KeyboardBuffer
CompilerElseIf #PB_Compiler_Processor = #PB_Processor_x64
!extrn PB_Keyboard_KeyboardBuffer
!MOV QWORD RAX, PB_Keyboard_KeyboardBuffer
CompilerEndIf
ProcedureReturn
EndProcedure
; ReleaseKeyboardKeys(ReleaseDelay,RepeatDelay) : time must be in ms
; must be called after ExamineKeyboard(). Has effect on KeyboardInkey(), KeyboardPushed(), KeyboardReleased(), Keyboardhit()
Procedure.i ReleaseKeyboardKeys(ReleaseDelay.i,RepeatDelay.i) ; Release keys after Release-Delay, Repeat release after Repeat-Delay
Protected *Buffer.__KeyboardBuffer
Protected e.i,i.i,rld.i,rpd.i
Shared _Keyboard_LastPressed.i()
*Buffer = GetKeyboardBuffer()
If ReleaseDelay<=0
Repeat
_Keyboard_LastPressed(i)=0
i=i+1
Until i>=#Keyboard_Max
ReleaseDelay=1000
EndIf
If RepeatDelay<=0
RepeatDelay=1
EndIf
If *Buffer
e=ElapsedMilliseconds()
rpd = e+RepeatDelay
rld = e+ReleaseDelay
i=0
Repeat
If *Buffer\b[i] ;*Buffer\b[i]
; ---------------------- PRESSED KEYS
If _Keyboard_LastPressed(i)=0
_Keyboard_LastPressed(i)=-1 ; first hit
ElseIf _Keyboard_LastPressed(i)=-1
_Keyboard_LastPressed(i)=rld
*Buffer\B[i]=1
ElseIf _Keyboard_LastPressed(i)=-2
_Keyboard_LastPressed(i)=rpd
*Buffer\B[i]=1
ElseIf _Keyboard_LastPressed(i) <= e ; force release
_Keyboard_LastPressed(i)=-2 ; repeat delay
; Debug "repeat start (pressed)"+Str(i)
Else
*Buffer\b[i]=0
EndIf
; -------------------- NOT PRESSED KEYS
ElseIf _Keyboard_LastPressed(i)>0
_Keyboard_LastPressed(i) = 0
ElseIf _Keyboard_LastPressed(i)=-1 ; process first hit (release)
_Keyboard_LastPressed(i)=0;rld
ElseIf _Keyboard_LastPressed(i)=-2 ; process repeat hit (release)
_Keyboard_LastPressed(i)=0;rpd
Else
_Keyboard_LastPressed(i) = 0
EndIf
i=i+1
Until i>=#Keyboard_Max
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
; KeyboardHit(#PB_Key) : returns 1 on first keyboard "hit" for #PB_Key or 0
Procedure KeyboardHit(Key) ; Keyboard first hit, returns 1 if first hit or 0 if not pushed/already pushed last frame
Shared _Keyboard_LastPressed.i()
If key<0 Or key>=#Keyboard_Max
ProcedureReturn 0 ; invalid
ElseIf _Keyboard_LastPressed(Key)=-1 ;first hit
ProcedureReturn 1
Else
ProcedureReturn 0 ; no first hit
EndIf
EndProcedure
Procedure.i ExamineKeyboard2(Release) ; release: #True to release keys (key stroke repetition), #False: PureBasic default
Shared _KeyboardReleaseTime,_KeyboardRepeatTime
Protected result
result=ExamineKeyboard()
If release And result
ReleaseKeyboardKeys(_KeyboardReleaseTime,_KeyboardRepeatTime)
EndIf
ProcedureReturn result
EndProcedure
; InitKeyboardEx() wrapper procedure to use the original keyboard lib
Procedure InitKeyboard2(ReleaseTime,RepeatTime) ; ReleaseTime=Delay until first repetition -- RepeatTime=Delay between key repetitions
Shared _KeyboardReleaseTime,_KeyboardRepeatTime
_KeyboardReleaseTime=ReleaseTime
_KeyboardRepeatTime=RepeatTime
ProcedureReturn InitKeyboard()
EndProcedure
CompilerIf #PB_Compiler_IsMainFile
; =============================================================================================
; ----------- Demo
;
Dim _BorderColor(2)
_BorderColor(0) = $EEEEEE
_BorderColor(1) = $202020
Dim _ElemColor.i(8)
_ElemColor(0)=$8070A0
_ElemColor(1)=$AABBCC
_ElemColor(2)=$A0B0C0
_ElemColor(3)=$A0B0F0
_ElemColor(4)=$808080
Dim _TxtColor.i(8)
_TxtColor(0)=$8F8F
_TxtColor(1)=$FFFF
_TxtColor(2)=$EEEE
_TxtColor(3)=$FFFF
_TxtColor(4)=$8F8F
Procedure WordWidth(*C.Character,*Len.Integer,Limit$)
Protected totalWidth
Protected len,*Z.Character
If limit$=""
limit$=" "+#TAB$+#CRLF$
EndIf
If *C
While *C\c
*Z = @Limit$
While *Z\c
If *Z\c = *C\c
Break 2
EndIf
*Z = *Z + SizeOf(Character)
Wend
totalWidth = totalWidth + TextWidth(Chr(*C\c))
len = len + 1
*C = *C +SizeOf(Character)
Wend
If *C\c And len=0
len=1
totalWidth=TextWidth(Chr(*C\c))
EndIf
If *len
*len\i=len
EndIf
EndIf
ProcedureReturn totalWidth
EndProcedure
Procedure DrawBorder(x,y,width,height,type=0,color1=-1,color2=-1)
Shared _BorderColor()
Select type
Case 0
; normal
LineXY(x,y,x+width,y,_BorderColor(0)) ; top
LineXY(x,y,x,y+height,_BorderColor(0)) ; left
LineXY(x+width,y,x+width,y+height,_BorderColor(1)) ; right
LineXY(x,y+height,x+width,y+height,_BorderColor(1)) ; bottom
Case 1
; inverted (sunken)
LineXY(x,y,x+width,y,_BorderColor(1)) ; top
LineXY(x,y,x,y+height,_BorderColor(1)) ; left
LineXY(x+width,y,x+width,y+height,_BorderColor(0)) ; right
LineXY(x,y+height,x+width,y+height,_BorderColor(0)) ; bottom
Case 2
; etched
LineXY(x,y,x+width,y,_BorderColor(0)) ; top
LineXY(x,y,x,y+height,_BorderColor(0)) ; left
LineXY(x+width,y,x+width,y+height,_BorderColor(1)) ; right
LineXY(x,y+height,x+width,y+height,_BorderColor(1)) ; bottom
LineXY(x+1,y,x+width-2,y,_BorderColor(1)) ; top
LineXY(x+1,y,x,y+height-2,_BorderColor(1)) ; left
LineXY(x+width-2,y,x+width-2,y+height-2,_BorderColor(0)) ; right
LineXY(x+1,y+height,x+width,y+height-2,_BorderColor(0)) ; bottom
EndSelect
EndProcedure
Procedure.i DrawButton(Y,X,Width,Height,Text$,Flags=0,textcolor=-1,backgroundcolor=-1)
Shared _ElemColor(),_TxtColor(),_BorderColor()
Protected twidth,theight,halfwidth,halfheight
Flags = Flags & 7
If textcolor=-1
textcolor=_TxtColor(Flags)
EndIf
If backgroundcolor = -1
backgroundcolor=_ElemColor(Flags)
EndIf
Box(x,y,width,height,backgroundcolor)
twidth=TextWidth(Text$)
tHeight=TextHeight(Text$)
halfwidth = (width - x)/2
halfheight= (height- y)/2
DrawText(2+x-halfwidth,2+y-halfheight,Text$,_BorderColor(1))
DrawText(x-halfwidth,y-halfheight,Text$,textcolor)
EndProcedure
Procedure$ LoadText(FileName$,Type=#PB_Ascii)
Protected fh,result$,len
fh=ReadFile(-1,FileName$)
If fh
result$=""
While Not Eof(fh)
result$=result$+ReadString(fh,Type)+#CR$
Wend
CloseFile(fh)
EndIf
ProcedureReturn result$
EndProcedure
Procedure.i DrawTextMultiLine(x,y,Text$,width,height,StartLine=0,Flags=0,*rX.Integer=0,*rY.Integer=0)
Protected *C.Character
Protected tx,ty,dx,dy,xmax,ymax,ly,nowrap,makeborder,wmax,processFullWord
Protected iWordLen,iWordWidth,i,chr$
*C=@Text$
ly=TextHeight("M")
ymax=height+y
xmax=width+x
While *C\c And StartLine>0
While *C\c <> 13 And *C\c
*C=*C+SizeOf(Character)
Wend
If *C\c = 13
Startline=StartLine-1
*C=*C+SizeOf(Character)
EndIf
Wend
makeborder = Flags & 1
nowrap = Flags & 2
If makeborder
LineXY(xmax,y,xmax,ymax,$222222)
LineXY(x,ymax,xmax,ymax,$222222)
LineXY(x,y,x,ymax,$bbbbbb)
LineXY(x,y,xmax,y,$bbbbbb)
x=x+2
xmax=xmax-2
y=y+2
ymax=ymax-2
EndIf
tx=x
ty=y
wmax=xmax-x
ymax=ymax-ly
While *C\c
If ty>ymax
Break
EndIf
dx=WordWidth(*C,@iWordLen,"")
If dx>wmax Or iWordLen=1
processFullWord=1 ; draw word character by character
ElseIf dx+tx>xmax
If nowrap = 0
processFullWord=2 ; draw on next line
Else
processFullWord=1
EndIf
Else
processFullWord=0 ; draw full word
EndIf
Select processFullWord
Case 0
; draw full
DrawText(tx,ty,PeekS(*C,iWordLen))
tx = tx + dx
If tx>xmax
tx=x
ty=ty+ly
If ty>ymax
Break
EndIf
EndIf
*C = *C + (iWordLen*SizeOf(Character))
Continue
Case 2
; draw on next line
ty = ty + ly
If ty>ymax
Break
EndIf
DrawText(x,ty,PeekS(*C,iWordLen))
tx = x +dx
*C = *C +(iWordLen * SizeOf(Character))
Continue
Case 1
i=0
While i<iWordLen
chr$=PeekS(*C,1)
dx=TextWidth(Chr$)
; dy=TextHeight(Chr(*C\c))
If nowrap
If *C\c=13
ty=ty+ly
tx=x
EndIf
ElseIf tx+dx>xmax Or *C\c = 13
ty=ty+ly
tx=x
EndIf
If *c\c>=32
If tx+dx<=xmax
DrawText(tx,ty,chr$)
EndIf
tx=tx+dx
EndIf
If tx+dx>xmax And nowrap=0
ty=ty+ly
tx=x
EndIf
i=i+1
*C=*C+SizeOf(Character)
Wend
Continue
Default
Debug "ERROR"
EndSelect
Wend
If *rX
*rX\i = tx
EndIf
If *rY
*ry\i = ty
EndIf
i=i+1
ProcedureReturn ((tx & $FFFF) | ((ty & $FFFF) << 16))
EndProcedure
Procedure OpenDesktopSizedScreen(Title$="PureBasic")
Protected w,h,d,f
If ExamineDesktops()
w = DesktopWidth(0)
h = DesktopHeight(0)
d = DesktopDepth(0)
f = DesktopFrequency(0)
ProcedureReturn OpenScreen(w,h,d,Title$,#PB_Screen_NoSynchronization,f)
EndIf
EndProcedure
DisableExplicit
If InitSprite() And InitKeyboard2(700,10) And InitMouse() And OpenDesktopSizedScreen("KeyboardBufferRelease")
KeyboardMode(#PB_Keyboard_International)
StartLine.i=0
TextMode.i=1
cd.i=128
dir.i=1
xypos.i=0
FullText$=""
inkey$=""
LoadFont(0,"Arial",16)
FullText$ = LoadText(#PB_Compiler_File)
StartLine=CountString(FullText$,#CR$)-15
CreateSprite(1,16,16)
If StartDrawing(SpriteOutput(1))
; mouse-sprite
Line(1,1,8,4,$8f8f8f)
Line(1,1,4,8,$8f8f8f)
Line(1,1,14,14,$8f8f8f)
StopDrawing()
TransparentSpriteColor(1,0)
EndIf
If StartLine<0:StartLine=0:EndIf
Repeat
If IsScreenActive()
FlipBuffers()
ClearScreen(RGB(0, 0, 0))
ExamineKeyboard2(#True)
;ReleaseKeyboardKeys(500,10) ; Zeichenpuffer vorbearbeiten
inkey$=KeyboardInkey()
If inkey$<>Chr(#BS) And inkey$<>Chr(13); Wenn nicht Backspace
FullText$ = FullText$ + inkey$ ; fügt das nächste Zeichen zum aktuellen Text (sofern vorhanden) hinzu
Else
; FullText$ = Left(FullText$,Len(FullText$)-1)
EndIf
If KeyboardReleased(#PB_Key_F1)
TextMode=TextMode+1
If TextMode>3
TextMode=0
EndIf
EndIf
If KeyboardHit(#PB_Key_F2)
FullText$=""
StartLine=0
EndIf
If KeyboardReleased(#PB_Key_Home)
StartLine=0
EndIf
If KeyboardReleased(#PB_Key_End)
StartLine=1+CountString(FullText$,#CR$)-(480/16)
EndIf
If KeyboardReleased(#PB_Key_Return) Or KeyboardReleased(#PB_Key_PadEnter); wird nicht "wiederholt" wegen KeyboardHit()
Fulltext$=FullText$+Chr(13)
EndIf
If (KeyboardReleased(#PB_Key_PageUp) Or MouseWheel()>0) And StartLine > 0 ; Hoch-scrollen
Startline=StartLine-1
If StartLine<0:StartLine=0:EndIf
EndIf
If (KeyboardReleased(#PB_Key_PageDown) Or MouseWheel()<0) ; Runter-Scrollen
If StartLine<CountString(FullText$,Chr(13))
Startline=StartLine+1
EndIf
EndIf
; Wenn wir die 'Backspace'-Taste drücken, löschen wir das letzte Zeichen
;
If KeyboardReleased(#PB_Key_Back) Or KeyboardReleased(#PB_Key_Delete) Or inkey$=Chr(#BS); Rück-Taste
FullText$ = Left(FullText$, Len(FullText$)-1)
EndIf
; Ergebnis darstellen
;
If StartDrawing(ScreenOutput())
If IsFont(0)
DrawingFont(FontID(0))
EndIf
DrawingMode(1)
If IsFont(0)
DrawingFont(FontID(0))
EndIf
FrontColor(RGB(128, 255, 0))
DrawTextMultiLine(20, 20, "ESC zum beenden F1 - Textmodus ändern F2 - Text löschen"+#CRLF$+"Tasten gedrückt lassen, für Release-Effekt. Rück-,Bildauf/-ab,Eingabe-Tasten:"+#CRLF$,740,80)
cd=cd+dir
If cd>255
cd=255
dir=-1
ElseIf cd<128
cd=128
dir=1
EndIf
FrontColor(RGB(cd,cd,cd))
Box(40,80,720,460,RGB(64,64,96))
xypos=DrawTextMultiLine(40, 80, FullText$,720,460,StartLine,TextMode,@rx.i,@ry.i)
b=b+7
If b>=512
b=0
c=0
ElseIf b>255
c=511-b
Else
c=b
EndIf
DrawText(rx ,ry,"_",RGB(c,c,0))
DrawText(0,0,"xypos x="+Str(rx)+" y="+Str(ry)+" Textlength:"+Str(Len(FullText$))+" Startline:"+Str(StartLine),$FF)
If ry>570
StartLine=StartLine+1
EndIf
StopDrawing()
ExamineMouse()
DisplayTransparentSprite(1,MouseX(),MouseY())
EndIf
EndIf
Until KeyboardPushed(#PB_Key_Escape) Or (MouseButton(1) And MouseX()<10 And MouseY()<10)
EndIf
CompilerEndIf