10-25-2023, 01:37 AM
Hi friends
here a new step towards a more flexible version of the showcase
news:
1. fixed bug of index selection (loose in previous version for all code more then first 30)
2. added compatibility with QB64pe compiler (before it was not recognized)
3. added compatibility with Jpeg and Jpg screenshot (before it uses only Pgn screenshot)
4. added Status field to the UDT of database for better managing projects with chained files and projects with different files
5. added the managing of Multifiles to Run section via PopUp menu
6. added utility in SUB to translate old Index.txt file to new Index2.txt file with enlarged UDT and automatic definition of Status field.
please enjoy to run and play with this new version, so can find and fix bugs and unwanted features.
Save this file into the same folder of original that you have downloaded.
the first time you must run it as is to adjourn the Index.txt to Index2.txt file, then you can REM out newindex call from main .
you can see in the showcase that the kind of code (monofile/multifile) has been showed in text with red color
moreover when you press R to run the code on the side of showcase a popup list appears and using Up/Down arrows you can navigate it, while pressing Enter you will run the selected (text in Black on Blue background) file.BAS
Incoming an editor to build from zero an Index.txt with its folders' structure.
And another idea is to let to add new projects as files and in the Index.txt file and to let to exclude unwanted projects making thme invisible!
Welcome suggestions and feedbacks
here a new step towards a more flexible version of the showcase
news:
1. fixed bug of index selection (loose in previous version for all code more then first 30)
2. added compatibility with QB64pe compiler (before it was not recognized)
3. added compatibility with Jpeg and Jpg screenshot (before it uses only Pgn screenshot)
4. added Status field to the UDT of database for better managing projects with chained files and projects with different files
5. added the managing of Multifiles to Run section via PopUp menu
6. added utility in SUB to translate old Index.txt file to new Index2.txt file with enlarged UDT and automatic definition of Status field.
please enjoy to run and play with this new version, so can find and fix bugs and unwanted features.
Code: (Select All)
'QB64-PE Sample Showcase
'code by SMcNeill (c) 2022
'code is under standard MIT License -- https://en.wikipedia.org/wiki/MIT_License
'inspired by MIT Licensed code sample archive from https://QB64.com/samples.html
Type Sample_Index_Type
Status As String ' Invisible or Monofile or Multifile or Name of the first file of the chain of files
title As String
author As String
tag As String
link As String
description As String
End Type
'format for data files is:
'Start line [START ENTRY]
'Status ' Invisible or Monofile or Multifile or Name of the first file of the chain of files
'Title This is the same as the directory name
'Author(s)
'Tag(s)
'Link
'Description
'Continue Description as needed.
'Finish Line [END ENTRY]
'All sample information is kept in the above format and organized for ease of reference and editing in any text editor.
Declare CustomType Library ".\direntry"
Function load_dir& (s As String)
Function has_next_entry& ()
Sub close_dir ()
Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare
$Color:32
Screen _NewImage(1280, 720, 32)
ReDim Shared SI(1000) As Sample_Index_Type, count, screenchanged
Dim Shared NoImage: NoImage = _LoadImage("no image.png", 32)
Dim Shared banner: banner = _LoadImage("Flaming Banner.png", 32)
Dim Shared logo: logo = _LoadImage("peWikiLogo.png", 32)
Dim Shared font: font = _LoadFont("courbd.ttf", 64, "monospace")
_Title "QB64-PE Sample Showcase"
NewIndex
Load_Sample_Index
count = count - 1
_Delay 1
_ScreenMove _Middle
SplashScreen
screenchanged = -1
Do
If screenchanged Then
DisplayScreen start, selected, limit
screenchanged = 0
End If
k = _KeyHit
If k = 0 Then k = MouseInput
Select Case k
Case 27: System
Case 18432
selected = selected - 1: If selected < 0 Then selected = 30
screenchanged = -1
Case 20480:
selected = selected + 1: If selected > limit Then selected = 0
screenchanged = -1
Case 20736
start = start + 30: If start >= count Then start = 0
screenchanged = -1
Case 18688
If start = 0 Then
start = count - 30
Else
start = start - 30: If start < 0 Then start = 0
End If
screenchanged = -1
Case Asc("R"), Asc("r")
If SI(selected + start).Status = "Invisible" Then
' if file is excluded
Beep
Else
RunFile SI(selected + start).title, selected + start ' index corrected and added as parameter
End If
End Select
_Limit 30
_Display
Loop
Function MouseInput
Static oldmouse
mousewheel = 0
While _MouseInput:
mousewheel = mousewheel + _MouseWheel
Wend
If mousewheel < 0 Then MouseInput = 18432
If mousewheel > 0 Then MouseInput = 20480
mb = _MouseButton(1)
If mb Then
Select Case _MouseY
Case 650 To 670
Select Case _MouseX
Case 10 To 100: MouseInput = 18688: _Delay .1
Case 110 To 200: MouseInput = 18432: _Delay .1
Case 210 To 300: If Not oldmouse Then MouseInput = 115
End Select
Case 680 To 700
Select Case _MouseX
Case 10 To 100: MouseInput = 20736: _Delay .1
Case 110 To 200: MouseInput = 20480: _Delay .1
Case 210 To 300: If Not oldmouse Then MouseInput = 114
End Select
End Select
End If
oldmouse = mb
End Function
Sub SplashScreen
Cls , SkyBlue
Color BrickRed, Black
_Font font
For i = 0 To 255
Cls , Black
_SetAlpha i, , banner
_SetAlpha i, , logo
_PutImage , banner
_PutImage (100, 100)-Step(256, 256), logo
_PutImage (950, 100)-Step(256, 256), logo
_Limit 30
_Display
Next
text$ = " Proudly Presents... QB64-PE Sample Showcase Inspired by Https://www.qb64.com/samples.html"
l = Len(text$)
PCopy 0, 1
For i = 1 To Len(text$)
PCopy 1, 0
_PrintString (0, 650), Mid$(text$, i)
_Display
_Limit 10
Next
_Font 16
End Sub
Sub DisplayScreen (start, selected, limit)
Static screenshot, blankscreen, titlescreen
If titlescreen = 0 Then titlescreen = _NewImage(560, 290, 32)
If blankscreen = 0 Then blankscreen = _NewImage(930, 390, 32)
finish = start + 30: If finish > count Then finish = count
limit = finish - start
If selected < 0 Then selected = 0
If selected > limit Then selected = limit
Cls , SkyBlue
Color Black, Transparent
Locate 10
For i = start To finish
If i = start + selected Then
_PutImage (20, 20)-(120, 140), logo
_PutImage (160, 20)-(300, 140), banner
Line (0, selected * 16 + 142)-Step(320, 16), Red, BF
Line (330, 20)-(1260, 699), Black, BF
If screenshot <> 0 And screenshot <> -1 Then _FreeImage screenshot
temp$ = "./" + SI(i).title + "/screenshot.png" ' here program searches for only .PNG files
If Not _FileExists(temp$) Then
temp$ = "./" + SI(i).title + "/screenshot.jpg" 'here program searches for .JPG
If Not _FileExists(temp$) Then temp$ = "./" + SI(i).title + "/screenshot.jpeg" 'here program searches for .JPEG
End If
screenshot = _LoadImage(temp$, 32)
If screenshot <> -1 And screenshot <> 0 Then
_PutImage (900, 20)-(1260, 309), screenshot
Else
_PutImage (900, 20)-(1260, 309), NoImage
End If
_Dest titlescreen
Cls , Black
Color White, Black
Print
Print
Print " TITLE : "; SI(i).title
Print " AUTHOR:"; SI(i).author
Print " TAGS :"; SI(i).tag
Print " LINK :"; SI(i).link
Color Red, Black
Print " STATUS :"; SI(i).Status
Color White, Black
_PutImage (330, 20)-(899, 309), titlescreen, 0
_Dest blankscreen
Cls , Black
Color White, Black
Print SI(i).description
_Dest 0
_PutImage (330, 310)-(1260, 699), blankscreen
End If
Print i; Tab(6); Left$(SI(i).title, 35)
Next
Button 10, 650, 100, 670, "PGUP"
Button 110, 650, 200, 670, "UP"
Button 210, 650, 300, 670, "SEARCH"
Button 10, 680, 100, 700, "PGDN"
Button 110, 680, 200, 700, "DOWN"
Button 210, 680, 300, 700, "RUN"
End Sub
Sub Button (x, y, x2, y2, caption$)
Line (x, y)-(x2, y2), DarkGray, BF
Color White, transparent
printX = (x2 - x - _PrintWidth(caption$)) \ 2 + x + 1
printy = (y2 - y - _FontHeight) \ 2 + y + 1
_PrintString (printX, printy), caption$
End Sub
Sub Load_Sample_Index
If _FileExists(".\index2.txt") Then 'it tryes if file index is there
Open ".\index2.txt" For Input As #1 'The only file we should ever have open, in all honesty.
Do Until EOF(1)
Line Input #1, start$
If start$ <> "[START ENTRY]" Then Print "ERROR Reading file. Invalid Start Entry Point.": End
Line Input #1, Statu$ ' Invisible or Monofile or Multifile or Name of the first file of the chain of files
Line Input #1, title$
Line Input #1, author$
Line Input #1, tag$
Line Input #1, link$
description$ = "": finish$ = ""
Do Until finish$ = "[END ENTRY]"
Line Input #1, finish$
finish$ = _Trim$(finish$)
If finish$ <> "[END ENTRY]" Then description$ = description$ + finish$ + Chr$(13)
Loop
SI(count).Status = _Trim$(Statu$)
SI(count).title = _Trim$(title$)
SI(count).author = _Trim$(author$)
SI(count).tag = _Trim$(tag$)
SI(count).link = _Trim$(link$)
SI(count).description = _Trim$(description$)
count = count + 1
Loop
Close
Else
' not found file index.txt
Print " Not found index.txt "
End ' no possible to continue to run program
End If
End Sub
Sub GetFileList (SearchDirectory As String, DirList() As String, FileList() As String)
Const IS_DIR = 1
Const IS_FILE = 2
Dim flags As Long, file_size As Long
ReDim _Preserve DirList(100), FileList(100)
DirCount = 0: FileCount = 0
If load_dir(SearchDirectory + Chr$(0)) Then
Do
length = has_next_entry
If length > -1 Then
nam$ = Space$(length)
get_next_entry nam$, flags, file_size
If flags And IS_DIR Then
DirCount = DirCount + 1
If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
DirList(DirCount) = nam$
ElseIf flags And IS_FILE Then
FileCount = FileCount + 1
If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
FileList(FileCount) = nam$
End If
End If
Loop Until length = -1
close_dir
Else
End If
ReDim _Preserve DirList(DirCount)
ReDim _Preserve FileList(FileCount)
End Sub
Sub RunFile (file$, I%)
ReDim As String Dir(0), File(0)
$If WIN Then
slash$ = "\"
$Else
slash$ = "/"
$End If
GetFileList file$, Dir(), File()
'first, count bas files
max = UBound(File)
ReDim bbas$(max)
For i = 1 To max
If LCase$(Right$(File(i), 4)) = ".bas" Then counter = counter + 1: bas$ = File(i): num = i: bbas$(counter) = bas$
Next
If counter < max Then ReDim _Preserve bbas$(counter)
' selecting file.bas to run
If SI(I%).Status = "Multifile" Then
'pop up menu with files .BAS
a& = _Dest
_Dest 0
chosen = 1
Do
Locate 12, 45
For i = 1 To counter
If i = chosen Then Color Black, Blue Else Color White, Black
Locate , 45: Print bbas$(i)
Next
k = _KeyHit
Select Case k
Case 18432
'up
If chosen > 1 Then chosen = chosen - 1
Case 20480:
'down
If chosen < counter Then chosen = chosen + 1
End Select
_Dest a&
_Display
Loop Until k = 13
ElseIf LCase$(Right$(_Trim$(SI(I%).Status), 4)) = ".bas" Then
' it is a chain of programs and status is the head of the chain
bas$ = LCase$(_Trim$(SI(I%).Status))
ElseIf SI(I%).Status = "Monofile" Or counter = 1 Then
' do nothing because file has already been selected
End If
' running file.bas choosen
' If counter = 1 Then
path$ = _CWD$ + slash$ + file$ + slash$
exe$ = path$ + Left$(bas$, Len(bas$) - 4) + ".exe"
If _FileExists(exe$) Then 'see if that bas file has been turned into an exe file already
Shell Chr$(34) + exe$ + Chr$(34) 'if so, then just run it
Else
b$ = path$ + bas$
If _FileExists("..\qb64pe.exe") Then pe$ = "pe" Else pe$ = "" ' path corrected for working both with QB64 both QB64pe
Shell _Hide "..\qb64" + pe$ + " -c " + Chr$(34) + b$ + Chr$(34) + " -o " + Chr$(34) + exe$ + Chr$(34)
Shell Chr$(34) + exe$ + Chr$(34)
End If
' End If
screenchanged = -1
_KeyClear
End Sub
Sub NewIndex
'this sub adds STATUS field to the original index.txt database
If _FileExists(".\index.txt") Then 'it tryes if file index is there
Open ".\index.txt" For Input As #1 'The only file we should ever have open, in all honesty.
Open ".\index2.txt" For Output As #2
Do Until EOF(1)
Line Input #1, start$
If start$ <> "[START ENTRY]" Then Print "ERROR Reading file. Invalid Start Entry Point.": End
Line Input #1, title$
Line Input #1, author$
Line Input #1, tag$
Line Input #1, link$
description$ = "": finish$ = ""
Do Until finish$ = "[END ENTRY]"
Line Input #1, finish$
finish$ = _Trim$(finish$)
If finish$ <> "[END ENTRY]" Then description$ = description$ + finish$ + Chr$(13)
Loop
' now it looks at directory to know how many files there are in it
file$ = _Trim$(title$)
ReDim As String Dir(0), File(0)
GetFileList file$, Dir(), File()
'first, count bas files
max = UBound(File)
For i = 1 To max
If LCase$(Right$(File(i), 4)) = ".bas" Then counter = counter + 1: bas$ = File(i): num = i
Next
If counter = 1 Then Statu$ = "Monofile" Else Statu$ = "Multifile"
counter = 0
'----------------------
' setting the field of UDT
SI(count).Status = _Trim$(Statu$)
SI(count).title = _Trim$(title$)
SI(count).author = _Trim$(author$)
SI(count).tag = _Trim$(tag$)
SI(count).link = _Trim$(link$)
SI(count).description = _Trim$(description$)
' it writes to index2.txt
Print #2, "[START ENTRY]"
Print #2, SI(count).Status
Print #2, SI(count).title
Print #2, SI(count).author
Print #2, SI(count).tag
Print #2, SI(count).link
Print #2, SI(count).description
Print #2, "[END ENTRY]"
count = count + 1
Loop
Close
End If
End Subthe first time you must run it as is to adjourn the Index.txt to Index2.txt file, then you can REM out newindex call from main .
you can see in the showcase that the kind of code (monofile/multifile) has been showed in text with red color
moreover when you press R to run the code on the side of showcase a popup list appears and using Up/Down arrows you can navigate it, while pressing Enter you will run the selected (text in Black on Blue background) file.BAS
Incoming an editor to build from zero an Index.txt with its folders' structure.
And another idea is to let to add new projects as files and in the Index.txt file and to let to exclude unwanted projects making thme invisible!
Welcome suggestions and feedbacks