XY-Schreibermodul mit Scrollfunktion und Datenspeicherfunktion
Die Aufzeichnungsdauer ist durch das "XYArray.l(999999)" begrenzt
Die Aktualisierungsrate kann im Thread durch "Delay" eingestellt werden
Nach dem Laden einer Datendatei setzt der Schreiber an der zuletzt gespeicherten Position fort
Herzlichen Dank an das Forum für eure Unterstützung ! ! ! ! ! ! ! !
Änderungen am Code die eine Verbesserung darstellen sind erwünscht !
Lg. Legion
Update !
Auf Grund eurer Fehlerbeschreibung hab ich folgende Änderungen vorgenommen:
Während der Schreiberthread läuft hab ich die "CallBackFunktion" abgeschaltet.
Die Abfrage der Startposition vereinfacht.
Es können nur noch spezifische (*.dat) Files geöffnet werden.
Ich hoffe das Prog. läuft jetzt fehlerfrei !
Code: Alles auswählen
Enumeration
#Window_0
EndEnumeration
Enumeration
#TrackBar_0
#ScrollBar_0
#Text_0
#Button_0
#Button_1
#Button_2
#Button_3
#Button_4
EndEnumeration
;------------------------------------------------------------------------------------------------------
Global X = 0
Global Y = 218
Global Dim XYArray.l(999999)
Global Startpos.l = 0
Global ScrollPos.l
Global ExitThread.b = 1
Declare WindowCallback(hWnd.l,uMsg.l,wParam.l,lParam.l)
;------------------------------------------------------------------------------------------------------
Procedure Open_Window_0()
If OpenWindow(#Window_0, 216, 0, 664, 600, "XY-Schreiber", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
If CreateGadgetList(WindowID(#Window_0))
OpenWindowedScreen(WindowID(#Window_0),20,20,620,435,0,0,0)
TrackBarGadget(#TrackBar_0, 20, 500, 620, 30, 0, 435)
SetGadgetState(#TrackBar_0,218)
ScrollBarGadget(#ScrollBar_0, 20, 460, 620, 20, 0, 620, 620)
HideGadget(#ScrollBar_0, 1)
TextGadget(#Text_0, 290, 485, 200, 15, "Bewege mich ! ! ! ! ")
ButtonGadget(#Button_0,30,550, 100, 30, "Start")
ButtonGadget(#Button_1,150,550, 100, 30, "Stop")
ButtonGadget(#Button_2,270,550, 100, 30, "Speichern")
ButtonGadget(#Button_3,390,550, 100, 30, "Laden")
ButtonGadget(#Button_4,520,550, 100, 30, "Beenden")
EndIf
EndIf
EndProcedure
;------------------------------------------------------------------------------------------------------
Procedure Schreiber(DelayTime)
Protected i
SetWindowCallback(0)
Repeat
ClearScreen($0)
StartDrawing(ScreenOutput())
FrontColor($80C020)
DrawingMode(1)
XYArray(X)= GetGadgetState(#TrackBar_0)
If X > 620
Startpos = Startpos +1
SetGadgetAttribute(#ScrollBar_0, #PB_ScrollBar_Maximum, GetGadgetAttribute(#ScrollBar_0, #PB_ScrollBar_Maximum)+1)
SetGadgetState(#ScrollBar_0, 620 + X)
EndIf
For i = Startpos +1 To X
LineXY(i-Startpos,XYArray(i-1),i-Startpos,XYArray(i),$67FDB0)
Next i
StopDrawing()
FlipBuffers()
X = X + 1
Delay(DelayTime)
Until ExitThread
SetWindowCallback(@WindowCallback())
EndProcedure
;------------------------------------------------------------------------------------------------------
Procedure ScrollPicture()
Protected i
ClearScreen($0)
StartDrawing(ScreenOutput())
FrontColor($80C020)
DrawingMode(1)
For i = 0 To 618
LineXY(i,XYArray(i+ScrollPos),i+1,XYArray(ScrollPos+i+1),$67FDB0)
Next i
StopDrawing()
FlipBuffers()
EndProcedure
;------------------------------------------------------------------------------------------------------
Procedure SaveTofile()
Protected i
Protected Pattern$ = "DAT (*.dat)|*.dat"
If X > 2
DateiName$ = SaveFileRequester("Datei speichern unter ...","C:\Schreiber.dat", Pattern$, PatternPosition)
If CreateFile(0,DateiName$)
WriteString(0,"PureBasic XY-Schreiber File")
For i = 0 To X
WriteLong(0,i) : WriteLong(0,XYArray(i))
Next i
CloseFile(0)
EndIf
Else
MessageRequester("Fehler", "Keine Daten zum Speichern !", #MB_OK|#MB_ICONWARNING)
EndIf
EndProcedure
;------------------------------------------------------------------------------------------------------
Procedure LoadFromFile()
Protected u
Protected Pattern$ = "DAT (*.dat)|*.dat"
Protected Dateikennung$
HideGadget(#ScrollBar_0, 1)
SetGadgetAttribute(#ScrollBar_0, #PB_ScrollBar_Maximum,620)
DateiName$ = OpenFileRequester("Datei öffen ...","C:\Schreiber.dat", Pattern$, Pattern)
If DateiName$
If OpenFile(0, DateiName$)
Dateikennung$ = ReadString(0)
If Dateikennung$ <> "PureBasic XY-Schreiber File"
MessageRequester("Fehler", "Keine gültige Schreiberdatei !", #MB_OK|#MB_ICONWARNING)
Goto home
EndIf
Startpos = 0 : u = 0 : ScrollPos = 0 : Dim XYArray.l(999999)
FileSeek(0, 27)
While Eof(0) = 0
u = ReadLong(0) : XYArray(u) = ReadLong(0)
If u > 620
Startpos = Startpos +1
SetGadgetAttribute(#ScrollBar_0, #PB_ScrollBar_Maximum, GetGadgetAttribute(#ScrollBar_0, #PB_ScrollBar_Maximum)+1)
SetGadgetState(#ScrollBar_0, 0)
EndIf
Wend
CloseFile(0)
EndIf
X = u
If X > 620 : HideGadget(#ScrollBar_0, 0) : EndIf
SetGadgetState(#TrackBar_0, XYArray(X-1))
ScrollPicture()
EndIf
home:
EndProcedure
;------------------------------------------------------------------------------------------------------
Procedure WindowCallback(hWnd.l,uMsg.l,wParam.l,lParam.l)
If uMsg = #WM_HSCROLL And lParam = GadgetID(#ScrollBar_0)
ScrollPos = GetGadgetState(#ScrollBar_0)
If ExitThread = 1 : ScrollPicture() : EndIf
EndIf
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
;------------------------------------------------------------------------------------------------------
Procedure StartSchreiber()
If ExitThread = 1
SchreiberThread = CreateThread(@Schreiber(),10)
HideGadget(#ScrollBar_0, 1)
EndIf
EndProcedure
;------------------------------------------------------------------------------------------------------
InitSprite()
InitKeyboard()
Open_Window_0()
SetWindowCallback(@WindowCallback())
;------------------------------------------------------------------------------------------------------
Repeat
If ExitThread = 0
DisableGadget(#Button_2,1) : DisableGadget(#Button_3,1) : DisableGadget(#Button_4,1)
Else
DisableGadget(#Button_2,0) : DisableGadget(#Button_3,0) : DisableGadget(#Button_4,0)
EndIf
;------------------------------------------------------------------------------------------------------
Event = WaitWindowEvent()
WindowID = EventWindow()
GadgetID = EventGadget()
EventType = EventType()
If Event = #PB_Event_Gadget
If GadgetID = #TrackBar_0
ElseIf GadgetID = #ScrollBar_0
ElseIf GadgetID = #Button_0 : StartSchreiber() : ExitThread = 0
ElseIf GadgetID = #Button_1 : ExitThread = 1 : If X > 620 : HideGadget(#ScrollBar_0, 0) : EndIf
ElseIf GadgetID = #Button_2 : ExitThread = 1 : SaveTofile()
ElseIf GadgetID = #Button_3 : ExitThread = 1 : LoadFromFile()
ElseIf GadgetID = #Button_4 : ExitThread = 1 : Break
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
End
;------------------------------------------------------------------------------------------------------