ntvgjhfnj | Дата: Четверг, 06.07.2023, 08:36 | Сообщение # 1 |
Лейтенант
Группа: Проверенные
Сообщений: 61
Статус: Offline
| Жуткая задержка при опросе клавиатуры ...
Код
Dim Shared As Integer mx, my, mz, mb, omb Dim Shared As String key, s, s2, ok
Sub se() Var key_ = InKey Select Case Asc(key_) Case 32 To 255 s += key_ End Select End Sub
' ScreenRes 800, 600, 32, 2 ScreenSet 1, 0 Color RGB(255, 128, 0), &H666666 Cls '[ -- Label_frame text animation -- Var tic = 0.1 Var tici = .4 Var tic_text = 0 ']
Do omb = mb GetMouse(mx, my, mz, mb)
If ( Timer >= tic) Then If tic_text >= 20 Then tic_text = 0 Else tic_text +=1 tic = Timer + tici EndIf key = InKey se() Select Case Asc(key) Case 32 To 255 s2 += key End Select
screenlock Cls Draw String (10,10), s Draw String (10,30), s2 Draw String ( tic_text * 20, 320), "Animate text" ScreenUnLock
ok = key Sleep 1 Flip Loop Until MultiKey(&H01) Or InKey = Chr(255)+"k" While InKey <> "": Wend End
Собственно нужно для interBox без прерывания цыкла
Код /' input_box.bi '/
#Undef __MAIN__ #Define __MAIN__ 1 #If __MAIN__ Dim Shared As Integer mx, my, mz, mb, omb Const MYWHITE = RGB(255,255,255) Const MYGREY = RGB(128,128,228) Const MYDARKGREY2 = RGB(100,100,100) Const MYBLACK = RGB(0,0,0) #EndIf
#Undef midle #Define midle( Out_x, Out_Width, in_Width) ( (Out_x) + ( (Out_Width) - (in_Width)) / 2)
#Undef MB_LEFT #Define MB_LEFT 1
#Undef UP #define UP 0 #Undef OVER #define OVER 1 #Undef DOWN #define DOWN 2 #Undef HIT #define HIT 3 #Undef ENABLE #define ENABLE 4
'#Undef LEFTE '#define LEFTE 0 '#Undef CENTERE '#define CENTERE 1 '#Undef RIGHTE '#define RIGHTE 2
Type InputBox As Integer _ x,_ y,_ w,_ h,_ bg(5),_ fg,_ bc,_ over_color
As boolean _ hasMouse,_ fixMouse,_ enabled,_ ' Ëîãè÷åñêîå çíà÷åíèå, êîòîðîå îïðåäåëÿåò, âêëþ÷åíà ëè êíîïêà. toggle,_ visible
As String _ text,_ defaultText
As ULong _ textAlign ' Âûðàâíèâàíèå òåêñòà ( LEFT, CENTER , RIGHT)
Declare Constructor() Declare Constructor( x As Integer, y As Integer, w As Integer, text As string = "", defaultText As String = "") Declare Function event( old_mouse_button As Integer = 0) As integer Declare Sub drawing() Declare Sub edit() Declare Function sendText( source_text_delete As boolean = false) As string
Private: As String _ txt
As ULong _ state
As Integer _ caret,_ textStartAt,_ max_char,_ posX
Declare Sub moveCaretLeft() Declare Sub moveCaretRight( txt_ As String = "") End Type
Sub InputBox.moveCaretLeft() If caret = 0 Then textStartAt -= 1 If textStartAt < 1 Then textStartAt = 1 Else caret -= 1 EndIf End Sub
Sub InputBox.moveCaretRight( txt_ As String = "") Var lenText = len(txt_) If caret = max_char Then If (caret + textStartAt) - lenText < 1 Then textStartAt += 1 If lenText < 1 Then textStartAt = 1 Else If ( lenText > 0) And (caret < lenText) Then caret += 1 ' If max_column > 0 Then End If End Sub
Function InputBox.sendText( source_text_delete As boolean = false) As string Dim As String send_text = text If source_text_delete Then text = "" return send_text End Function
Function InputBox.event( old_mouse_button As Integer = 0) As Integer Dim As Integer res = 0, btn_, x_, y_ GetMouse(x_, y_, , btn_)
If visible Then With This If enabled Then .state = ENABLE Else If x_ >= .x And y_ >= .y And x_<=(.x + .w) And y_ <= (.y + .h) Then If ((btn_ And (MB_LEFT))<> 0) Then .state = DOWN .HasMouse = TRUE .fixMouse = true 'res = 1 'return 1 Else If (((old_mouse_button And Not btn_) And (MB_LEFT))<>0) Then '.fixMouse = Not .fixMouse state = DOWN .HasMouse = TRUE return 1 Else .state = OVER .HasMouse = TRUE EndIf EndIf ElseIf .hasMouse Then 'If .fixMouse Then .state = DOWN Else .state = UP .hasMouse = FALSE Else .state = UP .hasMouse = FALSE .fixMouse = false EndIf EndIf End With EndIf
Return res End Function
Sub InputBox.drawing() If visible Then Select Case state Case UP Line( x, y) - (x + w - 1, y + h - 1), bg(0), bf Case OVER If fixMouse Then Line(x, y) - (x + w - 1, y + h - 1), bg(1), bf Else Line( x, y) - (x + w - 1, y + h - 1), bg(0), bf EndIf Line(x + 2, y + 2) - (x + w - 3, y + h - 3), over_color, b Case DOWN Line(x, y) - (x + w - 1, y + h - 1), bg(1), bf 'Line(x + 2, y + 2) - (x + w - 3, y + h - 3), over_color, b Case HIT
Case ENABLE Line(x, y) - (x + w - 1, y + h - 1), bg(2), bf Case Else Line(x, y) - (x + w - 1, y + h - 1), bg(1), bf End Select
Line ( x, y) - ( x + w - 1, y + h - 1), bc, B Line ( x + 1, y + 1) - ( x + w - 2, y + 1), &H666666 Line ( x + 1, y + h - 2) - ( x + w - 2, y + h - 2), &He6e6e6 Line ( x + 1, y + 1) - ( x + 1, y + h - 2), &H666666 Line ( x + w - 2, y + 1) - ( x + w - 2, y + h - 2), &He6e6e6
If text = "" Then Draw String ( x + 5, midle( y + 2, h + 4, 14)), Mid( defaultText, 1, max_char),fg Else Draw String ( x + 5, midle( y + 2, h + 4, 14)), Mid( text, textStartAt, max_char),fg EndIf EndIf End Sub
Sub InputBox.edit() '[ Dim As Single _ caret_blink = 1.0,_ caret_interval = 1
Dim As String _ s,_ keystr,_ splitA,_ splitB
Dim As boolean _ triger_,_ keyUp,_ capet_visible,_ select_text,_ exitDo
Dim As Integer _ key,_ lenText,_ mx,_ my,_ mb,_ omb ']
state = HIT s = text If s = "" Then caret = 0
Do 'text = s '& Chr(32) 'caret End lenText = len(s) '[ Mouse & Keyboard event keystr = inkey If Len(keystr) = 1 Then key = Asc(keystr) Else key = 0
GetMouse mx, my,,mb If mx >= x And my >= y And mx <=(x + w) And my <= (y + h) Then If ((mb And (MB_LEFT))<> 0) Then caret = (mx - x - 8) / 8 If caret < 0 Then caret = 0 If caret > lenText Then caret = lenText EndIf Else If ((mb And (MB_LEFT))<> 0) Then Exit Do EndIf ']
If keystr = ( Chr(255) & "S") Then ' Delete s = "" caret = 0 textStartAt = 1 posX = 0 ElseIf ( keystr = ( Chr(255) & "K") ) Then ' Left moveCaretLeft() ElseIf ( keystr = ( Chr(255) & "M") ) Then ' Right moveCaretRight(s) ElseIf ( keystr = (chr(255)+chr(71)) ) Then ' Home textStartAt = 1 caret = 0 ElseIf ( keystr = (chr(255)+chr(79)) ) Then ' End If lenText < 1 Then textStartAt = 1 ElseIf lenText > max_char then textStartAt += lenText - max_char caret = max_char EndIf
If caret < 0 Then caret = 0 ElseIf caret < max_char Then caret = lenText Else caret = max_char EndIf ElseIf ( keystr = chr(27)) And Not keyUp Then ' ESC keyUp = true EndIf
If ( keystr <> chr(27)) And keyUp Then exitDo = true
Select Case key Case 13 'Enter Exit Do Case 8 'Backspace If ( len(s) > 0 ) And ( textStartAt >= 1) And ( caret > 0) Then splitA = Mid( s, 1, textStartAt + caret - 2) splitB = Mid( s, textStartAt + caret) s = splitA & splitB moveCaretLeft() EndIf Case 32 To 255 splitA = Mid( s, 1, textStartAt + caret - 1) splitB = Mid( s, textStartAt + caret + 1 ) s = splitA & keystr & splitB moveCaretRight(s) End Select
If ( Timer >= caret_blink) Then capet_visible = Not capet_visible caret_blink = Timer + caret_interval End If
ScreenLock() #If __MAIN__ Line( 0,0) - ( 800, 200), &H333333, bf #EndIf Line( x, y) - ( x + w - 1, y + h - 1), bg(1), bf
Line ( x, y) - ( x + w - 1, y + h - 1), bc, B Line ( x + 1, y + 1) - ( x + w - 2, y + 1), &H666666 Line ( x + 1, y + h - 2) - ( x + w - 2, y + h - 2), &Hcccccc Line ( x + 1, y + 1) - ( x + 1, y + h - 2), &H666666 Line ( x + w - 2, y + 1) - ( x + w - 2, y + h - 2), &Hcccccc '&He6e6e6 Draw String ( x + 5, midle( y + 2, h + 4, 14)), Mid( s, textStartAt, max_char), fg ' Mid( s, 1, w / 8),fg
#If __MAIN__ Draw String ( 20,20), s Draw String ( 10,40), "text: " & Str( lenText) Draw String ( 10,60), "max_char: " & Str( max_char) Draw String ( 100,40), "caret: " & Str(caret) Draw String ( 200,60), "caret + textStartAt = " & Str(caret + textStartAt) Draw String ( 260,40), "textStartAt: " & Str(textStartAt) #endif
' draw caret If capet_visible Then Line ( x + caret * 8 + 4 - posX * 8, y + 3)-( x + caret * 8 + 4 - posX * 8, y + 17), &H0a0a0a Line ( x + caret * 8 + 4 - posX * 8 - 1, y + 3)-( x + caret * 8 + 4 - posX * 8 - 1, y + 17), &H0a0a0a EndIf ScreenUnLock()
omb = mb Sleep 1 Flip Loop Until exitDo While Inkey <> "": Wend
text = s state = UP End Sub
Constructor InputBox( x As Integer, y As Integer, w As Integer, text As String = "", defaultText As String = "") With This .x = x .y = y .w = w .h = 20 .text = text .defaultText = defaultText .textAlign = 0 .fg = &H666666 .bc = &H000000 .bg(0) = &Hb3b3b3 .bg(1) = &Hffffff .bg(2) = &H333333 .over_color = &H32dcff .visible = true .textStartAt = 1 .max_char = ( w - 8) / 8 End With End Constructor
Constructor InputBox() h = 20 textStartAt = 1 End Constructor
'/' '=============================================== #If __MAIN__ ' ScreenRes 800, 600, 32, 2 ScreenSet 1, 0 Color RGB(255, 128, 0), &H666666 Cls
Dim As InputBox ib = InputBox( 100, 100, 200,,"input text ...")
'[ -- Label_frame text animation -- Var tic = 0.1 Var tici = .4 Var tic_text = 0 ']
Do omb = mb GetMouse(mx, my, mz, mb)
If ( Timer >= tic) Then If tic_text >= 20 Then tic_text = 0 Else tic_text +=1 tic = Timer + tici EndIf If ib.event(omb) Then ib.edit
screenlock Cls Draw String ( 20,20), ib.text Draw String ( tic_text * 20, 320), "Animate text" ib.drawing ScreenUnLock
Sleep 25 Flip Loop Until MultiKey(&H01) Or InKey = Chr(255)+"k" While InKey <> "": Wend End #EndIf '/
посоветуйте чего-нибудь, а ? пробовал использовать
Код If GetAsyncKeyState(32) Then : key_pressed = 32
но геморно
polopok
|
|
| |
ntvgjhfnj | Дата: Пятница, 07.07.2023, 11:09 | Сообщение # 3 |
Лейтенант
Группа: Проверенные
Сообщений: 61
Статус: Offline
| Спасибо! код подправил заработало
Код Dim Shared As Integer mx, my, mz, mb, omb Dim Shared As String key, s, s2, ok
Sub se() Select Case Asc(key) Case 32 To 255 s += key End Select End Sub
' ScreenRes 800, 600, 32, 2 ScreenSet 1, 0 Color RGB(255, 128, 0), &H666666 Cls '[ -- Label_frame text animation -- Var tic = 0.1 Var tici = .4 Var tic_text = 0 ']
Do omb = mb GetMouse(mx, my, mz, mb)
If ( Timer >= tic) Then If tic_text >= 20 Then tic_text = 0 Else tic_text +=1 tic = Timer + tici EndIf key = InKey se() 'Select Case Asc(key) ' Case 32 To 255 ' s2 += key 'End Select
screenlock Cls Draw String (10,10), s Draw String (10,30), s2 Draw String ( tic_text * 20, 320), "Animate text" ScreenUnLock
ok = key Sleep 1 Flip Loop Until MultiKey(&H01) Or Key = Chr(255)+"k" While InKey <> "": Wend End
polopok
|
|
| |