Konsole im CanvasGadget emulieren

[Lothar Schirm]

Da man mit dem CanvasGadget ja fast alles anstellen kann, hier ein kleiner Versuch, ein CanvasGadget wie ein Konsolenfenster zu benutzen. Vielleicht braucht man so etwas mal für kleinere Informationsausgaben und -Eingaben (auch innerhalb eines größeren Fensters, in dem auch andere Funktionen, Buttons usw. implementiert sind).

Hier ein kleines Demoprogramm:

Code: Alles auswählen

; Canvas_Konsole_Test.pb

EnableExplicit

IncludeFile "Canvas_Konsole.pbi"

Define.s s
Define i
Define.d x, dx, y

OpenWindow(0, 0, 0, 440, 340, "CanvasGadget als Konsole", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
C_ID = C_Init(1, 20, 20, 400, 300)

C_PrintN("Willkommen auf der Canvas-Konsole!")
C_PrintN("")
C_Print("Bitte geben Sie Ihren Namen ein: ")
s = C_Edit("Otto Müller")
C_Locate(0, C_LastRow())
C_PrintN("Danke " + s + ", bitte drücken Sie die Enter-Taste!")
C_Edit("")

C_FrontColor = (RGB(255, 255, 255))
C_BackColor = (RGB(0, 0, 255))
C_Clear()

C_Print("Wertetabelle von y = sin(x)")
C_Locate(10, 2)
C_Print("x")
C_Locate(100, 2)
C_Print("y")
dx = 2 * #PI / 8
For i = 0 To 8
  x = 0 + i * dx
  y = Sin(x)
  C_Locate(10, 3 + i)
  C_Print(StrD(x, 4))
  C_Locate(100, 3 + i)
  C_Print(StrD(y, 4))
Next

C_locate(0, C_LastRow())
C_FrontColor = RGB(255, 255, 0)
C_Print("Und auf Wiedersehen! Bitte schliesen Sie dieses Fenster!")

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

End

Und hier das zugehörige Include-File:

Code: Alles auswählen

; Canvas_Konsole.pbi

EnableExplicit

; ID des CanvasGadget, Vor- und Hintergrundfarbe, Cursorposition:
Global C_ID, C_Frontcolor = RGB(0, 0, 0), C_BackColor = RGB(255, 255, 255), C_x, C_Row


Procedure C_Init(C_ID, x, y, Breite, Hoehe)
  ; CanvasGadget initialisieren, gibt die ID des CanvasGadget zurück
  
  C_ID = CanvasGadget(#PB_Any, x, y, Breite, Hoehe, #PB_Canvas_Border | #PB_Canvas_Keyboard | #PB_Canvas_DrawFocus)
  
  ProcedureReturn C_ID
  
EndProcedure


Procedure C_Clear()
  ; Fensterinhalt löschen und Cursorposition auf Null setzten
  
  StartDrawing(CanvasOutput(C_ID))
  Box(0, 0, OutputWidth(), OutputHeight(), C_BackColor)
  StopDrawing()
  C_x = 0
  C_Row = 0
  
EndProcedure


Procedure C_LastRow()
  ; Gibt die Nummer der untersten Zeile zurück (erste Zeile = 0)
  
  Protected Height
  
  StartDrawing(CanvasOutput(C_ID))
  Height = OutputHeight() / TextHeight("X")
  StopDrawing()
  
  ProcedureReturn Height - 1
  
EndProcedure


Procedure C_Locate(x, row)
  ; Setzt den Cursor auf die angegebene x-Position (in Pixeln) und Zeile (zählend ab 0)
  
  C_x = x
  C_Row = row
  
EndProcedure


Procedure C_PrintN(s.s)
  ; String mit Zeilenumbruch anzeigen
    
  StartDrawing(CanvasOutput(C_ID))
  DrawText(C_x, C_Row * TextHeight("X"), s, C_Frontcolor, C_BackColor)
  StopDrawing()
  C_x = 0
  C_Row = C_Row + 1
  
EndProcedure


Procedure C_Print(s.s)
  ; String ohne Zeilenumbruch anzeigen
    
  StartDrawing(CanvasOutput(C_ID))
  DrawText(C_x, C_Row * TextHeight("X"), s, C_Frontcolor, C_BackColor)
  C_x = C_x + TextWidth(s)
  StopDrawing()
  
EndProcedure


Procedure.s C_Edit(s.s)
  ; String eingeben, s = vorbelegter String
    
  Protected x, y, event
  Protected.s Text, Csr = "_"
  
  x = C_x
  StartDrawing(CanvasOutput(C_ID))
  y = C_Row * TextHeight("X")
  StopDrawing()
  Text = s
  
  Repeat
    
    StartDrawing(CanvasOutput(C_ID))
    Box(x, y, TextWidth(Text + Csr + Csr + Csr), TextHeight("X"), C_BackColor)
    DrawText(x, y, Text + Csr, C_Frontcolor, C_BackColor)
    StopDrawing()
    
    event = WaitWindowEvent()
    
    Select event
        
      Case #PB_Event_Gadget
        If EventGadget() = C_ID
          Select EventType()
            Case #PB_EventType_Input
              ; normaler Text:
              Text = Text + Chr(GetGadgetAttribute(C_ID, #PB_Canvas_Input))
            Case #PB_EventType_KeyDown
              Select GetGadgetAttribute(C_ID, #PB_Canvas_Key)
                Case #PB_Shortcut_Back
                  ; Backspace:
                  Text = Left(Text, Len(Text) - 1)
                Case #PB_Shortcut_Return
                  ; Enter:
                  Break
              EndSelect
          EndSelect
        EndIf
        
    EndSelect
    
  ForEver
  
  StartDrawing(CanvasOutput(C_ID))
  Box(x, y, TextWidth(Text + Csr + Csr + Csr), TextHeight("X"), C_BackColor)
  DrawText(x, y, Text, C_Frontcolor, C_BackColor)
  StopDrawing()
  C_x = 0
  C_Row = C_Row + 1
  
  ProcedureReturn Text
  
EndProcedure

[ts-soft]

Nette Idee

In Deinem Beispiel bleiben beim löschen des Namens Fragmente übrig.

Gruß
Thomas

[Lothar Schirm]

Ich habe jetzt die Box, mit der der Text gelöscht wird, bevor er neu geschrieben wird, ein Cursorzeichen "_" länger gemacht. Jetzt müsste es gehen (ist oben in den Code der Include-Datei eingebaut).