Da der Scroll-Bereich rahmenlos ist, wird das Programm durch einen Tastendruck auf der Tastatur beendet. Dazu muß das rahmenlose Fenster allerdings den Fokus haben.
Das Programm wurde unter Win7 als 64- und 32-Bit-Version getestet.
Hier die Include-Datei 'ScrollingUpTextWindow.pbi':
Code: Alles auswählen
;***********************************************************************************************************************
;* Diese hier in einer Include-Datei zusammengefaßten Prozeduren erzeugen einen randlosen Ausgabebereich, in den Text- *
;* zeilen ausgegeben werden könne. Bei jeder neuen Text-Zeile scrollen die schon vorhandenen Zeilen nach oben und die *
;* neue Text-Zeile wird als unterste Zeile angezeigt.Die oben aus dem Bereich heraus-scrollenden Zeilen gehen verloren.*
;* Der Bereich verfügt über einen eigenen Buffer, so daß er bei Auftreten des Events #PB_Event_Repaint ohne Probleme *
;* neu gezeichnet werden kann. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Für PureBasic 4.50 unter Windows programmiert von: Jürgen Priess (09.2010) *
;***********************************************************************************************************************
EnableExplicit
Structure SUTW_STRUK ;Von dem ScrollingUpTextWindwo benötigte Struktur mit den zu verwendenden Parametern
WindowIdNr.l ;Wird von SUTW_Open zur Speicherung der Windows-Nummer intern verwendet
ImageIdNr.l ;Wird von SUTW_Open zur Speicherung der Image-Nummer intern verwendet
FontIdNr.l ;PureBasic Font-Nummer für den auszugebenden Text
TopLeftX.l ;X-Bildschirm-Koordinate der linken oberen Ecke
TopLeftY.l ;Y-Bildschirm-Koordinate der linken oberen Ecke
ClientWidth.l ;Breite des Client-Bereichs in Pixel
ClientHeight.l ;Höhe des Client-Bereichs in Pixel
FontHeight.l ;Font-Größe in Pixel
FontColor.l ;Font-Farbe
WinBackColor.l ;Hintergrund-Farbe
SpacingY.l ;Zeilen-Abstand in Pixel
SpacingX.l ;Abstand des Textes vom linken RAnd in Pixel
EndStructure
Procedure.l SUTW_Open(*SUTW.SUTW_STRUK)
;***********************************************************************************************************************
;* Es wird ein rahmenloses Fenster gemäß den den der übergebenen Struktur angegeben Werte angelegt und ein um eine *
;* Ausgabezeile längeres Image. Das Image wird mit der in der Struktur übergebenen Hintergrund-Farbe gefüllt. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Parameter: *SUTW.SUTW_STRUK: Ein Pointer auf einen SUTW_STRUK Bereich, der die benötigten Parameter enthält. *
;* Die Bedeutung der verschiedenen Werte geht aus der obigen Struktur-Beschreibung hervor.*
;* Die Werte werden ungeprüft verwendet. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Return: 1 bei erfolg; 0 sonst. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Die Parameterübergabe ist in dieser Form gewählt worden, um eine ellenlange Parameter-Liste zu vermeiden. *
;* Die Prozedur zeigt außerdem, daß man trotz Pointer-Übergabe durch angabe der Struktur auf die zugrunde liegenden *
;* Struktur-Elemente zugreifen kann. *
;***********************************************************************************************************************
Protected Flag.l = #PB_Window_BorderLess
With *SUTW
\WindowIdNr = OpenWindow(#PB_Any,\TopLeftX,\TopLeftY,\ClientWidth,\ClientHeight,"",Flag)
If \WindowIdNr
\ImageIdNr = CreateImage(#PB_Any,\ClientWidth,\ClientHeight+(\FontHeight)+(\SpacingY))
If \ImageIdNr
If StartDrawing(ImageOutput(\ImageIdNr))
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,\ClientWidth,\ClientHeight+(\FontHeight)+(\SpacingY),\WinBackColor)
StopDrawing()
ProcedureReturn 1 ;Bei Erfolg
EndIf
EndIf
EndIf
ProcedureReturn 0 ;Im Fehlerfall
EndWith
EndProcedure
Procedure.l SUTW_PrintN(*SUTW.SUTW_STRUK,Text.s="")
;***********************************************************************************************************************
;* Dies ist der Text-Ausgabe-Befehl für das ScrollingUpTextWindow. Der schon vorhanden Text wird um eine Zeile nach *
;* oben geschoben und die frei werdende Zeile wird mit dem angegebenen Text gefüllt. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Parameter: *SUTW.SUTW_STRUK: Ein Pointer auf einen SUTW_STRUK Bereich, der die benötigten Parameter enthält. *
;* Die Bedeutung der verschiedenen Werte geht aus der obigen Struktur-Beschreibung hervor.*
;* Die Werte werden ungeprüft verwendet. *
;* Text: Der auszugebende Text. Wenn er zu lang ist, wird er am rechten Rand abgeschnitten. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Return: 1 bei erfolg; 0 sonst. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Mit GrabDrawingImage wird der schon vorhandene Text ab der 2.Zeile in ein neues Image gespeichert und dann um eine *
;* Zeile nach oben versetzt von diesem auf das in SUTW_Open angelegte Image kopiert. Danach kann das neue Image *
;* wieder freigegeben werden. Anschließend wird das in SUTW_Open angelegte Image in das ScrollingUpTextWindow ausge- *
;* geben. *
;***********************************************************************************************************************
Protected ImageIdNr2.l = 0
With *SUTW
If StartDrawing(ImageOutput(\ImageIdNr))
ImageIdNr2 = GrabDrawingImage(#PB_Any,0,\FontHeight+(\SpacingY),\ClientWidth,\ClientHeight)
DrawImage(ImageID(ImageIdNr2),0,0)
DrawingFont(FontID(\FontIdNr))
DrawText(\SpacingX,\ClientHeight-(\FontHeight)-(\SpacingY),Text,\FontColor,\WinBackColor)
StopDrawing()
FreeImage(ImageIdNr2) ;Hilfs-Image wieder freigeben
If StartDrawing(WindowOutput(\WindowIdNr))
DrawImage(ImageID(\ImageIdNr),0,0)
StopDrawing()
ProcedureReturn 1
EndIf
EndIf
ProcedureReturn 0
EndWith
EndProcedure
Procedure.l SUTW_Repaint(*STUW.SUTW_STRUK)
;***********************************************************************************************************************
;* Mit dieser Prozedure kann der bisherige Inhalt des ScrollingUpTextWindows neu gezeichnet werden. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Parameter: *SUTW.SUTW_STRUK: Ein Pointer auf einen SUTW_STRUK Bereich, der die benötigten Parameter enthält. *
;* Die Bedeutung der verschiedenen Werte geht aus der obigen Struktur-Beschreibung hervor.*
;* Die Werte werden ungeprüft verwendet. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Return: 1 bei erfolg; 0 sonst. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Wenn das ScrollingUpTextWindow teilweise von anderen Fenstern verdeckt wird oder zum Teil über den Rand des *
;* Monitors geschoben wurde, muß es neu gezeichnet werden. In diesem Fall signalisiert es der Event #PB_Event_Repaint *
;* und man kann diese Prozedure aufrufen. *
;***********************************************************************************************************************
If StartDrawing(WindowOutput(*STUW\WindowIdNr))
DrawImage(ImageID(*STUW\ImageIdNr),0,0)
StopDrawing()
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
Procedure SUTW_Close(*SUTW.SUTW_STRUK)
;***********************************************************************************************************************
;* Mit dieser Prozedur werden die in SUTW_Open angelegten Resourcen wieder freigegeben und das ScrollingUpTextWindow *
;* geschlossen. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Parameter: *SUTW.SUTW_STRUK: Ein Pointer auf einen SUTW_STRUK Bereich, der die benötigten Parameter enthält. *
;* Die Bedeutung der verschiedenen Werte geht aus der obigen Struktur-Beschreibung hervor.*
;* Die Werte werden ungeprüft verwendet. *
;***********************************************************************************************************************
FreeImage(*SUTW\ImageIdNr)
CloseWindow(*SUTW\WindowIdNr)
EndProcedure
Code: Alles auswählen
;***********************************************************************************************************************
;* Testprogramm für das ScrollingUpTextWindow. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Das Fenster erscheint oben links und es werden in einer Schleife Text-Zeilen ausgegeben, die nach oben scrollen. *
;* Das Fenster hat keine Rand und muß über die ESC-Taste beendet werden. Es ist dafür vorgesehen, innerhalb einer *
;* Haupt-Anwendung als Nachrichten/Status-Fenster zu fungieren. Vom Funktionsprinzip her sollte die Größe nicht *
;* änderbar sein. Es kann aber von andern Fenster überlappt und theoretisch auch verschoben werden. *
;* ------------------------------------------------------------------------------------------------------------------- *
;* Für PureBasic 4.50 unter Windows programmiert von: Jürgen Priess (09.2010) *
;***********************************************************************************************************************
EnableExplicit
IncludeFile "ScrollingUpTextWindow.pbi"
#My_VK_ESCAPE = $1B ;ESC key
Global MySUTW.SUTW_STRUK
Global Event.l = 0
Global I.l = 1
MySUTW\FontHeight = 10
MySUTW\FontColor = $00000000 ;Schwarz
MySUTW\FontIdNr = LoadFont(#PB_Any,"Courier",MySUTW\FontHeight,#PB_Font_HighQuality)
MySUTW\WinBackColor = $FFFFFFFF ;Weiß
MySUTW\TopLeftX = 10
MySUTW\TopLeftY = 20
MySUTW\ClientWidth = 300
MySUTW\ClientHeight = 392
MySUTW\SpacingX = 6
MySUTW\SpacingY = 5
SUTW_Open(@MySUTW) ;ScrollingUpTextWindwo initialisieren
Repeat
Event = WindowEvent()
If Event = #PB_Event_Repaint
SUTW_Repaint(@MySUTW) ;Neuzeichnen des ScrollingUpTextWindows
EndIf
SUTW_PrintN(@MySUTW,"[" + Str(I) + "] Zum Abbrechen Taste drücken")
Delay(100) ;Verzögerung, auch wegen WindowEvent
I = I+1
Until Event = #WM_KEYDOWN ;GetAsyncKeyState_(#My_VK_ESCAPE) funktioniert nur unter 32 Bit
SUTW_Close(@MySUTW) ;ScrollingUpTextWindow entfernen
End