ich bin ganz neu hier und bei PB. Mein erster PB Versuch läuft _fast_ genau wie ich das möchte, ausser:
Ich habe ein CheckBoxGadget (Zeile 210 im Editor, hier im Forum wohl nicht; gleich das zweite Gadget nach dem OpenWindow). Unter WindowsXP (SP2) läuft alles wie erwartet.
Unter Vista bleibt das Programm nach dem Klick auf diese Checkbox scheinbar stehen. Es reagiert danach auf keinerlei Eingabe mehr. Nach einger Zeit des wilden rumklickens (15 Sekunden) scheinen dann aber alle in der Zwischenzeit "gesammelten" Events auf einen Schlag abgearbeitet zu werden.
Code anbei. Ich bitte den grausigen Stil zu verzeihen, das ist mein erstes PB Programm und mit sehr viel "F1" in weniger als 12 Arbeitsstunden entstanden.
Code: Alles auswählen
#SerialPort = 0
Global Port$ = "COM2" ; Default com port; is overwritten by FindComm() anyhow
Global Msg$ = "" ; String Var for cosntructing the serial port string from several chunks
Global Text$ = "" ; Byte chunk from serial port buffer
Global *Buffer = AllocateMemory(1024) ; serial port receive buffer
Global RadarX.f = 0 ; X position for the neigungs display line
Global RadarY.f = 0 ; y position for the neigungs display line
Global AzX.f = 0 ; x position for the azimuth display line
Global AzY.f = 0 ; y position for the azimuth display line
Global Azimuth.f = 0 ; azimuth value in degree
Global NeigungsBetrag.f = 0 ; neigung value
Global NeigungsWinkel.f = 0 ; neigung angel
Global ValString$ = "" ; part of serial port buffer left of the CR
Global AutoStoreTolerance.f = 0.5 ; tolerance for autostore - if this is not exceeded for 3 measurments in an row, the third measurement is auto-stored
Global Temperature.f = 0 ; current temperature
Global Teufe.f = 0 ; current teufe
Global Batt = 0 ; current battery voltage (corase)
Global Dim TeufeA.f(90000) ; memory arrays for up to 90000 measurements used to construct the trace. 90000 is more than one day with 1 measueremnt per second.
Global Dim AzimuthA.f(90000)
Global Dim PitchA.f(90000)
Global Dim RollA.f(90000)
Global Dim TimeA$(90000)
Global Dim TempA.f(90000)
Global Dim Selected(90000)
Global Dim PosXA.f(90000)
Global Dim PosYA.f(90000)
Global ArrayPos.l = 0 ; current position within array
Global ScrollPos.l = 0 ; current position of the scrollbar, used for scrolling trough the memory array
Global OnlySavedFlag = 1 ; flag indicating that we want to see only values that have been saved by button or AutoSave
Global StoragePath$ = GetHomeDirectory() ; default path for file storage
Global FileName$ = "" ; current file name
If ReadFile(5,"GeoTerm_storage_path.txt") ; try to read the default storage path from a config file
StoragePath$ = ReadString(5,#PB_Ascii) ; read storage pth from file
CloseFile(5) ; close file
EndIf ; end of try to read storage path from config file
OldTeufe.f = 0 ; old teufe, needed for construction of the trace
OldWinkel.f = 0 ; old winkel; needed for autostore tolerance checking
GoodFlag = 0 ; flag indicating how many good measurements in a row we had
PortOpenFlag = 0 ; flag indicating the srial port is open; needed to be known for close
Global PortFoundFlag = 0 ; flag indicating that we found a sensor on a port
Global ImageFlag = 0 ; flag indicating that we want to show an overlay image in DrawPane()
BigFont = LoadFont(1,"Arial",12,#PB_Font_Bold)
Procedure FindComm() ; search all ports for the sensor data stream
PortFoundFlag = 0
SetGadgetText(7,"Suche COM Ports...")
For n= 1 To 100 ; scan ports 1 to 100; This is because virtual COM ports on windows can reach very high numbers
Port$ = "COM" + Str(n) ; construct port name
SetGadgetText(7,"..." + Port$)
If OpenSerialPort(#SerialPort, Port$, 19200, #PB_SerialPort_NoParity, 8, 1, #PB_SerialPort_NoHandshake, 1024, 1024) ; Try to open port - this function is, according to the PB Manual - "bullet proof"
SetGadgetText(7,Port$ + " opened")
Delay(1200) ; wait more than 1 second because the EWS data packets may be as slow as 1 per second
Result = AvailableSerialPortInput(#SerialPort) ; check if there is something in the input buffer
If Result ; and if so
SetGadgetText(7,Port$ + " opened and has " + Str(Result) + "bytes data")
ReadSerialPortData(#SerialPort,*Buffer,Result) ; read the buffer content
Text$ = PeekS(*Buffer, Result) ; get the string from the buffer "Buffer"
Result = FindString(Text$,"D",1) ; check if the buffer contains a "D" , the start condition of the sensor
If Result ; if so,
SetGadgetText(7,"... Sensor auf " + Port$ + " gefunden.")
PortFoundFlag = 1 ; set a flag indicating that we found the port
CloseSerialPort(#SerialPort) ; close the port
Break ; exit the for loop, we do not need to search further
EndIf ; if no "D" in the buffer contents
EndIf ; if nothing in the buffer
CloseSerialPort(#SerialPort) ; close port
EndIf ; if port could not be opened
Next ; try next port
EndProcedure ; end of the FindComm procedure
Procedure SaveValues() ; This procedure saves the current sensor data to a file
Selected(ArrayPos) = 1
PlaySound(0) ; play a sound indicating that the save event is triggered; this is useful for the autosave feature
WriteStringN(2,TimeA$(ArrayPos) + "," + StrF(AzimuthA.f(ArrayPos),1) + "," + StrF(PitchA.f(ArrayPos),1) + "," + StrF(RollA.f(ArrayPos),1) + "," + StrF(RadarX.f,1) + "," + StrF(RadarY.f,1) + "," + StrF(PosXA.f(ArrayPos),1) + "," + StrF(PosYA.f(ArrayPos),1) + "," + Str(ArrayPos) + "," + StrF(TeufeA.f(ArrayPos),1) + "," + StrF(TempA.f(ArrayPos),2) + "," + Str(Selected(ArrayPos)) , #PB_Ascii)
FlushFileBuffers(2) ; flush the file buffer; We want to have all data secure ASAP to be save in case of program crashes or power loss
EndProcedure
Procedure DrawPane() ; This procedure (re)draws the radar pane
CreateImage(0,720,720) ; create radar pane image
StartDrawing(ImageOutput(0)) ; draw on pane
FrontColor(RGB(0,0,0)) ; default draw color is black
DrawingMode(#PB_2DDrawing_Default) ; draw solid
Box(0,0,720,720,RGB(255,255,255)) ; draw white background box - default background is black
LineXY(0,360,720,360,RGB(200,200,200)) ; the x axis - note, this is north-south and thus y axis of the sensor
LineXY(360,0,360,720,RGB(200,200,200)) ; the y axis - note, this is east-west and thus x axis of the sensor
LineXY(0,655,50,655,RGB(128,0,0)) ; legend lines - neigung
LineXY(0,670,50,670,RGB(255,0,0)) ; compass
LineXY(0,685,50,685,RGB(0,0,255)) ; trace
For n = 1 To 361 Step 20 ; draw the scale lines and text
DrawingMode(#PB_2DDrawing_Transparent) ; draw only the outline of the circle(s) otherwise we end up with a big black filled circle
If n > 1 ; do not draw the "0" at the origin, as this is annoying
DrawText(360,360-n,Str(2*n/20),RGB(200,200,200)) ; draw the scale text
EndIf
DrawingMode(#PB_2DDrawing_Outlined) ; draw the scale circles - only the outlnes, not filled
Circle(360,360,n,RGB(200,200,200)) ; draw the circle
Next ; scaling is drawed now
LineXY(360,360,360+RadarY.f,360-RadarX.f,RGB(128,0,0)) ; the neigung
LineXY(360,360,360+AzY.f,360-AzX.f,RGB(255,0,0)) ; the compass
Last.l = 1 ; this is the array position of the last explicit stored dataset
For n = 1 To ArrayPos ; draw all stored data points, or only the ones explicitely saved
If OnlySavedFlag = 1 ; if we want to see only the explicit stored data
If Selected(n) = 1 ; check if this data set is explicit stored
LineXY(360+PosYA.f(Last),360-PosXA.f(Last),360+PosYA.f(n),360-PosXA.f(n),RGB(0,0,255)) ; if so, draw line from last explicit one to this one
Last = n ; now this one is the last one (for the next iteration)
EndIf ; end of "if this is explicit saved data"
Else ; If all data should be shown
LineXY(360+PosYA.f(n-1),360-PosXA.f(n-1),360+PosYA.f(n),360-PosXA.f(n),RGB(0,0,255)) ; draw line from last data point to this one
EndIf ; end of the "explicit or not" decision
Next ; next data set from the array
DrawingMode(#PB_2DDrawing_Transparent) ; draw text
DrawText(350,705,"S",RGB(200,200,200)) ; draw South, West, East markers
DrawText(0,360,"W",RGB(200,200,200))
DrawText(710,360,"E",RGB(200,200,200))
DrawText(615,640,"Temp.: " + StrF(Temperature.f,2),RGB(0,0,0)) ; draw current temperature to lower right corner
DrawText(615,655,"Teufe: " + StrF(Teufe.f,2),RGB(0,0,0)) ; draw current teufe to lower right corner
DrawText(615,670,"Az: " + StrF(Azimuth.f,1),RGB(255,0,0)) ; draw current azimuth to lower right corner
DrawText(615,685,"Abweichung: " + Str(Sqr(Pow(PosXA(ArrayPos),2) + Pow(PosYA(ArrayPos),2))/10),RGB(0,0,255))
DrawingFont(FontID(1))
DrawText(550,700,"Neigung: " + StrF(Neigungsbetrag.f,1) + "°, \/" + StrF(NeigungsWinkel.f,1),RGB(128,0,0))
DrawingFont(#PB_Default)
DrawText(0,705,Str(ArrayPos),RGB(0,0,0)) ; draw dataset number to lower left corner
DrawText(0,635,"Legende:",RGB(0,0,0)) ; draw legende
DrawText(55,650,"Neigung",RGB(128,0,0))
DrawText(55,665,"Azimuth",RGB(255,0,0))
DrawText(55,680,"Bohrspur",RGB(0,0,255))
; If ImageFlag = 1
; DrawingMode(#PB_2DDrawing_AlphaBlend)
; DrawAlphaImage(2,100,100,200) ; overlay map
; EndIf
If ScrollPos > 0 ; if the user is scrolling right now
Circle(360+PosYA(ScrollPos),360-PosXA(ScrollPos),3,RGB(0,0,0)) ; show scroll position as circle on the measured trace
Nb.f = Sqr(Pow(PitchA(ScrollPos),2) + Pow(RollA(ScrollPos),2)) ; calclate neigungs betrag
DrawText(615,0,"Temp. " + StrF(TempA(ScrollPos),2),RGB(200,200,200)) ; draw temperature in the uper right corner
DrawText(615,15,"Teufe " + Str(TeufeA(ScrollPos)),RGB(200,200,200)) ; draw teufe at this position at the upper right corner
DrawText(615,30,"Neigung " + StrF(Nb,1),RGB(200,200,200)) ; draw neigungs betrag in the upper right corner
DrawText(615,45,"Abweichung: " + Str(Sqr(Pow(PosXA(ScrollPos),2) + Pow(PosYA(ScrollPos),2))/10),RGB(200,200,200))
DrawText(0,0,Str(ScrollPos),RGB(200,200,200)) ; draw position of current data set in the uppper left corner
EndIf ; end of the "if user is scrolling" decision
StopDrawing() ; all drawing is done here
SetGadgetState(3,ImageID(0)) ; copy the image from the memory buffer to the screen buffer
FreeImage(0) ; free the memory buffer; otherwise -° memory overflow after a while
EndProcedure ; end of the DrawPane procedure
Procedure InitArray() ; This procedure emptys the memory array and the current values to 0
For n = 0 To 90000 ; loop all array positions
TeufeA.f(n) = 0
AzimuthA.f(n) = 0
PitchA.f(n) = 0
RollA.f(n) = 0
TimeA$(n) = ""
TempA.f(n) = 0
Selected(n) = 0
PosXA.f(n) = 0
PosYA.f(n) = 0
Next
ArrayPos = 1 ; reset array
TeufeA(ArrayPos) = Teufe ; set teufe to current value
NeigungsWinkel.f = 0 ; reset neigung and temperature
NeigungsBetrag.f = 0
Temperature.f = 0
SetGadgetAttribute(8,#PB_ScrollBar_Maximum,ArrayPos) ; reset scrollbar max value to 1
SetGadgetState(8,0) ; reset scrollbar position to 0
EndProcedure ; end of InitArray procedure
Procedure OpenPort()
If PortFoundFlag = 1 ; if the sensor was found at any serial port
If OpenSerialPort(#SerialPort, Port$, 19200, #PB_SerialPort_NoParity, 8, 1, #PB_SerialPort_NoHandshake, 1024, 1024) ; try to open the port (should work, the sensor has been found there)
PortOpenFlag = 1 ; remember that the port is open now; needed to close the port only if it is open - otherwise error msg.
DisableGadget(1,0) ; enable messung starten button
DisableGadget(5,0) ; enable autospeichern checkbox
DisableGadget(9,0) ; enable autostore tolerance spingadget
DisableGadget(10,0) ; enable text for the above gadget
DisableGadget(14,0) ; enable "what to display" checkbox
DisableGadget(15,0) ; enable storage path setting button
HideGadget(7,1) ; hide comm port search info text
HideGadget(3,0) ; show image gadget used to display the drawn image
DisableGadget(16,1) ; disable rescan button
DrawPane() ; draw pane - just to have something to look at
Else ; If port could Not be found - we still could open a stored file To watch it
MessageRequester("Unable to open port " + Port$,"Unable to open port " + Port$ + ". This should never happen, as the sensor was found on this port just seconds before.") ; display msg
PortOpenFlag = 0 ; reset port open flag
EndIf ; end of "if port could be opened" decision
Else ; If the sensor was NOT found - we still can open a file from disk to watch it.
SetGadgetText(7,"... Keinen Sensor gefunden") ; show the message on the area where otherwise the radar pane would be.
EndIf ; end of IfPortFound decision
EndProcedure
; ------------- End of procedures, main program follows ---------
If OpenWindow(0, 100, 100, 920, 720, "GeoTerm") ; Try to open window
ButtonGadget(1,760,20,150,30,"Messung starten") ; Start measurement button
GadgetToolTip(1,"Startet eine neue Messung und fragt vorher nach dem Dateinamen") ; tooltip for the above button
DisableGadget(1,1) ; enable only of sensor was found
CheckBoxGadget(5,760,55,150,20,"Automatisches speichern") ; checkbox for autostore feature
GadgetToolTip(5,"Speichert automatisch wenn drei aufeinanderfolgende Messwerte in der Neigung nicht mehr als unten eigestellt voneinander abweichen")
DisableGadget(5,1) ; enable only if sensor was found
TextGadget(10,760,75,115,20,"Toleranzbereich dafuer") ; text
GadgetToolTip(10,"Toleranzbereich dafuer")
DisableGadget(10,1) ; enable only if measurement was started
SpinGadget(9,875,75,35,20,1,10) ; autostoretolerance
SetGadgetState(9,5) ; default value is 5 - this gadget can only handle integers, thus we define a range from 1 to 10 and lateron divide by 10
SetGadgetText(9,"0,5") ; text display for default value - this gadget keeps real values and the shown text seperate
GadgetToolTip(9,"Toleranzbereich fuer automatisches Speichern")
DisableGadget(9,1) ; we enable this only if a measurement is started
ButtonGadget(6,760,110,150,30,"Speichern (SPACE)",#PB_Button_Default) ; The store button
GadgetToolTip(6,"Speichert den aktuellen Messwert")
DisableGadget(6,1) ; we enable this only if a measurement is started
ButtonGadget(15,760,90,50,15,"..") ; the button to choose the default storage path
GadgetToolTip(15,"Verzeichnis zum Speichern festlegen")
DisableGadget(15,1) ; we enable this only if the sensor was found
ButtonGadget(2,760,670,150,30,"Prog. beenden") ; the exit button
GadgetToolTip(2,"Beendet das Programm")
ButtonGadget(4,760,630,150,30,"Messung laden") ; the load file button
GadgetToolTip(4,"Laedt eine Messung von der Festplatte")
ScrollBarGadget(8,720,0,20,720,0,1,1,#PB_ScrollBar_Vertical) ; the scrollbar gadget - used to scroll trough the memory array - the trace
GadgetToolTip(8,"Durch die vorhandenen Messungen scrollen. Oben ist die erste Messung, unten die letzte.")
DisableGadget(8,1) ; we enable this if a measurement is started or a file is loaded
CreateImage(0,720,720) ; create radar pane image - this is a memory location to draw on
ImageGadget(3,0,0,0,0,ImageID(0)) ; create image gadget - this is an area on the window to display any kind of images
HideGadget(3,1) ; after the start, we hide this to use the room to display some messages about the serial port detection progress
TextGadget(7,280,360,160,20,"",#PB_Text_Center | #PB_Text_Border) ; this is the text for the serial port detection progress messages
SetGadgetColor(7,#PB_Gadget_BackColor,RGB(100,255,255))
; ButtonGadget(11,440,180,150,30,"Karte laden")
; GadgetToolTip(11,"Eine Karte als Hintergrund laden. Die Karte muss genau 80x80 Meter abbilden mit dem Mittelpunkt bei 40/40")
ButtonGadget(12,760,400,150,30,"Reset Teufe") ; this button allows one to (re)set the teufe at any time
GadgetToolTip(12,"Die Teufe auf einen beliebigen Wert (in Metern) setzen.")
DisableGadget(12,1) ; we enable this only if a measurement was started
ButtonGadget(13,760,440,150,30,"Spur loeschen") ; This button allows one to delete the trace, this is to reset the memory array to all 0
GadgetToolTip(13,"Die Bohrspur loeschen.")
DisableGadget(13,1) ; we enable this only if a measurement was started
CheckBoxGadget(14,760,150,150,20,"Nur gespeicherte Werte") ; this checkbox defines wether to display all data or only the one stored by user or AutoStore function
GadgetToolTip(14,"Nur manuell oder per autosave gespeicherte Messwerte anzeigen.")
SetGadgetState(14,OnlySavedFlag) ; we set this to the default state whic is only to show stored data
DisableGadget(14,1) ; we enable this only if a measurement was started or a file loaded
ButtonGadget(16,760,580,150,30,"Rescan Ports")
GadgetToolTip(16,"Die seriellen Ports neu durchsuchen (z.B. wenn Sensor ausgeschaltet wurde)")
UsePNGImageDecoder() ; use the PNG encoder (not used up to now, would be useful for map overlays)
UseJPEGImageDecoder() ; use the JPEG encoder (not used now, useful for map overlays)
InitSound() ; init the sound system - needed for the (auto)store BING sound
CatchSound(0, ?Bing) ; load the sound from the DATA section at the end of this file. We include the sound into the binary to be independend of the system sounds
InitArray() ; init the memory array to all 0
FindComm() ; find COM port
Delay(300) ; wait for port to close before re-opening
OpenPort()
; ------- main event loop -------
Repeat ; this is the main event loop. It is repeated forever untill the user exits the program
If RunFlag = 1 ; if measurement was started
Result = AvailableSerialPortInput(#SerialPort) ; Check for available data in the input buffer
If Result ; if chars in buffer
While Result ; loop until buffer is empty
ReadSerialPortData(#SerialPort, *Buffer, Result) ; Read the data from the input buffer into memory
Text$ = PeekS(*Buffer, Result) ; get the string from the buffer "Buffer"
Msg$ + Text$ ; append string to the one retrieved before
Result = AvailableSerialPortInput(#SerialPort) ; check if more chars n buffer ( or new ones in the meantime)
Wend ; loop until bufer is empty
Result = FindString(Msg$,"LowBatt",1) ; check for low batt message at the string
If Result ; if low batt message found
CloseFile(1) ; close files
CloseFile(2)
SetGadgetText(1,"Messung starten") ; change text of button to "start" - the measurement is ended now. Thus..
DisableGadget(1,1)
DisableGadget(4,0) ; enable load button
DisableGadget(2,0) ; enable exit button
DisableGadget(6,1) ; speichern button disablen
DisableGadget(16,0)
SetWindowTitle(0,"GeoTerm - no data") ; reset window title
RunFlag = 0
If PortOpenFlag = 1 ; Check if serial port is open by use of the flag. There is no way to check this by a PB function
CloseSerialPort(#SerialPort) ; close serial port
EndIf
Text$ = ""
Msg$ = ""
MessageRequester("Hinweis","Hinweis: Sensorelektronik hat wegen leerer Batterie abgeschaltet. Die Messung ist gespeichert.")
EndIf
Result = FindString(Msg$,"PowerDown",1) ; check for powerdown message at the string
If Result ; if low batt message found
CloseFile(1) ; close files
CloseFile(2)
SetGadgetText(1,"Messung starten") ; change text of button to "start" - the measurement is ended now. Thus...
DisableGadget(1,1)
DisableGadget(4,0) ; enable load button
DisableGadget(2,0) ; enable exit button
DisableGadget(6,1) ; speichern button disablen
DisableGadget(16,0)
SetWindowTitle(0,"GeoTerm - no data") ; reset window title
RunFlag = 0
If PortOpenFlag = 1 ; Check if serial port is open by use of the flag. There is no way to check this by a PB function
CloseSerialPort(#SerialPort) ; close serial port
EndIf
Text$ = ""
Msg$ = ""
MessageRequester("Hinweis","Hinweis: Sensorelektronik wurde vom Benutzer abgeschaltet. Die Messung ist gespeichert")
EndIf
Result = FindString(Msg$,Chr(13),1) ; look for CR in assembled string
While Result ; as long as CR's are found in assembled string
ValString$ = Left(Msg$,Result) ; get part at the left side of the CR
ValString$ = ReplaceString(ValString$," ","") ; remove all spaces - this is needed as he minus sign may be seperated from the according numer by spaces and VAL cannot handle tis
ArrayPos = ArrayPos + 1 ; next position in array
If ArrayPos.l > 90000 ; avoid memory overflow - wrap around the memory buffer in this case
ArrayPos.l = 1
EndIf
Selected(ArrayPos.l) = 0 ; this value set is not (yet) stored by user or AutoStore and thus mey be not valid
SetGadgetAttribute(8,#PB_ScrollBar_Maximum,ArrayPos) ; set new scrollbar maximum
TimeStamp = Val(StringField(ValString$,1,",")) ; get timestamp from sensor
Azimuth.f = Val(StringField(ValString$,2,",")) / 10 ; get Azimuth
AzX.f = 360 * Cos(Radian(Azimuth)) ; calculate X and Y coordinates for the radar pane display which has +- 300 pixels
AzY.f = 360 * Sin(Radian(Azimuth)) ; sin and cos return values in the +- 1 tange, thus multiply with number of image pixels
Pitch.f = Val(StringField(ValString$,3,",")) / 10 ; get pitch value
Roll.f = Val(StringField(ValString$,4,",")) / 10 ; get roll value
Temperature.f = ValF(StringField(ValString$,5,",")) ; get temperature value
Teufe.f = ValF(StringField(ValString$,7,",")) / 100 ; get teufe
Batt = ((Val(StringField(ValString$,9,",")) -3118) / 120 ) + 8 ; get and calc battery value. As this seems to be very non-linear, do some ugly corrections here. This is sufficient for the low battery warning.
NeigungsBetrag.f = Sqr(Pow(Pitch.f,2) + Pow(Roll.f,2)) ; calculate betrag of neigung
NeigungsWinkel.f = Degree(ATan2(Radian(Roll.f),Radian(Pitch.f))) - 90 ; calculate angel of neigung -- warum -90 Grad ?
NeigungsWinkel.f = NeigungsWinkel.f + Azimuth.f ; add azimuth to neigungswinkel
TeufeA.f(ArrayPos.l) = Teufe.f ; store values to memory array
AzimuthA.f(ArrayPos.l) = Azimuth.f
PitchA.f(ArrayPos.l) = Pitch.f
RollA.f(ArrayPos.l) = Roll.f
TempA.f(ArrayPos.l) = Temperature.f
TimeA$(ArrayPos.l) = FormatDate("%hh:%ii:%ss",Date())
RadarX.f = (NeigungsBetrag.f * Cos(Radian(NeigungsWinkel.f))) * 10 ; calculate coordinates for radar pane display. Multiply: 350pixels / 35 grad = 5
RadarY.f = (NeigungsBetrag.f * Sin(Radian(NeigungsWinkel.f))) * 10 ; 360px / 36 grad
a.f = (NeigungsBetrag.f * Cos(Radian(NeigungsWinkel.f))) ; calc coordinates for radar pane display.
PosXA.f(ArrayPos) = PosXA.f(ArrayPos - 1) + (Sin(Radian(a.f)) * (Teufe.f - TeufeA.f(ArrayPos-1))) * 10 ; Multiply : 360px / 36 meter = 10
a.f = (NeigungsBetrag.f * Sin(Radian(NeigungsWinkel.f)))
PosYA.f(ArrayPos) = PosYA.f(ArrayPos - 1) + (Sin(Radian(a.f)) * (Teufe.f - TeufeA.f(ArrayPos-1))) * 10 ; 360px / 36 meter
If GetGadgetState(5) = #PB_Checkbox_Checked ; if AutoStore feature enabled
If Teufe = TeufeA(ArrayPos -1) ; check if we are moving the sensor right now. If not,
If Abs((Abs(NeigungsBetrag.f) - Abs(OldWinkel.f))) < AutoStoreTolerance.f ; check if tolarance between last value an the current one.
GoodFlag = GoodFlag + 1 ; if OK, we have one more good
Else ; if not, no good, old tilt is current tilt, for next comparison
GoodFlag = 0
OldWinkel.f = NeigungsBetrag.f
EndIf
If GoodFlag = 2 ; if we had two good comparisons ( = 3 good values in a row)
SaveValues() ; AutoSave current value
GoodFlag = 0 ; reset for next comparison run
OldWinkel.f = 0
EndIf
EndIf
EndIf ; end of "If AutoSave feature on" check
WriteStringN(1,TimeA$(ArrayPos) + "," + StrF(Azimuth.f,1) + "," + StrF(Pitch.f,1) + "," + StrF(Roll.f,1) + "," + StrF(RadarX.f,1) + "," + StrF(RadarY.f,1) + "," + StrF(PosXA.f(ArrayPos),1) + "," + StrF(PosYA.f(ArrayPos),1) + "," + Str(ArrayPos) + "," + StrF(Teufe.f,2) + "," + StrF(Temperature.f,2) + "," + Str(Selected(ArrayPos)) , #PB_Ascii) ; save data
FlushFileBuffers(1) ; flush file buffers. We want to have all data save ASAP
SetWindowTitle(0,"GeoTerm - Batt: " + Str(Batt) + " Volt - " + GetFilePart(FileName$)) ; display battery voltage in title bar
If Batt < 10 ; if battery below 8 Volts
SetWindowColor(0,RGB($FF,$EE,$00)) ; set window background if battery is low
ElseIf Batt > 10 ; reset window background if battery is over 8 Volts (again)
SetWindowColor(0,-1) ; reset to default background color
EndIf
DrawPane() ; update the graphics. This dataset is now done
Msg$ = Mid(Msg$,Result+1) ; cut this part of the buffer content away because it is proceeded now
Result = FindString(Msg$,Chr(13),1) ; look for CR in the Rest
Wend ; next iteration of the "while chars in input buffer" loop
EndIf ; end of the check if any chars are in the input buffer
EndIf ; end of the check if a measurement is running - the whole thing above is otherwise not executed
EventID = WaitWindowEvent(200) ; refresh window every 20 ms
Select EventGadget() ; call EventGadget, which returns the number of the gadget of the last gadget event (there are other event types, too) and use this result for the following SELECT statement
Case 1 ; If start/stop button pressed
If RunFlag = 1 ; If already running, stop now
CloseFile(1) ; close files
CloseFile(2)
SetGadgetText(1,"Messung starten") ; change text of button to "start" - the measurement is ended now. Thus...
DisableGadget(4,0) ; enable load button
DisableGadget(2,0) ; enable exit button
DisableGadget(6,1) ; speichern button disablen
SetWindowTitle(0,"GeoTerm - no data") ; reset window title
RunFlag = 0 ; reset the run flag
Else ; If not yet running, start now
InitArray() ; init memory array as it may contain data from a before loaded file or a measurement made before
FileName$ = StoragePath$ + FormatDate("%yyyy-%mm-%dd-%hh-%ii-%ss",Date()) + ".csv" ; construct default filename
FileName$ = SaveFileRequester("Dateiname angeben",FileName$,"CSV Datei (*.csv)",1) ; open file requester to possible change the file name
If FileName$ ; if there is a filename
If FindString(FileName$,".csv",1) = 0 ; check for ".csv" extension
FileName$ = FileName$ + ".csv" ; append if not ".csv"
EndIf
FileNameTwo$ = ReplaceString(FileName$,".csv","_selected.csv",#PB_String_NoCase) ; construct filename for AutoSave or UserSave data file
If OpenFile(1,FileName$) ; try to open file
WriteStringN(1,"GeoTerm measurement file created at " + FormatDate("%yyyy-%mm-%dd",Date()) + " at " + FormatDate("%hh:%ii",Date())) ; on success, write header lines to file
WriteStringN(1,"Format: timestamp,Azimuth,Pitch,Roll,RadarX,RadarY,PosX,PosY,Measurement#,Teufe,Temperature,Selected,CrLf")
SetGadgetText(1,"Messung stoppen") ; set button text to "stop"
DisableGadget(4,1) ; disable load button
DisableGadget(2,1) ; disable exit button
DisableGadget(6,0) ; enable save button
; SetActiveGadget(6) ; set focus to save button
DisableGadget(8,0) ; enable scrollbar
DisableGadget(12,0) ; enable set teufe button
DisableGadget(13,0) ; enable delete trace button
DisableGadget(16,1) ; disable scan ports button
Wt$ = GetWindowTitle(0) ; get the current window title
SetWindowTitle(0,Wt$ + " - " + GetFilePart(FileName$)) ; add the filename to the current window title and display that new title
RunFlag = 1 ; set run flag
Else ; if file could not be opened
MessageRequester("Error","Error: unable to open file " + FileName$ + ".csv") ; msg box
EndIf
If OpenFile(2,FileNameTwo$) ; try to open file for UserStored or AutoStored data
WriteStringN(2,"GeoTerm measurement file created at " + FormatDate("%yyyy-%mm-%dd",Date()) + " at " + FormatDate("%hh:%ii",Date()) + " - selected measurements") ; write header lines
WriteStringN(2,"Format: Timestamp,Azimuth,Pitch,Roll,RadarX,RadarY,PosX,PosY,Measurement#,Teufe,Temperature,Selected,CrLf")
Else ; if it could not be opened
MessageRequester("Error","Error: Unable to open file " + FileNameTwo$ + ".csv") ; mesg box
EndIf
EndIf ; end of "if filename exists"
EndIf ; end of "start or stop measurement"
Case 2 ; exit button was clicked
EventID = #PB_Event_CloseWindow ; set event ID to that of clicking the (non existant) close button on the upper right corner
Case 4 ; load button
FileName$ = OpenFileRequester("Datei auswählen", StoragePath$, "CSV Dateien|*.csv;*.txt|All Files|*.*", 0) ; show choose file dialog
If FileName$ ; if filename
If ReadFile(3,FileName$) ; try to pen file for reading
HideGadget(7,1) ; hide comm port search info text
HideGadget(3,0) ; show image gadget used to display the drawn image
DisableGadget(12,1)
DisableGadget(13,1)
DrawPane() ; draw pane - just to have something to look at
SetWindowTitle(0,"GeoTerm - " + GetFilePart(FileName$)) ; add the filename to the current window title and display that new title
InitArray() ; init memory array as it may contain old data from a measurement or a file loaded before
RadarX.f = 0 ; reset radar pane draw coordinates and other values to 0
RadarY.f = 0
AzX.f = 0
AzY.f = 0
Temperature.f = 0
Teufe.f = 0
n = 0 ; init line counter to 0
While Eof(3) = 0 ; loop all lines
Lin$ = ReadString(3,#PB_Ascii) ; read a line
If FindString(Lin$,":",1) = 3 ; check if a line contains a ":" - this is to filter out the first two lines that contain user information
n = n + 1 ; increment line counter
TimeA$(n) = StringField(Lin$,1,",") ; read line values into memory array
AzimuthA(n) = ValF(StringField(Lin$,2,","))
PitchA(n) = ValF(StringField(Lin$,3,","))
RollA(n) = ValF(StringField(Lin$,4,","))
PosXA(n) = ValF(StringField(Lin$,7,","))
PosYA(n) = ValF(StringField(Lin$,8,","))
TeufeA(n) = ValF(StringField(Lin$,10,","))
TempA(n) = ValF(StringField(Lin$,11,","))
Selected(n) = Val(StringField(Lin$,12,","))
EndIf ; end if the "if : found" decision
Wend ; end of the loop over the entire file
CloseFile(3) ; close file
ArrayPos = n ; set array position to the end
DisableGadget(8,0) ; enable scrollbar
SetGadgetAttribute(8,#PB_ScrollBar_Maximum,n) ; set scrollbar max value
DisableGadget(14,0) ; enable the "show only UserSaved or AutoSaved data" checkbox
DrawPane() ; draw the radar pane
EndIf ; end of "if file could be opened"
EndIf ; end of "if filename exists"
Case 5 ; autostore checkbox clicked
;SetActiveGadget(6) ; set focus back to the speichern button
Case 6 ; speichern button clicked or SPACE pressed
SaveValues() ; store the vakues to disk
Case 8 ; scrollbar clicked (does NOT update during scroll, unfortunately. Code for similar effect below )
ScrollPos = GetGadgetState(8) ; get scrollbar position
DrawPane() ; (re)draw pane to show this position
Case 9 ; autostoretolerance changed
AutoStoreTolerance.f = GetGadgetState(9)/10 ; get new value (and divide by 10 as eplained at this gadget's creation code above )
SetGadgetText(9,StrF(AutoStoreTolerance.f,1)) ; set new value as text to gadget; this is separate at this gadget
;SetActiveGadget(6) ; set focus back to the save button
Case 11 ; load map - disabled right now
FileName$ = OpenFileRequester("Kartenbild auswaehlen","","Bilder|*.bmp;*.jpg;*.png",0) ; open open file dialog
If FileName$ ; if filename exists
ImageFlag = 1 ; set image is there flag (TODO: do this after laoding file succeeded)
LoadImage(2,FileName$) ; load image (TODO : check if success)
ResizeImage(2,400,400) ; resize image
DrawPane() ; (re)draw radar pane
EndIf ; end of check for filename
; SetActiveGadget(6) ; set focus back to the save button
Case 12 ; set teufe button clicked
a$ = InputRequester("Achtung!","Achtung ! Sie setzten die Teufe auf diesen Meterwert ! (Vorbelegung = aktueller Wert)",Str(Teufe.f)) ; request new value
WriteSerialPortString(#SerialPort,"<S" + Str(Val(a$)*100) + ">",#PB_Ascii) ; send command to sensor hardware
; SetActiveGadget(6) ; set focus back to the save button
Case 13 ; delete trace button clicked
Res = MessageRequester("Achtung!","Achtung! Dies loescht die Bohrspur aus der Anzeige ! Die Daten auf der Festplatte bleiben bestehen.",#PB_MessageRequester_YesNo) ; ask the user again
If Res = #PB_MessageRequester_Yes ; if user is sure
InitArray() ; reset data in memory
EndIf ; that's it. Do nothing otherwise
; SetActiveGadget(6) ; set focus back to the speichern button
Case 14 ; OnlySavedFlag checkbox clicked
; SetActiveGadget(6) ; set focus back to speichern button
OnlySavedFlag = GetGadgetState(14) ; set flag
DrawPane() ; redraw radar pane to show effect of command
Case 15 ; button for defining default storage path clicked
StoragePath$ = PathRequester("Standardmaessigen Speicherpfad festlegen",StoragePath$) ; show "choose path" dialog
If OpenFile(5,"GeoTerm_storage_path.txt") ; try to save value in file
WriteString(5,StoragePath$,#PB_Ascii)
CloseFile(5)
EndIf
Case 16
HideGadget(3,1)
HideGadget(7,0)
FindComm()
OpenPort()
EndSelect
CompilerIf #PB_Compiler_OS = #PB_OS_Windows ; the code below allows one to scroll the scrollbar by the mousewheel - but works only under windows
If EventID = 522 ; see http://www.purebasic.fr/german/viewtopic.php?f=6&t=19534&start=20
If WindowMouseX(0) > 720 ; check if mouse pointer is over scrollbar
If WindowMouseX(0) < 740
Stp.f = ( ArrayPos / 100 ) ; we want max. 100 position to be scrolled
If Stp.f < 1 ; we cannot scroll fractions
Stp.f = 1
EndIf
Gs = Gs - (EventwParam()/7864320) * Stp.f ; calculate new scrollbar position ( which also ist the array position)
If Gs > ArrayPos ; we cannot scroll past the array
Gs = ArrayPos
EndIf
If Gs < 0 ; no negative array indices
Gs = 0
EndIf
SetGadgetState(8,Gs) ; set scrolbar position
ScrollPos = Gs ; set scroll position flag
DrawPane() ; redraw pane
EndIf
EndIf ; end of "is mouse over scrollbar" check
EndIf ; end of EventID check
CompilerEndIf
If EventID = #PB_Event_Repaint ; if window was covered by other window
DrawPane() ; redraw radar pane; the gadgets itself are auto refreshed by PB
EndIf
Until EventID = #PB_Event_CloseWindow ; If the user has pressed on the window close button (which does not exist here), leave the endless event loop. This is the end...
; -------- the program ends here -----------
If PortOpenFlag = 1 ; Check if serial port is open by use of the flag. There is no way to check this by a PB function
CloseSerialPort(#SerialPort) ; close serial port
EndIf
EndIf ; this belongs to if window_open()
End ; this is the ultimate end of the program code and its execution
; ------------ data section - used to store data inside the binary --------------
DataSection
Bing: IncludeBinary("ben.wav") ; include wav file. This must be present on the compile machine in the folder this code resides.
Thread verschoben
Windows>Allgemein
21.02.2012
RSBasic
, brauch ich mit den unübersichtlichen Code nicht weiter angucken 
