BikesNTrikes

Developed or developing a new product in PureBasic? Tell the world about it.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

BikesNTrikes

Post by Fangbeast »

Never write for friends!!

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
Amateur Radio, D-STAR/VK3HAF
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: BikesNTrikes

Post by infratec »

Hi,

where is the structure of Program ???

It is not compilable.

Bernd
normeus
Enthusiast
Enthusiast
Posts: 414
Joined: Fri Apr 20, 2012 8:09 pm
Contact:

Re: BikesNTrikes

Post by normeus »

Fangbeast will fix it soon enough in the mean time...
Created it using regular expressions on a text editor called "RJ TextEd".
Of course you are missing the type and other constants but it was nice to come up with this using minimal effort!


missing something like this:

Code: Select all

Structure _program
BikeInitialisationFile.s
BikeInformationPath.s
OwnerName.s
LastWindow.s
CurrentLine.s
CurrentPath.s
CurrentBike.s
PreviewTop.s
PreviewLeft.s
AvailableScroll.s
PreviewWidth.s
PreviewHeight.s
ImageCounter.s
DesktopWidth.s
DesktopHeight.s
QuitValue.s
SearchCueText.s
SearchCueFont.s
SearchNormalFont.s
EndStructure

Global program._program
Norm.
google Translate;Makes my jokes fall flat- Fait mes blagues tombent à plat- Machte meine Witze verpuffen- Eh cumpari ci vo sunari
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: BikesNTrikes

Post by Fangbeast »

infratec wrote:Hi,

where is the structure of Program ???

It is not compilable.

Bernd
Bernd, it was 12:30 in the morning and it was still 28 degrees!! 2 days later, it's still an average of 39 most days and I can barely think my way out of a paper basket and think I broke more things.

It will be a balmy 19 degrees on Sunday and I should be able to think again and fix it. I hope.
Amateur Radio, D-STAR/VK3HAF
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: BikesNTrikes

Post by Fangbeast »

Sorry it took so long but the weather has been extreme (We've had averages of 35 degrees most days, hitting 41 other days) and I've had crazy headaches for days (everything else aches too)

I've fixed my mistakes(I hope) and the thing seems to work. Rather than trying to strip all my formatting, the original source code project is posted at the following link.

I'd appreciate any help looking it over, pointing out my mistakes ect.


http://members.westnet.com.au/bangfeast ... 0Trikes.7z
Amateur Radio, D-STAR/VK3HAF
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: BikesNTrikes

Post by infratec »

Code: Select all

#CCHILDREN_TITLEBAR
not found

I commented it out, since it is not in use.
A debug message had 2 " at the end

\BikeInformationPath still points to your directory.
Ok, I had to delete the prefs file (don't put it in the archive)

It's not possible to add a motorbike without picture.
(Maybe I will add the pictures later)

How to delete a complete bike?

I'm not really a friend of drag'n drop.
Maybe you can add (right click) to open a OpenFileRequester with #PB_Requester_MultiSelection.

You should store a 'thumpnail picture' for each added one.
This makes it faster to show it in the list. (less data, no resize)
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: BikesNTrikes

Post by Fangbeast »

#CCHILDREN_TITLEBAR
not found
Yep, knew that. Was for later.
\BikeInformationPath still points to your directory.
Ok, I had to delete the prefs file (don't put it in the archive)
I know, that's how the bloke wanted it. He said his friend is so simple that he wants a prefs file and he would MANUALLY edit it with the path he wanted.

I was too tired to argue with him.
It's not possible to add a motorbike without picture.
That's another condition of his.
How to delete a complete bike?
He didn't want to allow deletes for this bloke. The info was to be kept for legal purposes. I don't argue with idiots:):):)
I'm not really a friend of drag'n drop. Maybe you can add (right click) to open a OpenFileRequester with #PB_Requester_MultiSelection.
Nope. That's what he asked for and that's what I gave him.
You should store a 'thumpnail picture' for each added one.
He didn't want that.
This makes it faster to show it in the list. (less data, no resize)
Bernd, I did as I was told. Did a crappy program with no smart features, no database, no thumbnails. And if I expect to get a few dollars out of this (at all), I will continue to do it their way!!!

When I get around to redoing the recipe program of ours, I will be doing it right and will get everyone's opinion but not the idiot who get the program above:):)
Amateur Radio, D-STAR/VK3HAF
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: BikesNTrikes

Post by infratec »

Yep,

you are right.
If these are the specifications from a customer, you should only implement what he want.
Every else is wasted time. (And time is money :mrgreen: )

Sometimes I have added text and a picture but still get the message that the text is to small.
I'll look for this now.

Ok, restricted: has to be longer then 9 characters :wink:
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: BikesNTrikes

Post by Fangbeast »

infratec wrote: If these are the specifications from a customer, you should only implement what he want.
Every else is wasted time. (And time is money :mrgreen: )
Sometimes I have added text and a picture but still get the message that the text is to small.
I'll look for this now.
I felt violated writing this crappy program but had no choice:):):)
Amateur Radio, D-STAR/VK3HAF
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4747
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: BikesNTrikes

Post by Fangbeast »

**Update**

Client wanted more stuff so I added them, cleaned up the code, added more comments, fixed bugs (added bugs). Seems to work okay.

This link is still correct.

http://members.westnet.com.au/bangfeast ... 0Trikes.7z
Amateur Radio, D-STAR/VK3HAF
Post Reply