Disk/directory based database (Motorbikes for my mate's mate).
A friend wanted me to write something simple for another friend who loses and corrupt things so didn't want it to be a database.
Didn't want graphics, fancy buttons, glowy stuff, databases, nothing.
So, this code allows you to enter a title which becomes a text file on disk with the name of the directory being the name of the text file. You can also drag and drop pictures onto the form which get saved into that directory. You can also search.
Not done:
Saving edited data.
(Can't think of anything else)
Help needed:
Clearing the scrollareagadget is messy because I don't know what I am doing. Was trying to reset it all to initial state, not quite working.
Did I mention "Help needed"??? :)
Code: Select all
UseJPEGImageDecoder()
Define EventID, MenuID, GadgetID, WindowID
Enumeration 1
#Window_Bikesntrikes
#Window_Bikeinfo
#Window_Bikepicture
EndEnumeration
#WindowIndex = #PB_Compiler_EnumerationValue
Enumeration 1
; Window_Bikesntrikes
#Gadget_Bikesntrikes_Bikelist
#Gadget_Bikesntrikes_Bikepictures
#Gadget_Bikesntrikes_Addbike
#Gadget_Bikesntrikes_Editbike
#Gadget_Bikesntrikes_Search
#Gadget_Bikesntrikes_Exitbike
; Window_Bikeinfo
#Gadget_Bikeinfo_lDocument
#Gadget_Bikeinfo_Document
#Gadget_Bikeinfo_lDrophint
#Gadget_Bikeinfo_Picturelist
#Gadget_Bikeinfo_bSavebike
#Gadget_Bikeinfo_bDeletepicture
#Gadget_Bikeinfo_bExitprogram
; Window_Bikepicture
#Gadget_Bikepicture_Bikepicture
EndEnumeration
#GadgetIndex = #PB_Compiler_EnumerationValue
Enumeration 1
#Image_Bikepicture_Bikepicture
EndEnumeration
#ImageIndex = #PB_Compiler_EnumerationValue
CatchImage(#Image_Bikepicture_Bikepicture, ?_OPT_Bikepicture_Bikepicture)
DataSection
_OPT_Bikepicture_Bikepicture: : IncludeBinary "Images\NoPicture.jpg"
EndDataSection
Procedure.i Window_Bikesntrikes()
If OpenWindow(#Window_Bikesntrikes, 102, 89, 800, 600, "Bikes N' Trikes", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
ListIconGadget(#Gadget_Bikesntrikes_Bikelist, 10, 10, 570, 535, "Bike path", 0, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#LVS_NOCOLUMNHEADER)
AddGadgetColumn(#Gadget_Bikesntrikes_Bikelist, 1, "Bike title", 540)
SetGadgetFont(#Gadget_Bikesntrikes_Bikelist, LoadFont(#Gadget_Bikesntrikes_Bikelist, "Comic Sans MS", 10, 0))
ScrollAreaGadget(#Gadget_Bikesntrikes_Bikepictures, 590, 10, 200, 535, 172, 665, 5, #PB_ScrollArea_Flat|#PB_ScrollArea_BorderLess)
CloseGadgetList()
ButtonGadget(#Gadget_Bikesntrikes_Addbike, 10, 555, 160, 35, "Add a new bike", #PB_Button_Default)
SetGadgetFont(#Gadget_Bikesntrikes_Addbike, LoadFont(#Gadget_Bikesntrikes_Addbike, "Comic Sans MS", 12, 0))
ButtonGadget(#Gadget_Bikesntrikes_Editbike, 175, 555, 160, 35, "Edit old bike")
SetGadgetFont(#Gadget_Bikesntrikes_Editbike, LoadFont(#Gadget_Bikesntrikes_Editbike, "Comic Sans MS", 12, 0))
StringGadget(#Gadget_Bikesntrikes_Search, 340, 555, 240, 35, "")
SetGadgetFont(#Gadget_Bikesntrikes_Search, LoadFont(#Gadget_Bikesntrikes_Search, "Comic Sans MS", 10, 0))
ButtonGadget(#Gadget_Bikesntrikes_Exitbike, 590, 555, 200, 35, "Exit bike program")
SetGadgetFont(#Gadget_Bikesntrikes_Exitbike, LoadFont(#Gadget_Bikesntrikes_Exitbike, "Comic Sans MS", 12, 0))
HideWindow(#Window_Bikesntrikes, 0)
ProcedureReturn WindowID(#Window_Bikesntrikes)
EndIf
EndProcedure
Procedure.i Window_Bikeinfo()
If OpenWindow(#Window_Bikeinfo, 91, 86, 450, 370, "Bike info", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible, WindowID(#Window_Bikesntrikes))
TextGadget(#Gadget_Bikeinfo_lDocument, 10, 15, 110, 20, "Bike description", #PB_Text_Center)
SetGadgetFont(#Gadget_Bikeinfo_lDocument, LoadFont(#Gadget_Bikeinfo_lDocument, "Comic Sans MS", 10, 0))
StringGadget(#Gadget_Bikeinfo_Document, 120, 10, 315, 25, "")
SetGadgetFont(#Gadget_Bikeinfo_Document, LoadFont(#Gadget_Bikeinfo_Document, "", 10, 0))
TextGadget(#Gadget_Bikeinfo_lDrophint, 10, 50, 425, 20, "Drag and drop your pictures from Explorer down below", #PB_Text_Center)
SetGadgetFont(#Gadget_Bikeinfo_lDrophint, LoadFont(#Gadget_Bikeinfo_lDrophint, "Comic Sans MS", 10, 0))
ListIconGadget(#Gadget_Bikeinfo_Picturelist, 10, 75, 425, 245, "Directory", 0, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#LVS_NOCOLUMNHEADER)
AddGadgetColumn(#Gadget_Bikeinfo_Picturelist, 1, "Drop pictures here please!!!", 380)
SetGadgetFont(#Gadget_Bikeinfo_Picturelist, LoadFont(#Gadget_Bikeinfo_Picturelist, "Comic Sans MS", 10, 0))
ButtonGadget(#Gadget_Bikeinfo_bSavebike, 10, 330, 130, 35, "Save bike details")
SetGadgetFont(#Gadget_Bikeinfo_bSavebike, LoadFont(#Gadget_Bikeinfo_bSavebike, "Comic Sans MS", 10, 0))
ButtonGadget(#Gadget_Bikeinfo_bDeletepicture, 155, 330, 135, 35, "Delete a picture")
SetGadgetFont(#Gadget_Bikeinfo_bDeletepicture, LoadFont(#Gadget_Bikeinfo_bDeletepicture, "Comic Sans MS", 10, 0))
ButtonGadget(#Gadget_Bikeinfo_bExitprogram, 305, 330, 130, 35, "Exit this program")
SetGadgetFont(#Gadget_Bikeinfo_bExitprogram, LoadFont(#Gadget_Bikeinfo_bExitprogram, "Comic Sans MS", 10, 0))
HideWindow(#Window_Bikeinfo, 0)
ProcedureReturn WindowID(#Window_Bikeinfo)
EndIf
EndProcedure
Procedure.i Window_Bikepicture()
If OpenWindow(#Window_Bikepicture, 81, 90, 640, 480, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible, WindowID(#Window_Bikesntrikes))
ImageGadget(#Gadget_Bikepicture_Bikepicture, 0, 0, 640, 480, ImageID(#Image_Bikepicture_Bikepicture))
ResizeGadget(#Gadget_Bikepicture_Bikepicture, 0, 0, 640, 480)
ResizeImage(#Image_Bikepicture_Bikepicture, 640, 480)
SetGadgetState(#Gadget_Bikepicture_Bikepicture, ImageID(#Image_Bikepicture_Bikepicture))
HideWindow(#Window_Bikepicture, 0)
ProcedureReturn WindowID(#Window_Bikepicture)
EndIf
EndProcedure
;/// Create a new preferences file
Procedure CreatePreferencesFile()
CreatePreferences(Program\BikeInitialisationFile.s, #PB_Preference_GroupSeparator)
PreferenceGroup("Bike Information")
PreferenceComment(#EmptyString)
WritePreferenceString("Bikes Directory", Program\BikeInformationPath.s)
PreferenceComment(#EmptyString)
PreferenceGroup("Owner Information")
PreferenceComment(#EmptyString)
WritePreferenceString("Owner Name", Program\OwnerName.s)
PreferenceComment(#EmptyString)
ClosePreferences()
EndProcedure
;/// Read an existing preferences file
Procedure ReadPreferencesFile()
If FileSize(Program\BikeInitialisationFile.s) = -1
CreatePreferencesFile()
EndIf
OpenPreferences(Program\BikeInitialisationFile.s, #PB_Preference_GroupSeparator)
PreferenceGroup("Bike Information")
Program\BikeInformationPath.s = ReadPreferenceString("Bikes Directory", Program\BikeInformationPath.s)
PreferenceGroup("Owner Information")
Program\OwnerName.s = ReadPreferenceString("Owner Name", Program\OwnerName.s)
ClosePreferences()
EndProcedure
;/// Save the preferences file
Procedure SavePreferencesFile()
OpenPreferences(Program\BikeInitialisationFile.s, #PB_Preference_GroupSeparator)
PreferenceGroup("Bike Information")
WritePreferenceString("Bikes directory", Program\BikeInformationPath.s)
PreferenceGroup("Owner Information")
WritePreferenceString("Owner Name", Program\OwnerName.s)
ClosePreferences()
EndProcedure
;/// Save a single prererence item
Procedure SavePreferenceItem(GroupName.s, GroupHeading.s, GroupOption.s)
OpenPreferences(Program\BikeInitialisationFile.s, #PB_Preference_GroupSeparator)
PreferenceGroup(GroupName.s)
WritePreferenceString(GroupHeading.s, GroupOption.s)
ClosePreferences()
EndProcedure
;/// Allow only certain input characters
Procedure AllowOnly(Gadget.i, CharacterSet.i = 1)
Select CharacterSet.i
Case 1
ValidChar.s = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz.,!" + Chr(32)
EndSelect
ValidationString.s = GetGadgetText(Gadget.i)
GadgetHandle.i = GadgetID(Gadget.i)
For StartLoop.i = 1 To Len(ValidationString.s)
KeepChar.i = FindString(ValidChar.s, Mid(ValidationString.s, StartLoop.i, 1), 1)
If KeepChar.i = 0
SendMessage_(GadgetHandle.i, #EM_GETSEL, @cPos, 0)
NewString.s = RemoveString(ValidationString.s, Mid(ValidationString.s, StartLoop.i, 1), 1)
SetGadgetText(Gadget.i, NewString.s)
SendMessage_(GadgetHandle.i, #EM_SETSEL, cPos.i - 1, cPos.i - 1)
EndIf
Next
EndProcedure
;/// Get the current windows title bar height. Useful for form element resizing.
Procedure.i GetWindowTitleBarDetails(Window.i)
Protected TitleBarHeight.i
Protected pti.TITLEBARINFO
WindowHandle.i = WindowID(Window.i)
If WindowHandle.i
pti.TITLEBARINFO\cbSize = SizeOf(TITLEBARINFO)
GetTitleBarInfo_(WindowHandle.i, pti)
TitleBarHeight.i = pti\rcTitleBar\bottom - pti\rcTitleBar\top
EndIf
ProcedureReturn TitleBarHeight.i
EndProcedure
;/// Create multipath directories
Procedure.s MakeSureDirectoryPathExists(Directory.s)
ErrorCode.i = SHCreateDirectory(#Null, Directory.s)
Select ErrorCode.i
Case #ERROR_SUCCESS : Message.s = "Okay" ; ResultCode = 0
Case #ERROR_BAD_PATHNAME : Message.s = "Bad directory path" ; ResultCode = 161
Case #ERROR_FILENAME_EXCED_RANGE : Message.s = "Directory path too long" ; ResultCode = 206
Case #ERROR_FILE_EXISTS : Message.s = "Directory already exists" ; ResultCode = 80
Case #ERROR_ALREADY_EXISTS : Message.s = "Directory already exists" ; ResultCode = 183
;Case #ERROR_CANCELLED : Message.s = "The user canceled the operation." ; ResultCode = ??. Not defined in compiler residents
EndSelect
ProcedureReturn Message.s
; Debug MakeSureDirectoryPathExists("c:\1\2\3\4\5\6")
EndProcedure
;/// Drop images from Windows Explorer
Procedure DropPictureFromExplorer()
BikeItems.s = EventDropFiles()
If BikeItems.s
NumberOfBikes.i = CountString(BikeItems.s, #LF$)
If NumberOfBikes.i
For ProcessBikes.i = 1 To NumberOfBikes + 1
CurrentBike.s = StringField(BikeItems.s, ProcessBikes.i, #LF$)
If CurrentBike.s
BikeDirectory.s = GetPathPart(CurrentBike.s)
BikePicture.s = GetFilePart(CurrentBike.s)
If BikeDirectory.s And BikePicture.s
AddGadgetItem(#Gadget_Bikeinfo_Picturelist, #AtTheEndOfTheList, BikeDirectory.s + #LF$ + BikePicture.s)
Else
; Storage directory or bike picture string were missing
EndIf
Else
; There is no bike info in the list to be dropped
EndIf
Next
Else
; Could not find any items in the list to be dropped
EndIf
Else
; No items in the drag and drop operation
EndIf
EndProcedure
;/// Add a new bike
Procedure AddNewBike()
If Window_Bikeinfo()
Program\LastWindow = "Add New Bike"
EnableGadgetDrop(#Gadget_Bikeinfo_Picturelist, #PB_Drop_Files, #PB_Drag_Copy)
SetActiveGadget(#Gadget_Bikeinfo_Document)
Else
; Could not open the AddNewBike window
EndIf
EndProcedure
;/// Edit an existing bike
Procedure EditOldBike()
Program\CurrentLine = GetGadgetState(#Gadget_Bikesntrikes_Bikelist)
If Program\CurrentLine <> #NoLineSelected
Program\CurrentPath.s = GetGadgetItemText(#Gadget_Bikesntrikes_Bikelist, Program\CurrentLine, #MainListPathColumn)
Program\CurrentBike.s = GetGadgetItemText(#Gadget_Bikesntrikes_Bikelist, Program\CurrentLine, #MainListBikeColumn)
If Program\CurrentBike.s <> #EmptyString
If Window_Bikeinfo()
Program\LastWindow = "Edit Old Bike"
EnableGadgetDrop(#Gadget_Bikeinfo_Picturelist, #PB_Drop_Files, #PB_Drag_Copy)
SetGadgetText(#Gadget_Bikeinfo_Document, Program\CurrentBike.s)
DirectoryId.i = ExamineDirectory(#PB_Any, Program\CurrentPath.s, "*.*")
If DirectoryId.i
Repeat
TypeOfFile.i = NextDirectoryEntry(DirectoryId.i)
FileName.s = DirectoryEntryName(DirectoryId.i)
If TypeOfFile.i = #True
Select GetExtensionPart(FileName.s)
Case "bmp", "jpg", "jpeg", "jfif", "tiff", "tga", "gif", "png"
AddGadgetItem(#Gadget_Bikeinfo_Picturelist, #AtTheEndOfTheList, Program\CurrentPath.s + #LF$ + GetFilePart(FileName.s))
EndSelect
EndIf
Until TypeOfFile.i = #False
EndIf
SetActiveGadget(#Gadget_Bikeinfo_Document)
Else
; Could not open the AddNewBike window
EndIf
Else
; There was no bike title on this line
EndIf
Else
; No current line selected
EndIf
EndProcedure
;/// Save new or edited bike info
Procedure SaveBikeInfo()
If Right(Program\BikeInformationPath, 1) <> "\"
Program\BikeInformationPath + "\"
EndIf
CurrentBikeName.s = GetGadgetText(#Gadget_Bikeinfo_Document)
If CurrentBikeName.s <> #EmptyString And Len(CurrentBikeName.s) > 10
Select Program\LastWindow
Case "Add New Bike"
NumberOfBikePictures.i = CountGadgetItems(#Gadget_Bikeinfo_Picturelist) : Debug "Number of bike pictures to save: " + Str(NumberOfBikePictures.i)
If NumberOfBikePictures.i <> #False
ErrorMessage.s = MakeSureDirectoryPathExists(Program\BikeInformationPath + CurrentBikeName.s + "\") : Debug Program\BikeInformationPath + CurrentBikeName.s + "\"
Select ErrorMessage.s
Case "Bad directory path", "Directory path too long", "Directory already exists", "Directory already exists" : Debug ErrorMessage.s
Case "Okay"
BikeTitleTextFile.i = OpenFile(#PB_Any, Program\BikeInformationPath + CurrentBikeName.s + "\" + CurrentBikeName.s + ".txt")
If BikeTitleTextFile.i : Debug "Text file handle aquired: " + Str(BikeTitleTextFile.i)
WriteStringN(BikeTitleTextFile.i, CurrentBikeName.s)
CloseFile(BikeTitleTextFile.i)
For PictureProcessing.i = 0 To NumberOfBikePictures.i -1
OldPicturePath.s = GetGadgetItemText(#Gadget_Bikeinfo_Picturelist, PictureProcessing.i, 0)
OldPictureName.s = GetGadgetItemText(#Gadget_Bikeinfo_Picturelist, PictureProcessing.i, 1)
If CopyFile(OldPicturePath.s + OldPictureName.s, Program\BikeInformationPath + "\" + CurrentBikeName.s + "\" + OldPictureName.s)
If LCase(GetExtensionPart(Path.s + Filename.s)) = "txt"
Filename.s = RemoveString(CurrentBikeName.s, "." + GetExtensionPart(Program\BikeInformationPath + CurrentBikeName.s + "\" + CurrentBikeName.s + ".txt"))
AddGadgetItem(#Gadget_Bikesntrikes_Bikelist, #AtTheEndOfTheList, Program\BikeInformationPath + CurrentBikeName.s + "\" + #LF$ + CurrentBikeName.s)
EndIf
EndIf
Next PictureProcessing.i
EndIf
EndSelect
Else
; No pictures for this bike to copy
EndIf
Case "Edit Old Bike"
EndSelect
Else
; Nothing to save as user left the bike field empty
EndIf
CloseWindow(#Window_Bikeinfo)
EndProcedure
;/// Search for bike info in the list on screen
Procedure SearchBikeInfo()
If GetActiveGadget() = #Gadget_Bikesntrikes_Search
SearchString.s = LCase(GetGadgetText(#Gadget_Bikesntrikes_Search))
SetGadgetText(#Gadget_Bikesntrikes_Search, #EmptyString)
If SearchString.s <> #EmptyString
If FileSize(Program\BikeInformationPath.s) = #FileIsDirectory
ClearGadgetItems(#Gadget_Bikesntrikes_Bikelist)
NewList FoundDirectories.s()
If Program\BikeInformationPath.s <> #EmptyString
If Right(Program\BikeInformationPath.s, 1) = "\"
Program\BikeInformationPath.s = Left(Program\BikeInformationPath.s, Len(Program\BikeInformationPath.s) - 1)
EndIf
AddElement(FoundDirectories.s())
FoundDirectories.s() = Program\BikeInformationPath.s
IndexLevel.i = 0
Repeat
SelectElement(FoundDirectories.s(), IndexLevel.i)
If ExamineDirectory(0, FoundDirectories.s(), "*.*")
Path.s = FoundDirectories.s() + "\"
While NextDirectoryEntry(0)
Filename.s = DirectoryEntryName(0)
Select DirectoryEntryType(0)
Case #PB_DirectoryEntry_File
If LCase(GetExtensionPart(Path.s + Filename.s)) = "txt"
Filename.s = RemoveString(Filename.s, "." + GetExtensionPart(Path.s + Filename.s))
If FindString(Path.s + Filename.s, SearchString.s, 1, #PB_String_NoCase) <> #NoStringMatch
AddGadgetItem(#Gadget_Bikesntrikes_Bikelist, #AtTheEndOfTheList, Path.s + #LF$ + Filename.s)
Else
; No matching string found in the search box
EndIf
EndIf
Case #PB_DirectoryEntry_Directory
Filename.s = DirectoryEntryName(0)
If Filename.s <> ".." And Filename.s <> "."
AddElement(FoundDirectories())
FoundDirectories() = Path + Filename.s
EndIf
EndSelect
Wend
EndIf
IndexLevel.i + 1
Until IndexLevel.i > ListSize(FoundDirectories()) -1
EndIf
Else
; Debug "Bike information directory was not found bozo!!"
EndIf
Else
ClearGadgetItems(#Gadget_Bikesntrikes_Bikelist)
Getbikelist()
; There was no search string in the search box
EndIf
Else
; The search box wasn't active when enter was pressed
EndIf
EndProcedure
;///
Procedure Getbikelist()
If FileSize(Program\BikeInformationPath.s) = #FileIsDirectory
; Debug Program\BikeInformationPath.s + "Was found where you said it was bozo!"
NewList FoundDirectories.s()
If Program\BikeInformationPath.s <> #EmptyString
If Right(Program\BikeInformationPath.s, 1) = "\"
Program\BikeInformationPath.s = Left(Program\BikeInformationPath.s, Len(Program\BikeInformationPath.s) - 1)
EndIf
AddElement(FoundDirectories.s())
FoundDirectories.s() = Program\BikeInformationPath.s
IndexLevel.i = 0
Repeat
SelectElement(FoundDirectories.s(), IndexLevel.i)
If ExamineDirectory(0, FoundDirectories.s(), "*.*")
Path.s = FoundDirectories.s() + "\"
While NextDirectoryEntry(0)
Filename.s = DirectoryEntryName(0)
Select DirectoryEntryType(0)
Case 1
If LCase(GetExtensionPart(Path.s + Filename.s)) = "txt"
Filename.s = RemoveString(Filename.s, "." + GetExtensionPart(Path.s + Filename.s))
AddGadgetItem(#Gadget_Bikesntrikes_Bikelist, #AtTheEndOfTheList, Path.s + #LF$ + Filename.s)
EndIf
Case 2
Filename.s = DirectoryEntryName(0)
If Filename.s <> ".." And Filename.s <> "."
AddElement(FoundDirectories())
FoundDirectories() = Path + Filename.s
EndIf
EndSelect
Wend
EndIf
IndexLevel.i + 1
Until IndexLevel.i > ListSize(FoundDirectories()) -1
EndIf
Else
; Debug "Bike information directory was not found bozo!!"
EndIf
EndProcedure
;///
Procedure Getbikepictures()
;x, y, width, height, scrollwidth, scrollheight, scrollstep
;590, 10, 200, 535, 172, 665, 5
If ListSize(ScrollImage())
Program\PreviewTop = 10 ; Initial position from top
Program\PreviewLeft = 10 ; Preview left position
Program\AvailableScroll = 665 ; Total initial scroll space
Program\PreviewWidth = 195 ; Preview image width
Program\PreviewHeight = 125 ; Preview image height
OpenGadgetList(#Gadget_Bikesntrikes_Bikepictures)
ForEach ScrollImage()
FreeGadget(ScrollImage()\ImageGadgetId)
FreeGadget(ScrollImage()\LabelGadgetId)
Next ScrollImage()
CloseGadgetList()
ClearList(ScrollImage())
SetGadgetAttribute(#Gadget_Bikesntrikes_Bikepictures, #PB_ScrollArea_InnerHeight, Program\AvailableScroll)
;SetGadgetAttribute(#Gadget_Bikesntrikes_Bikepictures, #PB_ScrollArea_Y, Program\AvailableScroll)
EndIf
;
CurrentLine.i = GetGadgetState(#Gadget_Bikesntrikes_Bikelist)
If CurrentLine.i <> #NoLineSelected
PicturePath.s = GetGadgetItemText(#Gadget_Bikesntrikes_Bikelist, CurrentLine.i, #MainListPathColumn)
DirectoryId.i = ExamineDirectory(#PB_Any, PicturePath.s, "*.*")
If DirectoryId.i
Repeat
TypeOfFile.i = NextDirectoryEntry(DirectoryId.i)
FileName.s = DirectoryEntryName(DirectoryId.i)
If TypeOfFile.i = #True
Select GetExtensionPart(FileName.s)
Case "bmp", "jpg", "jpeg", "jfif", "tiff", "tga", "gif", "png"
;Debug PicturePath.s + FileName.s
NewImageNumber.i = LoadImage(#PB_Any, PicturePath.s + FileName.s)
; Only proceed if we got a new image handle
If NewImageNumber.i <> #False
ResizedImage.i = ResizeImage(NewImageNumber.i, Program\PreviewWidth, Program\PreviewHeight, #PB_Image_Smooth)
If ResizedImage.i <> #False
OpenGadgetList(#Gadget_Bikesntrikes_Bikepictures)
NewImageGadget.i = ImageGadget(#PB_Any, Program\PreviewLeft, Program\PreviewTop, Program\PreviewWidth, Program\PreviewHeight, ImageID(NewImageNumber.i))
NewLabelGadget.i = TextGadget(#PB_Any, Program\PreviewLeft, Program\PreviewTop + Program\PreviewHeight, Program\PreviewWidth, 20, GetFilePart(FileName.s), #PB_Text_Center)
AddElement(ScrollImage())
ScrollImage()\ImageGadgetId = NewImageGadget.i
ScrollImage()\LabelGadgetId = NewLabelGadget.i
ScrollImage()\LabelGadgetText = GetGadgetText(NewLabelGadget.i)
ScrollImage()\PictureFilename = PicturePath.s + FileName.s
;ScrollImage()\ImageNumber = ImageCounter.i
SetGadgetData(NewImageGadget.i, NewLabelGadget.i)
;SetGadgetColor(NewLabelGadget.i, #PB_Gadget_BackColor, $BFBFBF)
Program\PreviewTop + Program\PreviewHeight + 5 + 15 + 10
Program\ImageCounter + 1
If Program\ImageCounter > = 5
Program\AvailableScroll + Program\PreviewHeight + 5 + 15 + 10
SetGadgetAttribute(#Gadget_Bikesntrikes_Bikepictures, #PB_ScrollArea_InnerHeight, Program\AvailableScroll)
;SetGadgetAttribute(#Gadget_Bikesntrikes_Bikepictures, #PB_ScrollArea_Y, Program\AvailableScroll)
EndIf
CloseGadgetList()
Else
; "Could not resize the requested image"
EndIf
Else
; "Cannot get new image number"
EndIf
EndSelect
EndIf
Until TypeOfFile.i = #False
EndIf
Else
; Cannot get a current line
EndIf
EndProcedure
;/// Show a picture from the list when it is double clicked on ///
Procedure ShowBikePicture(GadgetID.i)
ForEach ScrollImage()
If ScrollImage()\ImageGadgetId = GadgetID.i
; Message.s = "Image: " + ScrollImage()\LabelGadgetText + #CRLF$
; Message.s + "FileName: " + GetFilePart(ScrollImage()\PictureFilename) + #CRLF$
; Message.s + "Directory: " + GetPathPart(ScrollImage()\PictureFilename) + #CRLF$
; Message.s + "FileSize: " + Str(FileSize(ScrollImage()\PictureFilename))
; MessageRequester("Detected", Message.s)
Break
EndIf
Next
If ScrollImage()\PictureFilename <> #EmptyString
PictureFileStatus.i = FileSize(ScrollImage()\PictureFilename)
If PictureFileStatus.i <> #FileNotFound And PictureFileStatus.i <> #FileIsDirectory
If Window_Bikepicture()
If ScrollImage()\PictureFilename <> #EmptyString
PictureHandle.i = LoadImage(#PB_Any, ScrollImage()\PictureFilename)
If PictureHandle.i
WindowsFrameWidth.i = (WindowWidth(#Window_Bikepicture, #PB_Window_FrameCoordinate) - WindowWidth(#Window_Bikepicture, #PB_Window_InnerCoordinate))
WindowsFrameHeigth.i = (WindowHeight(#Window_Bikepicture, #PB_Window_FrameCoordinate) - WindowHeight(#Window_Bikepicture, #PB_Window_InnerCoordinate))
TaskBarHeight.i = GetWindowTitleBarDetails(#Window_Bikepicture)
PictureWidth.i = ImageWidth(PictureHandle.i) ; HorizontalWidth.i
PictureHeight.i = ImageHeight(PictureHandle.i) ; VerticalHeight.i
MaxInnerWidth.i = Program\DesktopWidth - WindowsFrameWidth.i
MaxInnerHeight = Program\DesktopHeight - WindowsFrameHeigth.i - TaskBarHeight.i
WidthFactor.f = 1.0
HeightFactor.f = 1.0
Factor.f = 1.0
If PictureWidth.i > MaxInnerWidth.i
WidthFactor.f = MaxInnerWidth.i / PictureWidth.i
EndIf
If PictureHeight.i > MaxInnerHeight.i
HeightFactor.f = MaxInnerHeight.i / PictureHeight.i
EndIf
If WidthFactor.f < HeightFactor.f
Factor.f = WidthFactor.f
EndIf
If HeightFactor.f < WidthFactor.f
Factor.f = HeightFactor.f
EndIf
NewWindowWidth.i = PictureWidth.i * Factor.f
NewWindowHeight.i = PictureHeight.i * Factor.f
If PictureHandle.i <> #NoPictureHandle
ResizeWindow(#Window_Bikepicture, (Program\DesktopWidth - NewWindowWidth.i - WindowsFrameWidth.i) / 2, (Program\DesktopHeight - NewWindowHeight.i - WindowsFrameHeigth.i - TaskBarHeight.i) / 2, NewWindowWidth.i, NewWindowHeight.i)
ResizeImage(PictureHandle.i, NewWindowWidth.i, NewWindowHeight.i, #PB_Image_Smooth)
SetGadgetState(#Gadget_Bikepicture_Bikepicture, ImageID(PictureHandle.i))
EndIf
Else
;"The picture could not be loaded or does not exist"
EndIf
Else
; Picture filename was empty, should never happen
EndIf
; Make sure the data form window is topmost
SetActiveWindow(#Window_Bikepicture)
; Make sure the version field is selected
SetActiveGadget(#Gadget_Bikepicture_Bikepicture)
Else
; We could not open up the picture window to show it
EndIf
Else
; We had a filename but no file on disk
EndIf
Else
; Picture filename was empty, should not happen
EndIf
EndProcedure
If Window_Bikesntrikes()
; Set the initial quit value to false
Program\QuitValue = #False
; Read the preferences file for information and owner information
ReadPreferencesFile()
;
AddKeyboardShortcut(#Window_Bikesntrikes, #Keys_StartSearching, #StartSearching)
;
SetWindowTitle(#Window_Bikesntrikes, GetWindowTitle(#Window_Bikesntrikes) + ", Owner: " + Program\OwnerName)
;
SendMessage_(GadgetID(#Gadget_Bikesntrikes_Search), #EM_SETLIMITTEXT, 67, 0)
SendMessage_(GadgetID(#Gadget_Bikesntrikes_Search), #EM_SETCUEBANNER, 1, Program\SearchCueText)
SetGadgetFont(#Gadget_Bikesntrikes_Search, FontID(Program\SearchCueFont))
;
Getbikelist()
;
SetGadgetState(#Window_Bikesntrikes, #FirstItem)
;
PostEvent(#PB_Event_Gadget, #Window_Bikesntrikes, #Gadget_Bikesntrikes_Bikelist, #PB_EventType_Change)
;
SetActiveGadget(#Gadget_Bikesntrikes_Addbike)
;
Repeat
EventID = WaitWindowEvent()
MenuID = EventMenu()
GadgetID = EventGadget()
WindowID = EventWindow()
Select EventID
; Handle any window closing events
Case #PB_Event_CloseWindow
Select WindowID
Case #Window_Bikesntrikes : Program\QuitValue = #True
Case #Window_Bikeinfo : CloseWindow(#Window_Bikeinfo)
Case #Window_Bikepicture : CloseWindow(#Window_Bikepicture)
EndSelect
; Dropping pictures on the data editor
Case #PB_Event_GadgetDrop
Select EventDropType()
Case #PB_Drop_Files
Select GadgetID
Case #Gadget_Bikeinfo_Picturelist : DropPictureFromExplorer()
EndSelect
EndSelect
; Handle menus and keyboard shortcuts
Case #PB_Event_Menu
Select MenuID
Case #StartSearching : SearchBikeInfo()
EndSelect
; Handle window control events
Case #PB_Event_Gadget
Select GadgetID
; Main bike list on the main window
Case #Gadget_Bikesntrikes_Bikelist
Select EventType()
Case #PB_EventType_LeftClick : Getbikepictures()
Case #PB_EventType_Change : Getbikepictures()
EndSelect
; All controls on the main form
Case #Gadget_Bikesntrikes_Search
If GetGadgetText(#Gadget_Bikesntrikes_Search) = #EmptyString
SetGadgetFont(#Gadget_Bikesntrikes_Search, FontID(Program\SearchCueFont))
Else
SetGadgetFont(#Gadget_Bikesntrikes_Search, FontID(Program\SearchNormalFont))
EndIf
Case #Gadget_Bikesntrikes_Addbike : AddNewBike()
Case #Gadget_Bikesntrikes_Editbike : EditOldBike()
Case #Gadget_Bikesntrikes_Search :
Case #Gadget_Bikesntrikes_Exitbike : Program\QuitValue = #True
; All controls on the data editor form
Case #Gadget_Bikeinfo_Document : AllowOnly(#Gadget_Bikeinfo_Document, 1)
Case #Gadget_Bikeinfo_Picturelist :
Select EventType()
Case #PB_EventType_Change : ; ShowBikePicture("DataForm")
EndSelect
Case #Gadget_Bikeinfo_bSavebike : SaveBikeInfo()
Case #Gadget_Bikeinfo_bDeletepicture :
Case #Gadget_Bikeinfo_bExitprogram : CloseWindow(#Window_Bikeinfo)
Default
;Case #Gadget_Bikesntrikes_Bikepictures
Select EventType()
Case #PB_EventType_LeftDoubleClick : ShowBikePicture(GadgetID)
EndSelect
; No more gadget events to process
EndSelect
; No more event id's to process
EndSelect
; No more events to process in this loop
Until Program\QuitValue
;
CloseWindow(#Window_Bikesntrikes)
;
EndIf
;
End