Code archives/Miscellaneous/Path(way) Editor
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| Here is an exaple of how to: - Load/Save Data in two formats: binary and as Text file with Data's. - File Requester - Text Scroller - Reading and Using Data. - Use Goto's and Gosub's ( to all you Sphagetti-haters out there ;) ) - A way to Display text which dissapears after few seconds, like OSD. A Picture called 320x250.png will be loaded at the Start, but if its not Found in the (compiled) app's directory, it wont be used. Make sure you have data folder in blitzbasic\bin\ folder or in the Compiled exe's folder if you want to save the data. Screen function needs Decls. If you dont want to install them, just delete the function and the calls to it (its only 1) See here for the File Requester source. | |||||
;====================================================================
; Project: Path(Way) Editor
; Version: 1.0 - 22.7.2015 ~Dan ~
; Author: Dan
; Email: -.-
; Copyright: PD
; Description: You can Draw a path with Mouse, and save the data
; as blitzbasic data statements or as binary file.
; (see ***) To save the data go into Animate mode and see if the
; Path is ok, then choose the format to save.
; Here you can press Left MouseButton to change the moving graphic
; In Edit mode you can press d multiple times to
; load the Demo Data from the data statements.
; m changes the type of drawing.
; Press f4 to see a Scrolling text following the path.
; Hold F1 to exit the scroller.
; L Opens a simple File requester, which displays the binary saved data.
;*** Make sure you have data folder inside blitzbasic\bin\
; folder if you start this demo from the IDE,
; or a data folder in the exe's folder,if you compile it
; Space key shows the last The OnScreenDisplay(OSD) message
; using Blu_Matt's hex2dec function
;====================================================================
; The following decls are needed ONLY for the Screen function
; if you dont want to use it, comment the whole Screen Function
; and remove the calls to it
;
; User32.decls
;;.lib "user32.dll"
;api_GetSystemMetrics% (nIndex%) : "GetSystemMetrics"
;api_GetActiveWindow%():"GetActiveWindow"
;api_GetDC% (hwnd%) : "GetDC"
;api_GetDesktopWindow% () : "GetDesktopWindow"
;
;
; GDI32.decls
;.lib "gdi32.dll"
;api_GetDeviceCaps% (hdc%, nIndex%) : "GetDeviceCaps"
;====================================================================
; Graphic 320,250,32,2 ;Uncomment this
; Graphic 320,250,32,3 ;and this line if you dont want to use Screen function
; Screen fuction gets the desktop resolution and streches the small window to fullscreen
Screen 320,250 ;Comment this, and uncomment the above if you dont want to use Screen function
;Screen 800,600
SetBuffer BackBuffer()
ChangeDir SystemProperty$("appdir")
bgimage=LoadImage("320x250.png")
;TextY function setting:
Global TxtY=-2
;/
;File Requester Setting:
FR_folder$=SystemProperty$("appdir")+"Data\" ; Setting up folders
FR_ext$=".dat"
ReqMaxShow=5
;/
Repeat
Cls
Color $ff,$ff,$ff
TextY (-2,"Usage: (Edit Mode)")
TextY (1,"Left Mouse Button to draw path")
TextY (0,"Right Mouse B.to Animate")
TextY (0,"Middle Mouse B.to Clear (BackSpace <-)")
TextY (0,"L to Load, F4 Scroller demo")
TextY (0,"D to cycle through Demo Data")
TextY (0,"Hold Shift + Left MouseButton to ")
TextY (0,"draw faster. + - Shift speed Modifier ")
TextY (0,"M To change mode, Space for OSD")
TextY (0,"Press ESC to END")
TextY (1,"While in Animate Mode")
TextY (0,"S= Save as BB-Data statements")
TextY (0,"E= Save as Binary Data (see L key)")
Color $ff,0,0
TextY (1,"Press left mouse key to continue")
Flip
Delay 1
Until MouseDown(1)
FlushMouse()
Delay 500
PathwayUsed=0 ; Tracks how many path points are set
PathwayMax=3555 ; How many Pathways to use
demod=-1 ; Demo tracking Variable
SKMSpeed=80 ;Slows down the drawing speed while shift is held down
;Changeable with + and - keys
Dim Pathway(PathwayMax,1) ; Store the pathway data. Coordinates: 0=x, 1=y
Global Timer_m=MilliSecs() ; For the Timer_mSec function
MDL=MilliSecs() ; Left mouse Click Delay in edit mode
AppTitle "Edit Mode"
OSDtimeout=5000 ; OSD - OnScreenDisplay Settings
DKP=MilliSecs()
Gosub SetEditModeOSD
Repeat ;Main Loop (editor)
Cls
Gosub DrawBack
If mmode=1
Text MouseX()-3,MouseY()-7,"X"
Else
Rect MouseX(),MouseY(),1,1,0
EndIf
If KeyDown(42) Or KeyDown(54) ;Left or Right Shift Keys
;Checks if Left Mouse and If slowdown timer is reached
If MouseDown(1)=True And MilliSecs()-MDL=>SKMSpeed And PathwayUsed<PathwayMax ;Left Mousebutton Clicked, and the timer is reached, and PathWay used has not reached The PathWayMax
MDL=MilliSecs()
Gosub PlotIt
EndIf
Else
;Checks if Left Mouse is Pressed and if MDL=0
If MouseDown(1)=True And MDL=0 And PathwayUsed<PathwayMax ;Left Mousebutton Clicked, and It was released allready, and PathWay used has not reached The PathWayMax
MDL=1
Gosub PlotIt
EndIf
If MouseDown(1)=False And MDL=>1 Then MDL=0 ;Wait until Left MouseButton is released
EndIf
If MouseDown(2)=True ;Right Mouse Button shows a Replay
Gosub SetAniModeOSD
Gosub Replay
Gosub SetEditModeOSD
EndIf
If MouseDown(3) Or KeyDown(14) ;Middle Mouse Button Erase pathway(or backspace)
Gosub ClearDim
While MouseDown(3) Or KeyDown(14) ;Wait untill the keys are released
Delay 1
Wend
EndIf
If KeyDown(13) Or KeyDown(78) ; + Numpad +
SKMSpeed=SKMSpeed-5
If SKMSpeed<=0 Then SKMSpeed=0
EndIf
If KeyDown(12) Or KeyDown(74) ; - Numpad -
SKMSpeed=SKMSpeed+5
If SKMSpeed >700 Then SKMSpeed=700
EndIf
If KeyDown(38) ;l to load
AppTitle "Loader"
Gosub FileRequester
If FR_Error=0 And Toload$<>""
Gosub loaddata
DKP=MilliSecs()
OSDText$="Loaded File:"
OSDText1$=ToLoad$
OSDText2$=""
Else
OSDText$="File Requester: Error Loading"
If Fr_Error=1
OSDText2$="Folder does not exists"
OSDText1$=FR_folder$
DKP=MilliSecs()
Else
OSDText1$="Cancelled or No files"
OSDText2$=""
EndIf
AppTitle "Edit Mode"
FlushKeys
Delay 250
EndIf
EndIf
If KeyDown(50) ;M for Mode
mmode=Not mmode
While KeyDown(50)
Delay 1
Wend
EndIf
If KeyDown(62) And pathwayused>0 ;F4 for scroller
Gosub scrollit
Delay 100
FlushKeys
Gosub SetEditModeOSD
ElseIf KeyDown(62) And PathwayUsed=0 ;No pathway set, display error msg
DKP=MilliSecs() ; OSD - OnScreenDisplay Settings
OSDText$="No Pathways set !"
OSDText1$=" Use the Left mouse button"
OSDText2$=" or D for demo path "
FlushKeys()
AppTitle "Edit Mode"
EndIf
If KeyDown(32) ;D to load Demo data
Gosub ClearDim
demod=(demod+1) Mod 3 ;Cycle demod from 0 to 2
Select demod
Case 0
Restore demo
Case 1
Restore demo1
Case 2
Restore demo2
End Select
Read PathwayUsed ;Here we have no error checking, assuming that the data is correct
For LoopX=0 To PathwayUsed-1 ;Read the data into Pathway()
Read Pathway(LoopX,0)
Read Pathway(LoopX,1)
Next
While KeyDown(32) ;Wait untill D key is released
Delay 1
Wend
DKP=MilliSecs() ; OSD - OnScreenDisplay Settings
OSDText$="Demo data loaded"
OSDText1$="Demo #0"+(demod+1)+" / 03"
OSDText2$=""
EndIf
Flip
Until KeyDown(1) ;/Main Loop /editor
End ; Thats all Folks!
.scrollit
AppTitle "Hold F1 to exit the Scroller"
TEX$=" "
TEX$=TEX$+String$(" ",PathWayUsed) ; Do not change this
; Write new text down here
TEX$=TEX$+"Dan presents : SSTT * Super Scrolling Test Text * "
TEX$=TEX$+"you can Setup the path with the Mouse and save it for later use. "
TEX$=TEX$+"Press F1 to Return to the Editor, visit www.blitzbasic.com and dont forget to subscribe !!! :) .-''-."
TEX$=TEX$+" "
;and above here as Tex$=Tex$+" new text "
TEX$=Tex$+String$(" ",40) ;And as last, to have the smooth text in/out effect
TLE=Len(TEX$)
;frameTimer=CreateTimer(10)
FlushKeys()
DMSpeed=2 ;Demo Scroll-speed Setting (1 fast 4 slowest)
DKP=MilliSecs() ; OSD - OnScreenDisplay Settings
Time_mSec(0)
Repeat
;WaitTimer(frameTimer)
For SY=1 To 2 ;Repeat 2 times
For SX=1 To TLE
THELP$=Mid$(TEX$,SX,PathWayUsed)
Cls
If bgimage<>0 Then DrawBlock bgimage,0,0
Color $ff,$ff,$ff
For SX1=0 To PathWayUsed-1
If KeyHit(59) Then Goto loopend ;F1 Ends it
THELP1$=Mid$(THELP$,SX1+1,1)
If SY=1 Then OutlineText1 (Pathway(sx1,0),Pathway(sx1,1),THELP1$)
If SY=2 Then OutlineText1 (Pathway((PathwayUsed-1)-sx1,0),Pathway((PathWayUsed-1)-sx1,1),THELP1$)
Next
If (KeyDown(13) Or KeyDown(78) ) And MilliSecs()-DKP>250 ; + Numpad +
DMSpeed=DMSpeed-1
DKP=MilliSecs()
If DMSpeed<=1 Then DMSpeed=1
EndIf
If (KeyDown(12) Or KeyDown(74)) And MilliSecs()-DKP>250 ; - Numpad -
DMSpeed=DMSpeed+1
DKP=MilliSecs()
If DMSpeed >4 Then DMSpeed=4
EndIf
While Time_mSec(DMSpeed)>1
Delay 1
Wend
OSDtext$="Demo Text Speed="+DMSpeed
OSDtext1$="Change with + -"
OSDtext2$="F1 = Go Back to Edit Mode"
Gosub OSDtext
Time_mSec(0)
Flip
Next
Next
Until KeyHit(59) ; F1, If ever
.loopend
Delay 1000
FlushKeys()
AppTitle "Edit Mode"
Return
.OSDtext
; Pass OSDtext$ OSDtext1$ OSDtext2$ to display different lines empty will be ignored
; Set OSDtimeout in seconds for display duration
If KeyDown(57) And MilliSecs()-DKP>OSDtimeout Then DKP=MilliSecs()
If MilliSecs()-DKP<OSDtimeout
If OSDtext$<>"" Then OutlineText(3,3+(FontHeight()*2),OSDText$)
If OSDtext1$<>"" Then OutlineText(3,3+(FontHeight()*3),OSDText1$)
If OSDtext2$<>"" Then OutlineText(3,3+(FontHeight()*4),OSDText2$)
EndIf
Return
.ClearDim
For LoopX=0 To PathwayUsed-1
Pathway(LoopX,0)=0
Pathway(LoopX,1)=0
Next
PathwayUsed=0
Return
.PlotIt
Pathway(PathwayUsed,0)=MouseX()
Pathway(PathwayUsed,1)=MouseY()
PathwayUsed=PathwayUsed+1
Return
.DrawBack ;Draws the Background text and every Way-Point for the Edit mode
If bgimage<>0 Then DrawBlock bgimage,0,0
For LoopX=0 To PathwayUsed-1
If LoopX=pathwayUsed-1 Then
Color $ff,00,00
ElseIf LoopX=PathwayUsed-2
Color $ef,$6f,00
ElseIf LoopX=PathwayUsed-3
Color $cf,$af,00
ElseIf LoopX=0
Color $0,$ff,$0
Else
Color $ff,$ff,00
EndIf
If mmode=1
Text Pathway(LoopX,0)-3,Pathway(LoopX,1)-7,"X"
Else
Rect Pathway(LoopX,0),Pathway(LoopX,1),2,2
EndIf
Next
Color $0,$ff,$0 ; The 1st position of the path shall be always seen (here in green)
If mmode=1
Text Pathway(0,0)-3,Pathway(0,1)-7,"X"
Else
Rect Pathway(0,0),Pathway(0,1),2,2
EndIf
Color $80,$f0,$f0
Text 0,0,PathwayUsed+"/"+PathWayMax+" MX="+MouseX()+" MY="+MouseY()+" Shift="+SKMSpeed
Gosub OSDtext
Return
.SetEditModeOSD
OSDtext$="Edit Mode Keys: Esc BackSpace <-"
OSDtext1$="Left MouseB + Shift / M / F4 + - D"
OSDtext2$="L=Load / Middle/Right MouseButton"
Return
.SetAniModeOSD
OSDText1$="Press Right Mouse B. to Edit"
OSDText2$="S=Save Data,E=Export Binary"
OSDText$="Animate Mode Keys:"
Return
.DrawBackReplay ;Draws the Text/or Image if used for the Animate part
Cls
If bgimage<>0 Then DrawImage bgimage,0,0
Gosub OSDtext
Color $ff,$ff,$ff
Text 0,GraphicsHeight()-18,"Nr. ("+Replay+") of {"+PathwayUsed+"} "
Return
.Replay ;Replay Mode
AppTitle "Animate Mode"
Cls
Replay=0
FlushMouse()
Delay 500
Time_mSec(0)
DKP=MilliSecs() ; OSD - OnScreenDisplay Settings
Repeat
If MouseDown(1) And amm=0 ;M for Mode
ammode=(ammode+1) Mod 4
amm=1
EndIf
If Not(MouseDown(1)) And amm=1
amm=0
EndIf
If KeyDown(31) Then savetype=0 : Gosub savedata : DKP=MilliSecs() ;key s
If KeyDown(18) Then savetype=1 : Gosub savedata : DKP=MilliSecs() ;key e
Gosub DrawBackReplay
If Time_mSec(-1)>2 Then Time_mSec(0) : Replay=Replay+1
If Replay>PathwayUsed-1 Then Replay=0
Select ammode
Case 0
Color $00,$ff,$ff
Oval Pathway(Replay,0),Pathway(Replay,1),8,6,1
Color $ff,0,0
Oval Pathway(Replay,0),Pathway(Replay,1),8,6,0
Case 1
Color Rand(0,255),Rand(0,255),Rand(0,255)
Rect Pathway(Replay,0),Pathway(Replay,1),3,3,1
Color $ff,0,$FF
Rect Pathway(Replay,0),Pathway(Replay,1),4,4,0
Case 2
If Replay>0 Then Replay2=Replay-1
If Replay2>0 Then Replay3=Replay2-1
If Replay3>0 Then Replay4=Replay3-1
Color $0,$9f,$ff
Text Pathway(Replay4,0)-3,Pathway(Replay4,1)-7,"w"
Color $0,$bf,$ff
Text Pathway(Replay3,0)-3,Pathway(Replay3,1)-7,"x"
Color $0,$df,$ff
Text Pathway(Replay2,0)-3,Pathway(Replay2,1)-7,"y"
Color $00,$ff,$ff
Text Pathway(Replay,0)-3,Pathway(Replay,1)-7,"z"
Case 3
Color $bc,10,$cd
Rect Pathway(Replay,0),Pathway(Replay,1),1,1,0
End Select
Flip
Until MouseDown(2)
While MouseDown(2) ;Release the Right mousebutton to continue
Delay 10
Wend
FlushMouse
AppTitle "Edit Mode"
DKP=MilliSecs() ; OSD - OnScreenDisplay Settings
Return
; Load Data
.loaddata
; Binary data format:
; $000000 - Pathways used
; $0000 $0000 - LoopX,LoopY coordinates (as many as Pathways used)
If FileSize(FR_folder$+Toload$)=>7 ;Check if file holds at least 7 bytes (see binary data format (at least 1 x,y coordinate pair)
TextY (1,FR_folder$+Toload$)
Gosub ClearDim ;Erase the Pathway()
filein=ReadFile(FR_folder$+Toload$) ;Open the file to read
For LoopX=2 To 0 Step -1 ;Read the PathwayUsed from the File (3 bytes)
RData=ReadByte(filein)
BB$=BB$+Right$(Hex$(RData),2) ;Stick the Bytes together as hex value !
Next
PathwayUsed=hex2dec(BB$) ;Calculate the Decimal value of the readed data and set it into PathWayUsed
bb$="" ;Clear the BB$ to use it later
For LoopX=0 To PathwayUsed-1 ;Start reading X and Y mouse Coordinates from the file
For loopy=0 To 1 ;Read 2 bytes for X, Then 2 bytes for Y
RData=ReadByte(filein) : BB$=BB$+Right$(Hex$(RData),2)
RData=ReadByte(filein) : BB$=BB$+Right$(Hex$(RData),2)
Pathway(LoopX,LoopY)=hex2dec(BB$) : BB$="" ; Calculate The Bytes and set them into PathWay(x,y)
Next
Next
CloseFile(filein) ;Done ?! Close the file.
EndIf
Return
; Save Data
.savedata
Delay 1 ;in case you have 100000 files saved as dat (probably wont, but hey ;) )
FlushKeys
If PathwayUsed=0
OSDText$="Not Saved!!!"
OSDText1$="Reason:No pathways set.Count=0"
OSDText2$="Switch to Edit and add some"
Delay 1000
FlushKeys
Return ; Dont save if no Path(ways) are set
EndIf
fnamenum$=String$("0",4-Len(Str(fname)))+Str(fname) ;Calculate the filename numbers with leading 0'os
If savetype=0 ;0 means user has choosen to export it as Data statements
fileext$=".bb"
Else ;1(else) means to save it in binary format, set the appropriate file ext.
fileext$=".dat"
EndIf
FileName$=FR_folder$+"PathWay_"+fnamenum$+fileext$ ;Forms the filename folder + "pathway_" + filenamenumber
If FileType(FileName$)>0 ; If the file exists ( > 0 )
fname=fname+1 ;increase fname variable
Delay 2
Goto savedata ;and form the filename again, until free filename is found
EndIf
AppTitle "saving file: "+FileName$
file=WriteFile (FileName$)
z=-1 ;counter for data type
Written=0 ;variable to write the data at the end of the loop
If file>0 ;Check if the file could be opened for writing, and if yes:
If savetype=0 ;Header for the data statements :
OSDText2$="as Data File"
WriteLine (file,";Format: Data pathways") ;Some informational text
WriteLine (file,";Data Mouse X,MouseY in Hexadecimal")
WriteLine (file,";You can safely Delete the Last "+Chr$(34)+"ffff"+Chr$(34)+",it is Not used")
; WriteLine (file,";and probably 2~3 last $0000 pairs")
WriteLine (file,"Data "+PathwayUsed) ; Here is the 1st data statement
Else ; For binary data (header)
OSDText2$="as Binary File"
For LoopX=1 To 3 ; write 3 bytes of the hexadecimal PathwayUsed variable
WriteByte (file,hex2dec(Mid$(Hex$(PathwayUsed),(LoopX*2)+1,2)))
Next
EndIf
For LoopX=0 To PathwayUsed-1 ; Mouse X,Y loop of all pathways
If savetype=0 ;As data statements
z=z+1 ;Counts how many data pairs are saved in one line in one data
If z=0 ;z0 means the dataitem$ will hold "data x,y,"
Dataitem$="Data "+"$"+Right$(Hex$(Pathway(LoopX,0)),4)+",$" +Right$(Hex$(Pathway(LoopX,1)),4) + "," : Written=0
ElseIf z>0 And z<=3 ;>0 and <3 the dataitem$ will have "," at the end of the line
Dataitem$=Dataitem$+"$"+Right$(Hex$(Pathway(LoopX,0)),4) +",$" +Right$(Hex$(Pathway(LoopX,1)),4) + "," : Written=0
ElseIf z=4 ;dataitem$ will have the last pair of x,y without ( , )
Dataitem$=DataItem$+"$"+Right$(Hex$(Pathway(LoopX,0)),4) +",$" +Right$(Hex$(Pathway(LoopX,1)),4)
WriteLine (file,Dataitem$)
Written=1 ;Written 1 to bypass the exit loop, or to write the last data items into the file ! important
z=-1
EndIf
Else ;As binary Data
For LoopX=0 To PathwayUsed-1 ; Every pathwayused (-1 because Pathway() is saved at 0 as 1st)
For LoopY=0 To 1 ;Count for X and Y
WriteByte (file,hex2dec(Mid$(Hex$(Pathway(LoopX,LoopY)),5,2))) ;Writes the 1st byte of X or Y
WriteByte (file,hex2dec(Mid$(Hex$(Pathway(LoopX,LoopY)),7,2))) ;Writes the 2nd byte of X or Y
Next
Next
Written=1 ;Needed only for the Data statements
EndIf
Next
If Written=0 ;and Savetype=0 ; written=0 to catch the last pairs of data were not written in some cases
;(if the above loop ends because the pathway end is reached and the z was lower than 4)
WriteLine (file,Dataitem$+Chr$(34)+"FFFF"+Chr$(34)) ;Writes the Lats dataitems and "FFFF" (for readability)
End If
CloseFile (file)
OSDText$="Saved:"
OSDText1$=FileName$
Else ;The file could not be opened for Writing
Cls
AppTitle "Error "+FileName$+" could NOT be saved" ; Show it in the App Titlebar
Color $ff,0,0
; TextY (-2,"") ;Display an error text
; TextY (1,"File could NOT be saved !!!")
; TextY (0,"ERROR! File could NOT be saved !!!")
OSDText$="Error:
If FileType(FR_folder$)=0 ;Displays if the reason was, because the folder doesnt exists (i know it could be checked earlier :p (but it could be deleted meanwhile aswell ^^))
; TextY (0,"Folder does not exist:")
; TextY (0,FR_folder$)
OSDtext1$="Reason: Folder does not exist"
OSDText2$=FR_folder$
EndIf
; TextY (1,"Press any Key on Keyboard")
Color $ff,$ff,$ff
Flip
; WaitKey() ;Wait for a keypress
EndIf
Flip
FlushKeys()
Delay 250
Return
; File Requester
.FileRequester ; Returns filename in ToLoad$, if its empty then it was cancelled or not available
; ; Returns FR_Error - 1 Directory doesnt exists
; before call set :
; FR_folder$="c:\data" ; to the folder which will be checked
; FR_ext$=".*" ; as extension of the file displayed, ".*" for every file
; ReqMaxShow=5 ; set how many files will be displayed at once
;ReqMaxShow=(GraphicsHeight()/FontHeight())-4 ;Use this to have height resolution-dependant number of the displayed items
FR_LoadedFile=0 ;Resets the variable for multiple uses
fr_delay=80 ;Arrow Up/Down Delay time, in millisecs
FR_Error=0
If FileType(FR_folder$)<2 Then ToLoad$="": FR_Error=1 : Goto theend
For fr_x=1 To 2 ;Reads the Current folder 2 times ! (to get the Right number for the Dim)
;Because of the filtering ability, to store only filtered files in the FR_Filename$
FR_DIR=ReadDir(FR_folder$) ;Open the directory for reading
If fr_x=2 ;Second pass, make a dim statement
Dim FR_Filename$(FR_LoadedFile) ;dimensioning the Array
FR_LoadedFile=0 ;reset it for later use
EndIf
Repeat
FR_File$=NextFile$(FR_DIR) ;Get the next file from the directory
If FR_File$="" Then Exit ;Exit the loop if the last file is reached
If FileType(FR_folder$+"\"+FR_File$) = 1 Then ; File Exists !
If Lower$(Right$(FR_File$,Len(FR_ext$)))=FR_ext$ Or FR_ext$=".*" ;Check the extension or every file
FR_LoadedFile=FR_LoadedFile+1 ;1st pass: count the available files
If fr_x=2 Then FR_Filename$(FR_LoadedFile)=FR_File$ ;2ns pass: add to FR_Filename$()
End If
End If
Forever
CloseDir (FR_DIR) ;Close the Directory
If FR_LoadedFile=0 Then ToLoad$="" : Goto theend ;There were no matching Files found,
;set the ToLoad$ as "" and go to the End, bypassing the requester
Next
FR_RequesterPos=1 ;Resetting the variables for multiple calls !
FR_ReqOffset=0
;Check if Enter,Return or Esc keys are Held down
While KeyDown(156) Or KeyDown(28) Or KeyDown(1) ; Delay The Program Execution until theese keys are released
Delay 1
Wend
FlushKeys()
Delay 10
FR_time=MilliSecs() ;Arrow Up and Down delay
Repeat ;Requester Loop
Cls
If bgimage<>0 Then DrawImage bgimage,0,0 ;Draw the background image if available, or skip it ^^
Color $ff,$ff,$ff
TextY (-2,"Please Choose:") ;self expained
Color $FF,$FF,$0
TextY (0, String$("-",40)) ;Displays a line
If KeyDown(200) And MilliSecs()-FR_time>fr_delay ; Arrow Up
FR_time=MilliSecs()
FR_RequesterPos=FR_RequesterPos-1
EndIf
If KeyDown(208) And MilliSecs()-FR_time>fr_delay; Arrow Down
FR_time=MilliSecs()
FR_RequesterPos=FR_RequesterPos+1
EndIf
If KeyDown(156) Or KeyDown(28) ;Return or Enter
Exit
EndIf
If KeyDown(1) ;Esc
ToLoad$="" ; Set the ToLoad$ as ""
Exit
EndIf
If FR_RequesterPos<1 ;Calculating the Highlighted Text position
FR_RequesterPos=1
If FR_ReqOffset>0 ;if it were lower than 0, scroll up
FR_ReqOffset=FR_ReqOffset-1
EndIf
EndIf
If FR_RequesterPos>ReqMaxSHow
FR_RequesterPos=ReqMaxShow
If FR_ReqOffset<FR_LoadedFile-ReqMaxShow ;;if it were lower than 0, scroll down
FR_ReqOffset=FR_ReqOffset+1
EndIf
EndIf
If FR_RequesterPos>FR_LoadedFile Then FR_RequesterPos=FR_LoadedFile ; Dont go below Maximal loaded files
For fr_LX=1 To ReqMaxShow ;This loop displays the filenames available up to the ReqMaxShow
If fr_LX=FR_RequesterPos
Color $0,$ff,$ff ; This is the highlight Color
ToLoad$=FR_Filename$(fr_LX+FR_ReqOffset) ;Set ToLoad$ as the filename
Else
Color $Af,$af,$af ;This is the normal Color
EndIf
If fr_LX <= FR_LoadedFile
TextY (0,FR_Filename$(fr_LX+FR_ReqOffset)) ;Here is the text displayed
Else
;TextY (0,"-empty slot-") ; Uncheck to display Empty Slot if there are not
; enough files to fit the ReqMaxShow display
EndIf
Next
Color $FF,$FF,$0
TextY (0,String$("-",40)) ;Displays a line
Color $ff,$ff,$ff
TextY (0,"Return to Accept, Esc to Cancel")
Delay 10
Flip
Forever ;Requester loop goes on forever and forever (until esc or return) or no files found
.theend
FlushKeys()
Return
Function OutlineText(x,y,Txt$)
Color $30,$50,$90
For zzx=-1 To 1
For zzy=-1 To 1
If zzx<>0 And zzy<>0 Then Text x+zzx,y+zzy,Txt$
Next
Next
Color $ff,$ff,$ff
Text x,y,Txt$
End Function
Function OutlineText1(x,y,Txt$)
Color $90,$50,$30
For zzx=-1 To 0
For zzy=-1 To 0
Text x+zzx,y+zzy,Txt$
Next
Next
Color $ff,$ff,$ff
Text x,y,Txt$
End Function
Function Screen(x,y)
DeskX=api_GetSystemMetrics(0)
DeskY=api_GetSystemMetrics(1)
If x>DeskX Then x=DeskX
If x<64 Then x=64
If y>DeskY Then y=DeskY
If y<64 Then y=64
bits=api_GetDeviceCaps(api_GetDC( api_GetDesktopWindow()),12)
Graphics x,y,bits,2
Graphics x,y,bits,3
api_MoveWindow(api_GetActiveWindow(),0,0,DeskX,DeskY,True)
End Function
Function Time_mSec(x)
;Global Timer_m=MilliSecs() ;<---Put at the start of your program---
; x can be -1<,0 or >0
;- numbers returns miliseconds passed since last function call with 0
;0 resets the timer
;above 0 sets a countdown timer in seconds
If x>0
y1=MilliSecs()-Timer_m
If Len(y1)>2
y2=Left$(y1,Len(y1)-2)
Return x-Int(y2)
Else
Return x
EndIf
ElseIf x=0
Timer_m=MilliSecs()
Else
y1=Left$(MilliSecs(),7)
y2=Left$(Timer_m,7)
Return Int(y1)-Int(y2)
EndIf
End Function
Function TextY (num,txt$)
;Num = How many columns to skip
;Replaces Print with Text
;Every Function call displays the text
;1 line under the old one, like calling
;multiple print statements after eachother.
;
; Set num to -2 to make the text go on top (like locate 0,0)
; Use the Global TxtY=-2 outside this function
;
;Global TxtY=-2 ;Make TxtY global variable for displaying help text
If num=-2
TxtY=0
Else
TxtY=TxtY+(FontHeight()*(num+1))
EndIf
Text 0,TxtY,txt$
End Function
Function hex2dec%(hex_number$)
; Converts the supplied hex number into a decimal number
; If hex_number isn't a valid hex number, then returns -1
; written by Matt Burns (Blu_Matt / matt@blis.co.uk)
Local the_hex$=Upper(Trim(hex_number$)) ; the hex number
Local base_power%=0 ; the current base power
Local base%=16 ; the base to convert from
Local the_dec%=0 ; the decimal representation
Local chars%=0
Local hex_length%=Len(the_hex$) ; current length of the hex
If Left(the_hex$,1)="$" Then ; removes any leading "$"
the_hex$=Right(the_hex$,hex_length%-1)
EndIf
hex_length%=Len(the_hex$) ; current length of the hex
Local chars_left%=hex_length% ; current number of chars left
Local hex_left$=the_hex$ ; current hex left
Repeat
current_hex$=Right(hex_left$,1) ; gets the current hex char
If ((Asc(current_hex$)>=Asc("0")) And (Asc(current_hex$)<=Asc("9"))) Then
hex_dec%=current_hex$ ; digit 0-9
ElseIf ((Asc(current_hex$)>=Asc("A")) And (Asc(current_hex$)<=Asc("F"))) Then
hex_dec%=Asc(current_hex$)-55 ; char A-F
Else
Return -1 ; found an illegal character, aborting...
EndIf
the_dec%=the_dec%+((base%^base_power%)*hex_dec%) ; add the local hex digit to the total
base_power%=base_power%+1 ; increase the base power
chars_left%=chars_left%-1 ; reduce the number of chars left
hex_left$=Left(hex_left$,chars_left%) ; sets the remainder
Until chars_left%=0
Return the_dec% ; return the result
End Function
.demo
Data 152
Data $0002,$0006,$0008,$0009,$000E,$000E,$0015,$0014,$001D,$0013,$0025,$0011,$002E,$000C,$0036,$0006,$0036,$0006,$003C,$000C
Data $0042,$0015,$0049,$0018,$0050,$0017,$0058,$0014,$005F,$0010,$0066,$000B,$006E,$0005,$006E,$0005,$0075,$0010,$007D,$0015
Data $0087,$0019,$0090,$0018,$0099,$0015,$00A2,$0011,$00AA,$000D,$00B2,$0007,$00B9,$0004,$00B9,$0004,$00B9,$0004,$00C0,$000E
Data $00C9,$0015,$00D2,$0016,$00DC,$0016,$00E6,$0016,$00EE,$0014,$00F5,$0010,$00FD,$000E,$0105,$000A,$010D,$0006,$010D,$0006
Data $010D,$0006,$0115,$000E,$0118,$0019,$0119,$0024,$0120,$0029,$0127,$0023,$012A,$0017,$012E,$000D,$0131,$0004,$0131,$0004
Data $0134,$0010,$0139,$0019,$013F,$001E,$013E,$001E,$0136,$0024,$012F,$0029,$012A,$0032,$0128,$003C,$0128,$0045,$0128,$004E
Data $0129,$0059,$012D,$0064,$0131,$006E,$0138,$0076,$013D,$0080,$013D,$0080,$0135,$0085,$012B,$0087,$0121,$008C,$0119,$0094
Data $011A,$00A0,$0124,$00A8,$012C,$00AF,$0135,$00B6,$013B,$00BA,$013B,$00BA,$013B,$00BA,$013B,$00BA,$013B,$00BA,$0134,$00C1
Data $012C,$00C7,$012A,$00D2,$0129,$00DD,$0129,$00E8,$0128,$00F3,$0128,$00F3,$0128,$00F3,$0121,$00EA,$011A,$00E1,$0112,$00D9
Data $0109,$00D0,$0101,$00CF,$00F8,$00D3,$00EE,$00DC,$00E4,$00E7,$00DC,$00EF,$00D2,$00F3,$00CA,$00E9,$00C3,$00DE,$00BA,$00D2
Data $00B0,$00CC,$00A6,$00CC,$009C,$00CC,$0094,$00D3,$008C,$00DB,$0084,$00E5,$0081,$00EF,$0079,$00F3,$0079,$00F3,$0071,$00E8
Data $0069,$00DD,$0060,$00D8,$0057,$00D8,$004E,$00DB,$0046,$00DF,$003D,$00E7,$0035,$00EC,$002E,$00F4,$002E,$00F4,$0025,$00EA
Data $001C,$00DF,$0014,$00D4,$000B,$00D0,$0002,$00CD,$0002,$00CD,$000B,$00C4,$0014,$00BC,$001B,$00B1,$001B,$00A5,$0017,$0099
Data $0010,$0090,$0009,$0087,$0003,$007C,$0003,$007C,$000A,$0074,$0012,$006B,$0013,$0060,$0010,$0055,$000B,$004B,$0006,$0041
Data $0001,$0038,$0001,$0038,$0009,$0034,$0012,$0034,$001B,$002F,$0019,$0025,$0013,$001F,$000C,$0018,$0005,$0014,$0001,$000B
Data $0000,$0004,$0000,$0004,"FFFF"
.demo1
Data 104
Data $013F,$0067,$013A,$005F,$0134,$0057,$012C,$0050,$0121,$004D,$0117,$004D,$010C,$0050,$0104,$0055,$00FE,$005B,$00F7,$0061
Data $00F0,$0068,$00E8,$006E,$00DE,$0074,$00D5,$0078,$00CC,$0077,$00C4,$0073,$00BE,$006C,$00B7,$0062,$00B2,$005A,$00AE,$0052
Data $00A9,$004B,$00A3,$0045,$009A,$0043,$0092,$0046,$008C,$004C,$0086,$0053,$0080,$005A,$007A,$0061,$0074,$0067,$006F,$006E
Data $0068,$0073,$005E,$0076,$0058,$0071,$0054,$006B,$004F,$0062,$004B,$005B,$0048,$0055,$0043,$004D,$003E,$0046,$003A,$0042
Data $0033,$003E,$002C,$003D,$0024,$003E,$001E,$0042,$0017,$0048,$0012,$004E,$000D,$0054,$0008,$005B,$0004,$0063,$0000,$006D
Data $0000,$00AF,$0009,$00A6,$0012,$00A2,$001B,$009D,$0024,$00A1,$002C,$00A9,$0033,$00B2,$003A,$00BA,$0041,$00C2,$0049,$00BD
Data $0052,$00B5,$005D,$00AC,$0066,$00A6,$0072,$00A1,$0080,$009F,$008A,$00A3,$0092,$00A9,$009B,$00B1,$00A0,$00B8,$00A3,$00C3
Data $00A4,$00D0,$00A4,$00DE,$00A7,$00EB,$00AE,$00EC,$00B4,$00E5,$00B7,$00DA,$00BA,$00CC,$00BD,$00BF,$00C0,$00B7,$00C9,$00AF
Data $00D4,$00AD,$00DC,$00AD,$00E2,$00B4,$00E7,$00BB,$00EE,$00C6,$00F4,$00D2,$00F6,$00DD,$00FD,$00E9,$0102,$00ED,$010C,$00ED
Data $0111,$00E5,$0116,$00DC,$0119,$00D2,$011B,$00C7,$011A,$00BC,$011A,$00AE,$0121,$00AE,$0128,$00AE,$0130,$00AF,$0139,$00AF
Data $013E,$00AC,$013E,$009F,$013E,$0090,$013E,$007E
.demo2
Data 12
Data $0033,$0047,$003E,$0047,$004A,$0047,$0054,$0047,$0062,$0048
Data $006E,$0048,$007C,$0048,$0089,$0048,$0096,$0048,$00A3,$0049
Data $00AE,$0049,$00B9,$0049 |
Comments
None.
Code Archives Forum
   |