Rem Dark Basic Classic Project: DBC Paint Rem Created: 02/02/2007 18:58:00 Rem Author: TDK_Man Rem Company: Computech Tenerife Rem E-Mail: tdk_man@computechtenerife.com Rem Web Site: http://www.computechtenerife.com/db.htm Rem ***** Main Source File ***** Gosub Setup Do Mx=MouseX(): My=MouseY(): Mc=MouseClick() If Mc=2: Rem Right Mouse Hide/Show Control Panel Gosub ShowHidePanel Endif If Mc=1 and FullViewMode = 1: Rem Menu Not On Screen So Do Drawing Action Gosub DoDrawAction Endif If Mc=1 and FullViewMode = 0 If My > 6 and My < 26: Rem Over Buttons So Select New Option OldDrawMode = DrawMode DrawMode = (Mx-4) / ButtonWidth + 1 If DrawMode < 9 Rem Drawing Tools DTools = 1 For N=0 To Buttons-1 Paste Image N+1,N*ButtonWidth+4,6 Next N Paste Image Buttons+DrawMode,(DrawMode-1)*ButtonWidth+4,6 Else: Rem Non-Drawing Option Selected (Colour/New/Load/Save etc) DTools = 0 Select DrawMode Case 9 Rem Colour Paste Image Buttons+DrawMode,(DrawMode-1)*ButtonWidth+4,6 Paste Image 1002,330,203: Rem Palette Repeat Sync Until MouseClick()=0 ExitPanel=0 Repeat Mx=MouseX(): My=MouseY(): Mc=MouseClick() If Mx>335 and My>208 and Mx<464 and My<370 Rem Show Colour OverColour = Point(Mx,My) If Mc=0 Ink OverColour,0 Box 330+6,203+168,330+133,203+187 Else CurrentColour = OverColour ExitPanel=1 Endif Endif If (Mx<335 or My<208 or Mx>64 or My>370) and Mc>0 Rem Close Palette (Cancel) ExitPanel=1 Endif Sync Until ExitPanel=1 Paste Image 1001,0,0 Paste Image 1000,0,0 DrawMode = OldDrawMode Gosub AllButtonsUp Paste Image Buttons+DrawMode,(DrawMode-1)*ButtonWidth+4,6 EndCase Case 10 Rem New Paste Image Buttons+DrawMode,(DrawMode-1)*ButtonWidth+4,6 Repeat Sync Until MouseClick()=0 CLS Get Image 1001,0,0,800,600: Rem Full Screen Paste Image 1000,0,0: Rem Top Strip DrawMode = OldDrawMode Gosub AllButtonsUp Paste Image Buttons+DrawMode,(DrawMode-1)*ButtonWidth+4,6 EndCase Case 11 Rem Load Paste Image Buttons+DrawMode,(DrawMode-1)*ButtonWidth+4,6 Repeat Sync Until MouseClick()=0 Title$="Load Bitmap": Rem Text to appear at top of fileselector Filter$="BMP": Rem 3 char filter extension (Eg: 'TXT') or *.* for all files Selected=Fileselect(CurDir$,Title$,Filter$) If Selected = 1 Load Image Filename$(0),1001 CurDir$=Path$(0) Endif Paste Image 1001,0,0 Paste Image 1000,0,0 DrawMode = OldDrawMode Gosub AllButtonsUp Paste Image Buttons+DrawMode,(DrawMode-1)*ButtonWidth+4,6 EndCase Case 12 Rem Save Paste Image Buttons+DrawMode,(DrawMode-1)*ButtonWidth+4,6 Repeat Sync Until MouseClick()=0 Title$="Save Bitmap": Rem Text to appear at top of fileselector Filter$="BMP": Rem 3 char filter extension (Eg: 'TXT') or *.* for all files Selected = Fileselect(CurDir$,Title$,Filter$) If Selected = 1 If File Exist(Filename$(0)) Then Delete File Filename$(0) Save Image Filename$(0),1001 CurDir$=Path$(0) Endif Paste Image 1001,0,0 Paste Image 1000,0,0 DrawMode = OldDrawMode Gosub AllButtonsUp Paste Image Buttons+DrawMode,(DrawMode-1)*ButtonWidth+4,6 EndCase Case 13 Rem Exit Delete Bitmap 1 End EndCase EndSelect Endif Endif Repeat Sync Until MouseClick()=0 Endif Sync Loop End Rem *********************************************************** Rem ** PROCEDURES ** Rem *********************************************************** DoDrawAction: Select DrawMode Case 1 Gosub Draw EndCase Case 2 Gosub DLine EndCase Case 3 Gosub DCircle EndCase Case 4 Gosub DFCircle EndCase Case 5 Gosub DBox EndCase Case 6 Gosub DFBox EndCase Case 7 Gosub DSpray EndCase Case 8 EndCase EndSelect Repeat Until MouseClick()=0 Return AllButtonsUp: For N=1 To Buttons: Rem Buttons In Up State (1 to 11) Paste Image N,(N-1)*ButtonWidth+4,6 Next N Return Draw: StartX=Mx: StartY=My Repeat Mx=MouseX(): My=MouseY(): Mc=MouseClick() Line StartX,StartY,Mx,My StartX=Mx: StartY=My Sync Until MouseClick() = 0 Get Image 1001,0,0,800,600: Rem Full Screen Return DLine: StartX=Mx: StartY=My Repeat Mx=MouseX(): My=MouseY(): Mc=MouseClick() Paste Image 1001,0,0 Line StartX,StartY,Mx,My Sync Until MouseClick() = 0 Get Image 1001,0,0,800,600: Rem Full Screen Return DCircle: Hide Mouse Repeat Radius=ABS(MouseX()-Mx) Paste Image 1001,0,0 Circle Mx,My,Radius Sync Until MouseClick()=0 Get Image 1001,0,0,800,600: Rem Full Screen Show Mouse Return DFCircle: Hide Mouse Repeat Radius=ABS(MouseX()-Mx) Paste Image 1001,0,0 SBFillCircle(Mx,My,Radius) Sync Until MouseClick()=0 Get Image 1001,0,0,800,600: Rem Full Screen Show Mouse Return DBox: Hide Mouse StartX=Mx: StartY=My Repeat Mx=MouseX(): My=MouseY(): Mc=MouseClick() If Mx-StartX > 1 and My-StartY > 1 Paste Image 1001,0,0 Get Image 1003,Startx+1,Starty+1,Mx,My Box Startx,Starty,Mx,My Paste Image 1003,Startx+1,Starty+1 Endif Sync Until MouseClick()=0 Get Image 1001,0,0,800,600: Rem Full Screen Show Mouse Return DFBox: Hide Mouse StartX=Mx: StartY=My Repeat Mx=MouseX(): My=MouseY(): Mc=MouseClick() rem If Mx-StartX > 1 and My-StartY > 1 Paste Image 1001,0,0 Box Startx,Starty,Mx,My rem Endif Sync Until MouseClick()=0 Get Image 1001,0,0,800,600: Rem Full Screen Show Mouse Return DSpray: Repeat Mx=MouseX(): My=MouseY(): Mc=MouseClick() Dx = MX+Rnd(40)-20 Dy = MY+Rnd(40)-20 Dot Dx,Dy Inc SyncCounter If SyncCounter = 20 Sync SyncCounter = 0 Endif Until MouseClick() = 0 Get Image 1001,0,0,800,600: Rem Full Screen Return Setup: Set Display Mode 800,600,16 Sync On: Sync Rate 0: CLS 0 StartDir$=Get Dir$(): Rem Starting Directory CurDir$=StartDir$ Get Image 1001,0,0,800,600: Rem Full Screen Rem Required DIM Statements For FileSelector Routines Dim Files$(1000,2): Dim Drv$(26): Dim Temp$(1000,2): Dim GotDrives(1) Dim Path$(1): Dim Filename$(1): Dim SliderHeight(1): Dim FileOffset(1) Buttons = 13 Dim ButtonText$(Buttons) ButtonText$(1) = "Draw" ButtonText$(2) = "Line" ButtonText$(3) = "Circle" ButtonText$(4) = "FCircle" ButtonText$(5) = "Box" ButtonText$(6) = "FBox" ButtonText$(7) = "Spray" ButtonText$(8) = "" ButtonText$(9) = "Colour" ButtonText$(10) = "New" ButtonText$(11) = "Load" ButtonText$(12) = "Save" ButtonText$(13) = "Exit" Ink RGB(255,255,255),0: Box 0,0,799,32 Ink RGB(120,120,120),0: Box 1,1,799,32 Ink RGB(180,180,180),0: Box 1,1,798,31 Set Text Font "Tahoma" Set Text Size 14 DrawMode = 1 ViewMode = 0 ButtonWidth = 60 Randomize Timer() For N=1 To Buttons: Rem Buttons In Up State (1 to 11) MakeButton(N,ButtonWidth,20,0,ButtonText$(N)) Paste Image N,(N-1)*ButtonWidth+4,6 Next N For N=1 To Buttons: Rem Buttons In Down State (12 to 22) MakeButton(N+Buttons,ButtonWidth,20,1,ButtonText$(N)) Next N Paste Image DrawMode+Buttons,0+4,6: Rem Initial Down Button (Draw) Get Image 1000,0,0,800,32: Rem Top Strip Rem Create Colour Palette Create Bitmap 1,800,600 Ink RGB(255,255,255),0: Box 0,0,139,193 Ink RGB(100,100,100),0: Box 1,1,139,193 Ink RGB(170,170,170),0: Box 1,1,138,192 Ink RGB(255,255,255),0: Box 5,5,134,188 Ink 0,0: Box 6,168,133,187 For Y=0 To 16 For X=0 To 255 Step 2 R=X: G=0: B=0 Ink RGB(X,0,0),0 Dot X/2+6,Y+6 Ink RGB(0,X,0),0 Dot X/2+6,Y+16+6 Ink RGB(0,0,X),0 Dot X/2+6,Y+32+6 Next X Next Y Rem Greys For Y=0 To 16 For X=0 To 255 Step 2 Ink RGB(X,X,X),0 Dot X/2+6,Y+48+7 Next X Next Y Rem Green To Red For Y=0 To 255 Step 8 For X=0 To 255 Step 2 Ink RGB(X,Y,0),0 Dot X/2+6,Y/8+64+7 Next X Next Y Rem Red To Blue For Y=0 To 255 Step 8 For X=0 To 255 Step 2 Ink RGB(Y,0,X),0 Dot X/2+6,Y/8+96+7 Next X Next Y Rem Blue To Green For Y=0 To 255 Step 8 For X=0 To 255 Step 2 Ink RGB(0,X,Y),0 Dot X/2+6,Y/8+128+7 Next X Next Y Get Image 1002,0,0,140,194 CLS CurrentColour = 16777215 Ink CurrentColour,0 Set Current Bitmap 0 Return ShowHidePanel: If FullViewMode = 0 FullViewMode = 1 Get Image 1000,0,0,800,32: Rem Top Strip For N = 0 To -32 Step -1 Paste Image 1001,0,0: Rem Full Screen Paste Image 1000,0,N: Rem Top Strip Sync Next N Paste Image 1001,0,0: Rem Full Screen Else FullViewMode = 0 Get Image 1001,0,0,800,600: Rem Full Screen For N = -32 To 0 Paste Image 1000,0,N: Rem Top Strip Sync Next N Paste Image 1000,0,0: Rem Top Strip Endif Repeat Until MouseClick()=0 Return Rem *********************************************************** Rem ** FUNCTIONS ** Rem *********************************************************** Function MakeButton(ImageNum,Width,Height,State,Label$) Create Bitmap 1,800,600 CLS RGB(255,0,0) If State=0 Ink RGB(255,255,255),0: Box 0,0,Width,Height Ink RGB(100,100,100),0: Box 1,1,Width,Height Ink RGB(180,180,180),0: Box 1,1,Width-1,Height-1 Else Ink RGB(0,0,0),0: Box 0,0,Width,Height Ink RGB(220,220,220),0: Box 1,1,Width,Height Ink RGB(180,180,180),0: Box 1,1,Width-1,Height-1 Endif Ink 0,0: Center Text Width/2+1,3,Label$ Get Image ImageNum,0,0,Width+1,Height+1 Set Current Bitmap 0 EndFunction Function SBFillCircle(CX,CY,R) Rem Function By Sven B - Pointless Re-Inventing The Wheel! :) sR = R*R For I = 1 to R h = sqrt(sR-i*i) box CX-i,CY-h,CX+i,CY+h Next I endfunction Rem ** Functions For FileSelector ** Function Rectangle(tlx,tly,w,h) Line tlx,tly,tlx+w,tly Line tlx+w,tly,tlx+w,tly+h Line tlx+w,tly+h,tlx,tly+h Line tlx,tly+h,tlx,tly endfunction function Arrow(Atype,AXpos,AYpos) If AType=1 Rem Up Arrow Line AXpos,AYpos,AXpos-6,AYpos+6 Line AXpos,AYpos,AXpos+6,AYpos+6 Line AXpos,AYpos+1,AXpos-6,AYpos+6+1 Line AXpos,AYpos+1,AXpos+6,AYpos+6+1 Endif If AType=2 Rem Down Arrow For I=0 to 5 Dot AXPos+I,AYPos-I Dot AXPos+I+1,AYPos-I Dot AXPos-I+1,AYPos-I Dot AXPos-I,AYPos-I Next I Endif endfunction Function FileSelect(ProjDir$,Title$,Filter$) TFont$=TEXT FONT$() TSize=TEXT SIZE() Set Text Font "Tahoma" Set Text Size 14 CentreX=Screen Width()/2: TLX=CentreX-127 CentreY=Screen Height()/2: TLY=CentreY-153 OldDir$=Get Dir$() Selected=0 Set Camera View 0,0,1,1 Sync FileOffset(0)=0: Cancel=0: OK=0 Rem ------------------------------------------------------- Ink rgb(255,255,255),0 Rectangle(TLX,TLY,254,306): Rem Top Left Highlight Ink rgb(120,120,120),0 Rectangle(TLX+1,TLY+1,253,305): Rem Bottom Right Shadow Ink rgb(200,200,200),0: Rem Med Grey Background Box TLX+1,TLY+1,TLX+253,TLY+305 Rem ------------------------------------------------------- Ink rgb(120,120,120),0: Rem Dark Grey Bits Rectangle(TLX+12,TLY+29,229,20): Rem Path Box Rectangle(TLX+12,TLY+57,148,177): Rem Files List Box Rectangle(TLX+48,TLY+242,193,19): Rem Filename Box Rectangle(TLX+12,TLY+272,110,20): Rem OK Box Rectangle(TLX+132,TLY+272,110,20): Rem Cancel Box Rectangle(TLX+162,TLY+57,20,15): Rem Up Button Rectangle(TLX+162,TLY+74,20,143): Rem Scroll Box Rectangle(TLX+162,TLY+219,20,15): Rem Down Button Rem ------------------------------------------------------- Ink rgb(255,255,255),0: Rem White Bits Rectangle(TLX+13,TLY+30,228,19): Rem Path Box Rectangle(TLX+13,TLY+58,147,176): Rem Files List Box Rectangle(TLX+49,TLY+243,192,18): Rem Filename Box Rectangle(TLX+13,TLY+273,109,19): Rem OK Box Rectangle(TLX+133,TLY+273,109,19): Rem Cancel Box Rectangle(TLX+163,TLY+58,19,14): Rem Up Button Rectangle(TLX+163,TLY+75,19,142): Rem Scroll Box Rectangle(TLX+163,TLY+220,19,14): Rem Down Button Rem ------------------------------------------------------- Ink rgb(220,220,220),0: Rem Write-To Panels Box TLX+13,TLY+30,TLX+240,TLY+48: Rem Clear Path Box Box TLX+13,TLY+58,TLX+159,TLY+233: Rem Clear Files Box Box TLX+49,TLY+243,TLX+240,TLY+260: Rem Clear Filename Box Box TLX+13,TLY+273,TLX+121,TLY+291: Rem OK Box Box TLX+133,TLY+273,TLX+241,TLY+291: Rem Cancel Box Box TLX+163,TLY+58,TLX+181,TLY+71: Rem Up Button Box TLX+163,TLY+75,TLX+181,TLY+216 : Rem Scroll Box Box TLX+163,TLY+220,TLX+181,TLY+233: Rem Down Button Rem -------------- LABELS ---------------------------------- Ink rgb(250,250,250),0: Rem Filename Label Text TLX+57,TLY+276,"OK" Text TLX+167,TLY+276,"Cancel" Center Text CentreX,TLY+7,Title$: Rem Panel Title Text Text TLX+15,TLY+245, "File:": Rem Filename Label Arrow(1,TLX+172,TLY+60) Arrow(2,TLX+171,TLY+228): Rem Up/Down Arrows Ink 0,rgb(200,200,200) Text TLX+56,TLY+275,"OK" Text TLX+167,TLY+275,"Cancel" Center Text CentreX-1,TLY+6,Title$ Text TLX+14,TLY+244, "File:" Arrow(1,TLX+173,TLY+61) Arrow(2,TLX+172,TLY+229): Rem Up/Down Arrows CD ProjDir$ DriveBoxes(TLX,TLY) FO=FileOffset(0) Scroll=0 NumFiles=UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,0,Scroll) SlidePos=TLY+75 SliderTop=DrawSlider(TLX,TLY,NumFiles) Show Mouse Repeat FSx=MouseX(): FSy=MouseY(): FSc=MouseClick() If FSx>TLX+12 and FSx<TLX+160 and FSy>TLY+57 and FSy<TLY+234 and FSc=1 : Rem Files/Dir List area Selected=Int((FSy-TLY-58)/16)+1+FileOffset(0): FileClick=1 REM ********************** REM SELECT A NEW DIRECTORY REM ********************** If Files$(Selected,2)="Dir": Rem Open Directory And Re-Read Repeat Until MOUSECLICK()=0 T=Timer() DClick=0 Repeat: Rem Double Click routine TClock=Timer()-T DClick=MOUSECLICK() Until DClick=1 or TClock>=250 If DClick=1: Rem Mouse was double-clicked Scroll=0 If Files$(Selected,1)=". <Parent>": Rem Back out of directory CD ".." ProjDir$=Get Dir$() Else: Rem Go Into New Directory CD Files$(Selected,1) ProjDir$=Get Dir$() Endif FileOffset(0)=0: FileClick=0: Selected=0 FO=FileOffset(0) NumFiles=UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,OldNumFiles,Scroll) FO=FileOffset(0) SliderTop=DrawSlider(TLX,TLY,NumFiles) Else: Rem Mouse was single-clicked Scroll=1: OldNumFiles=NumFiles FO=FileOffset(0) NumFiles=UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,OldNumFiles,Scroll) SliderTop=DrawSlider(TLX,TLY,NumFiles) Endif Filename$(0)="" Repeat Until MouseClick()=0 Sync Endif REM ********************** REM SELECT A FILE REM ********************** If Files$(Selected,2)="File" and FileClick=1: Rem Clicked On Filename Filename$(0)=Files$(Selected,1) Repeat Until MOUSECLICK()=0 T=Timer() DClick=0 Repeat: Rem Double Click routine TClock=Timer()-T DClick=MOUSECLICK() Until DClick=1 or TClock>=250 If DClick=1 OK=1: Rem OK to leave fileselector Path$(0)=GET DIR$()+"\" Else Ink 0,rgb(220,220,220) Text TLX+53,TLY+244,Filename$(0): Rem Display Selected file's name FO=FileOffset(0) Scroll=1: OldNumFiles=NumFiles NumFiles=UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,OldNumFiles,Scroll) SliderTop=DrawSlider(TLX,TLY,NumFiles) Endif Endif Repeat Until MouseClick()=0 Sync Endif REM ********************** REM SCROLL FILES UP REM ********************** If FSx>TLX+162 and FSx<TLX+182 and FSy>TLY+57 and FSy<TLY+72 and FSc=1: Rem Scroll List Of Files Up FileOffset(0)=FileOffset(0)-1 If FileOffset(0)<0 Then FileOffset(0)=0 FO=FileOffset(0) Scroll=1: OldNumFiles=NumFiles NumFiles=UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,OldNumFiles,Scroll) SliderTop=DrawSlider(TLX,TLY,NumFiles) Sync Endif REM ********************** REM SCROLL FILES DOWN REM ********************** If FSx>TLX+162 and FSx<TLX+182 and FSy>TLY+219 and FSy<TLY+234 and FSc=1: Rem Scroll List Of Files Down FileOffset(0)=FileOffset(0)+1 If FileOffset(0)+11>NumFiles FileOffset(0)=FileOffset(0)-1 Endif FO=FileOffset(0) Scroll=1: OldNumFiles=NumFiles NumFiles=UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,OldNumFiles,Scroll) SliderTop=DrawSlider(TLX,TLY,NumFiles) Sync Endif REM ********************** REM DRAG SCROLLBAR REM ********************** If FSx>TLX+163 and FSx<TLX+181 and FSy>SliderTop and FSy<SliderTop+SliderHeight(0) and FSc=1: Rem Slider Bar MouseDiff=FSy-SliderTop SliderTop=MoveSlider(TLX,TLY,MouseDiff,NumFiles,Selected) FSc=0 Endif REM ************************* REM CLICK ABOVE SCROLLBAR REM ************************* If FSx>TLX+162 and FSx<TLX+182 and FSy>TLY+74 and FSy<SliderTop and FSc=1: Rem Slider Bar FileOffset(0)=FileOffset(0)-11 If FileOffset(0)<0 Then FileOffset(0)=0 FO=FileOffset(0) Scroll=1: OldNumFiles=NumFiles NumFiles=UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,OldNumFiles,Scroll) SliderTop=DrawSlider(TLX,TLY,NumFiles) Sleep 20 Sync Endif REM ************************* REM CLICK BELOW SCROLLBAR REM ************************* If FSx>TLX+162 and FSx<TLX+182 and FSy>SliderTop+SliderHeight(0) and FSy<TLY+217 and FSc=1: Rem Slider Bar FileOffset(0)=FileOffset(0)+11 If FileOffset(0)+11>NumFiles FileOffset(0)=NumFiles-11 Endif FO=FileOffset(0) Scroll=1: OldNumFiles=NumFiles NumFiles=UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,OldNumFiles,Scroll) SliderTop=DrawSlider(TLX,TLY,NumFiles) Sleep 20 Sync Endif REM ********************** REM ENTER NEW FILENAME REM ********************** If FSx>TLX+42 and FSx<TLX+242 and FSy>TLY+242 and FSy<TLY+262 and FSc=1: Rem Click on Filename Entry Box Ink RGB(220,220,220),0 Box TLX+49,TLY+243,TLX+241,TLY+260: Rem Clear Filename Box Ink 0,RGB(220,220,220) Set Cursor TLX+53,TLY+244 Input Fn$ Fn$=Upper$(Fn$) Ink RGB(220,220,220),0 Box TLX+49,TLY+243,TLX+241,TLY+261: Rem Clear Filename Box If Filter$="*.*" Filename$(0)=Fn$ Else ExtTest$="."+Filter$ If Right$(Fn$,4)<>ExtTest$ Filename$(0)=Fn$+"."+Filter$: Rem Add . and extension Endif Endif Ink 0,RGB(220,220,220): Text TLX+53,TLY+244,Filename$(0) Path$(0)=GET DIR$() OK=1 Endif REM ********************** REM OK BUTTON REM ********************** If FSx>TLX+12 and FSx<TLX+122 and FSy>TLY+272 and FSy<TLY+292 and FSc=1: Rem OK If Files$(Selected,1)<>"" OK=1 Endif Endif REM ********************** REM CANCEL BUTTON REM ********************** If FSx>TLX+132 and FSx<TLX+242 and FSy>TLY+272 and FSy<TLY+292 and FSc=1: Rem Cancel Filename$(0)="" Path$(0)="" OK=0: Cancel=1 CD OldDir$ Endif REM ********************** REM SELECT DRIVE REM ********************** If FSx>TLX+198 and FSx<TLX+242 and FSy>TLY+57 and FSy<TLY+217 and FSc=1: Rem Drives DrBoxX=(FSx-TLX+198)/22: DrBoxY=(FSy-TLY+57)/20 DrNum=DrBoxY*2+DrBoxX+65 If Chr$(DrNum)+":"=Drv$(DrNum-64) Ink rgb(220,220,220),0: Box TLX+13,TLY+30,TLX+240,TLY+48: Rem Clear Path Box CurDrive$=Chr$(DrNum)+":\" CD CurDrive$ DriveBoxes(TLX,TLY): Rem Highlight selected drive FO=FileOffset(0) Scroll=0 NumFiles=UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,OldNumFiles,Scroll) DrawSlider(TLX,TLY,NumFiles) Sync Repeat Until MouseClick()=0 Endif Endif Sync Until Cancel=1 or OK=1 Repeat Until MOUSECLICK()=0 Ink rgb(255,255,255),0 Set Text Font TFont$ Set Text Size TSize EndFunction OK Function UpdatePanel(TLX,TLY,Filter$,ProjDir$,FO,Selected,OldNumFiles,Scroll) FileOffset(0)=FO If Scroll=1: Rem Scrolling so no need to re-read files back in NumFiles=OldNumFiles Else For N=1 To 1000: Rem Clear Out Old Directory Entries Files$(N,1)="": Files$(N,2)="" Temp$(N,1)="": Files$(N,2)="" Next N Count=1: Filename$(0)="": DirCount=0: FileCount=0 Find First Repeat FileType=Get File Type() If FileType=0: Rem If Type Is 'File' FullName$=Get File Name$() Ext$=Right$(FullName$,3) If Filter$="*.*": Rem Display ALL Files Files$(Count,1)=FullName$ Files$(Count,2)="File" Inc Count Inc FileCount Else: Rem Use Filter If Upper$(Ext$)=Filter$ Files$(Count,1)=FullName$ Files$(Count,2)="File" Inc Count Inc FileCount Endif Endif Endif If FileType=1: Rem If Type Is 'Directory' FullDirName$=Get File Name$() If FullDirName$<>".." Files$(Count,1)=FullDirName$ If Files$(Count,1)="." then Files$(Count,1)=". <Parent>" Files$(Count,2)="Dir" Inc Count Inc DirCount Endif Endif Find Next Until Get File Type()=-1: Rem No more files NumFiles=Count-1 Rem Sort All Entries For Display Repeat Swap=0 For N=1 To NumFiles-1 Fl1=Asc(Files$(N,1)) Fl2=Asc(Files$(N+1,1)) If Fl1>Fl2: Rem Characters in wrong position Swap=1 T1$=Files$(N,1) T2$=Files$(N,2) Files$(N,1)=Files$(N+1,1) Files$(N,2)=Files$(N+1,2) Files$(N+1,1)=T1$ Files$(N+1,2)=T2$ Endif Next N Until Swap=0 FCount=1: DCount=1 For N=1 To NumFiles If Files$(N,2)="Dir" : Rem Separate Directories Temp$(DCount,1)=Files$(N,1) Temp$(DCount,2)=Files$(N,2) Inc DCount Else: Rem Separate Files Temp$(FCount+DirCount,1)=Files$(N,1) Temp$(FCount+DirCount,2)=Files$(N,2) Inc FCount Endif Next N For N=1 To NumFiles: Rem Put back into main array Files$(N,1)=Temp$(N,1) Files$(N,2)=Temp$(N,2) Next N Rem Print New Path in Path box Ink rgb(220,220,220),0: Box TLX+13,TLY+30,TLX+240,TLY+48: Rem Clear Path Box Ink 0,rgb(220,220,220) Path$(0)=Get Dir$() If Len(Path$(0))>39 TempPath$=Left$(Path$(0),2)+"\...\"+Right$(Path$(0),32) Text TLX+16,TLY+32,TempPath$: Rem Path Position on Fileselector Else Path$=ProjDir$ Text TLX+16,TLY+32,Path$(0): Rem Path Position on Fileselector Endif Endif Rem ******************* Rem DISLAY ENTRIES Rem ******************* TextXPos=TLX+30: Ty=TLY+42 Ink rgb(220,220,220),0 Box TLX+13,TLY+58,TLX+159,TLY+233: Rem Clear Files Box For N=1 to 11: Rem Fill Files Box (Max 11 Entries) If FileOffset(0)+N<=NumFiles If N=Selected-FileOffset(0): Rem Just clicked on entry Set text opaque Ink 0,rgb(255,255,255) Else Ink 0,rgb(220,220,220) Endif If Files$(FileOffset(0)+N,2)="Dir" Text TextXPos,Ty+N*16,Left$(Files$(FileOffset(0)+N,1),17) Ink 0,0: Box TextXPos-16,Ty+N*16+2,TextXPos-4,Ty+N*16+12 Ink RGB(255,200,0),0: Box TextXPos-15,Ty+N*16+3,TextXPos-5,Ty+N*16+11 Ink RGB(0,0,0),0: Box TextXPos-10,Ty+N*16+2,TextXPos-4,Ty+N*16+4 Ink RGB(220,220,220),0: Box TextXPos-9,Ty+N*16+2,TextXPos-4,Ty+N*16+3 Else Text TextXPos,Ty+N*16,Left$(Files$(FileOffset(0)+N,1),17) Ink RGB(0,0,255),0: Box TextXPos-15,Ty+N*16+2,TextXPos-5,Ty+N*16+12 Ink RGB(255,255,255),0: Box TextXPos-14,Ty+N*16+5,TextXPos-6,Ty+N*16+11 Endif Endif Set text transparent Next N EndFunction NumFiles Function DriveBoxes(TLX,TLY) CurDrive$=Left$(GET DIR$(),2) Rem Get Drive List First Time Function Called If GotDrives(0)=0 GotDrives(0)=1 Perform Checklist For Drives DrCount=Checklist Quantity() For T=1 To 26 Drv$(T)="No Drive" Next T For T=1 To DrCount Dl=Asc(Checklist String$(T))-64 Drv$(Dl)=Checklist String$(T) Next T Endif N=1 For N2=0 to 7: Rem Draw Drive Buttons For N1=0 to 1 D$=Chr$(64+N)+":" : Rem Drives A: To P: Ink rgb(255,255,255),0 Rectangle(N1*22+TLX+198, N2*20+TLY+57,22,20): Rem White Border Ink rgb(200,200,200),0 If CurDrive$=D$ Ink rgb(170,170,170),0: Rem Centre OK Endif Box N1*22+TLX+199,N2*20+TLY+58, N1*22+TLX+219, N2*20+TLY+76: Rem Draw Box Background rem if calculated drive letter = Drive letter from checklist If D$=Drv$(N) Ink rgb(255,255,255),0 Text N1*22+TLX+205, N2*20+TLY+60,D$: Rem the drive letter Ink 0,0 Text N1*22+TLX+204, N2*20+TLY+59,D$: Rem the drive letter Else: Rem Grey out cos drive does not exist Ink rgb(255,255,255),0 Text N1*22+TLX+205, N2*20+TLY+60,D$: Rem the drive letter Ink rgb(150,150,150),0 Text N1*22+TLX+204, N2*20+TLY+59,D$: Rem the drive letter Endif Inc N Next N1 Next N2 Sync EndFunction Function DrawSlider(TLX,TLY,NumFiles) Items=NumFiles SliderHeight(0)=Int(11*(142.0/Items)) MoveRange#=142.0-SliderHeight(0) MoveRatio#=MoveRange#/(Items-11) SlidePos=Int(TLY+75+FileOffset(0)*MoveRatio#) If SlidePos+SliderHeight(0)>TLY+215 Then SlidePos=TLY+215-SliderHeight(0) If Items<12 SliderHeight(0)=140: SlidePos=TLY+75 Endif Ink rgb(220,220,220),0: Rem Write-To Panels Box TLX+163,TLY+75,TLX+181,TLY+216: Rem Scroll Box Ink rgb(255,255,255),0: Rem White Bits Box TLX+163,SlidePos,TLX+165+16,SlidePos+SliderHeight(0)+1: Rem Scroll Button Ink rgb(120,120,120),0: Rem Dark Grey Bits Box TLX+164,SlidePos+1,TLX+165+16,SlidePos+SliderHeight(0)+1: Rem Scroll Button Ink rgb(200,200,200),0: Rem Write To Panel Colour Box TLX+164,SlidePos+1,TLX+165+15,SlidePos+SliderHeight(0): Rem Scroll Button EndFunction SlidePos Function MoveSlider(TLX,TLY,MouseDiff,NumFiles,Selected) Items=NumFiles MoveRange#=142.0-SliderHeight(0) MoveRatio#=MoveRange#/(Items-10) Repeat FSx=MouseX():FSy=MouseY() SlidePos=FSy-MouseDiff If SlidePos<TLY+75 Then SlidePos=TLY+75 If SlidePos+SliderHeight(0)>TLY+215 Then SlidePos=TLY+215-SliderHeight(0) Ink rgb(220,220,220),0: Rem Write-To Panels Box TLX+163,TLY+75,TLX+181,TLY+216: Rem Scroll Box Ink rgb(255,255,255),0: Rem White Bits Box TLX+163,SlidePos,TLX+165+16,SlidePos+SliderHeight(0)+1: Rem Scroll Button Ink rgb(120,120,120),0: Rem Dark Grey Bits Box TLX+164,SlidePos+1,TLX+165+16,SlidePos+SliderHeight(0)+1: Rem Scroll Button Ink rgb(200,200,200),0: Rem Write To Panel Colour Box TLX+164,SlidePos+1,TLX+165+15,SlidePos+SliderHeight(0): Rem Scroll Button FileOffset(0)=Int((SlidePos-TLY-75)/MoveRatio#) TextXPos=TLX+30: Ty=TLY+42 Ink rgb(220,220,220),0 Box TLX+13,TLY+58,TLX+159,TLY+233: Rem Clear Files Box Rem ***** DISPLAY ENTRIES ***** For N=1 to 11: Rem Fill Files Box (Max 11 Entries) If FileOffset(0)+N<=NumFiles set text opaque Ink Rgb(255,255,255),0 If N=Selected-FileOffset(0): Rem Currently Selected Entry set text opaque Ink 0,rgb(255,255,255) Else Ink 0,rgb(220,220,220) Endif If Files$(FileOffset(0)+N,2)="Dir" Text TextXPos,Ty+N*16,Left$(Files$(FileOffset(0)+N,1),17) Ink 0,0: Box TextXPos-16,Ty+N*16+2,TextXPos-4,Ty+N*16+12 Ink RGB(255,200,0),0: Box TextXPos-15,Ty+N*16+3,TextXPos-5,Ty+N*16+11 Ink RGB(0,0,0),0: Box TextXPos-10,Ty+N*16+2,TextXPos-4,Ty+N*16+4 Ink RGB(220,220,220),0: Box TextXPos-9,Ty+N*16+2,TextXPos-4,Ty+N*16+3 Else Text TextXPos,Ty+N*16,Left$(Files$(FileOffset(0)+N,1),17) Ink RGB(0,0,255),0: Box TextXPos-15,Ty+N*16+2,TextXPos-5,Ty+N*16+12 Ink RGB(255,255,255),0: Box TextXPos-14,Ty+N*16+5,TextXPos-6,Ty+N*16+11 Endif Endif Set text transparent Next N Sync Until MouseClick()=0 EndFunction SlidePos