├── .gitignore ├── 7Zip.pbi ├── Base64Lib.pbi ├── CanvasDrag.pbi ├── CocoaHelper.pbi ├── ColorRequesterEx.pbi ├── Complex.pbi ├── CompressHelper.pbi ├── DesktopHelper.pbi ├── DropdownButtonGadget.pbi ├── EnvironmentPaths.pbi ├── FTPHelper.pbi ├── FormatDatePHP.pbi ├── GadgetCommon.pbi ├── GetExifData.pbi ├── Hg.mod.pbi ├── ImproveGadgets.pbi ├── IntStack.pbi ├── JSON.pbi ├── JSON_Helper.pbi ├── ListRequester.pbi ├── MemGadget.pbi ├── OJSON.pbi ├── OSTheme.pbi ├── OS_Names.pbi ├── PBP_Projects.pbi ├── PBShortcuts.pbi ├── PSDL.pbi ├── Podcast.pbi ├── PropertyGadget.pbi ├── README.md ├── RatingGadget.pbi ├── RegEx_Helper.pbi ├── RequesterEx.pbi ├── RotateImage.pbi ├── ScaleImage.pbi ├── ScanFolder.pbi ├── ScintillaBoost.pbi ├── SendKeys_Win.pbi ├── StringHelper.pbi ├── Winamp.pbi ├── WindowFromGadget.pbi ├── XML_Helper.pbi ├── common.pbi ├── ini.pbi └── os.pbi /.gitignore: -------------------------------------------------------------------------------- 1 | ___* 2 | project.cfg 3 | -------------------------------------------------------------------------------- /7Zip.pbi: -------------------------------------------------------------------------------- 1 | ; +--------------+ 2 | ; | 7-Zip Helper | 3 | ; +--------------+ 4 | ; | 2015.10.13 . Added Add7ZipFile and password/flags 5 | ; | 2017.01.06 . Added Examine Files/Folders, Extract File 6 | ; | .03.16 . Made file multiple-include safe, rewrote demo 7 | ; | .04.06 . Delete temporary unzip folder 8 | 9 | ;- 10 | CompilerIf (Not Defined(__7Zip_Included, #PB_Constant)) 11 | #__7Zip_Included = #True 12 | 13 | CompilerIf (#PB_Compiler_IsMainFile) 14 | EnableExplicit 15 | CompilerEndIf 16 | 17 | 18 | 19 | ;- Constants (Public) 20 | 21 | ; Can't start a constant's name with a number, like #7Zip_ 22 | #SevenZip_IncludeVersion = 20170316 23 | 24 | Enumeration ; 7Zip Flags 25 | #SevenZip_EncryptNames = $01 26 | EndEnumeration 27 | 28 | 29 | 30 | ;- 31 | ;- Structures (Private) 32 | 33 | Structure __7ZIPSTRUCT 34 | Init.i 35 | Executable.s 36 | ExitCode.i 37 | Output.s 38 | VersionS.s 39 | VersionI.i 40 | Password.s 41 | Flags.i 42 | ; 43 | nFiles.i 44 | FileList.s 45 | nFolders.i 46 | FolderList.s 47 | EndStructure 48 | 49 | 50 | ;- 51 | ;- Globals (Private) 52 | 53 | Global __7Zip.__7ZIPSTRUCT 54 | 55 | 56 | ;- 57 | ;- Procedures (Private) 58 | 59 | Procedure.i __7Zip_Run(Executable.s, Parameter.s = "", Directory.s = "") 60 | Protected PID.i = #Null 61 | With __7Zip 62 | \ExitCode = 0 63 | \Output = "" 64 | PID = RunProgram(Executable, Parameter, Directory, #PB_Program_Hide | #PB_Program_Open | #PB_Program_Read) 65 | If (PID) 66 | While (ProgramRunning(PID)) 67 | While (AvailableProgramOutput(PID)) 68 | CompilerIf (#PB_Compiler_Version < 540) 69 | \Output + ReadProgramString(PID, #PB_Unicode) + #LF$ 70 | CompilerElse 71 | \Output + ReadProgramString(PID, #PB_UTF8) + #LF$ 72 | CompilerEndIf 73 | Wend 74 | Delay(1) 75 | Wend 76 | \ExitCode = ProgramExitCode(PID) 77 | CloseProgram(PID) 78 | EndIf 79 | EndWith 80 | ProcedureReturn (Bool(PID)) 81 | EndProcedure 82 | 83 | 84 | ;- 85 | ;- Procedures (Public) 86 | 87 | Procedure Reset7Zip() 88 | With __7Zip 89 | \Password = "" 90 | \Flags = #Null 91 | EndWith 92 | EndProcedure 93 | 94 | Procedure Set7ZipPassword(Password.s) 95 | With __7Zip 96 | \Password = Password 97 | EndWith 98 | EndProcedure 99 | 100 | Procedure Set7ZipFlags(Flags.i) 101 | With __7Zip 102 | \Flags = Flags 103 | EndWith 104 | EndProcedure 105 | 106 | Procedure.i Init7Zip(Executable.s = "") 107 | With __7Zip 108 | If (Not \Init) 109 | If (Executable = "") 110 | Executable = GetCurrentDirectory() + "7za.exe" 111 | EndIf 112 | If (__7Zip_Run(Executable)) 113 | Protected i.i = FindString(\Output, "7-Zip (A) ", 1, #PB_String_NoCase) 114 | If (i) 115 | \Executable = Executable 116 | \VersionS = StringField(Trim(Mid(\Output, i + 10)), 1, " ") 117 | \VersionI = Round(100.0 * ValF(\VersionS), #PB_Round_Nearest) 118 | Reset7Zip() 119 | \Init = #True 120 | EndIf 121 | EndIf 122 | EndIf 123 | ProcedureReturn (\Init) 124 | EndWith 125 | EndProcedure 126 | 127 | Procedure.s Get7ZipVersion() 128 | With __7Zip 129 | If (\Init) 130 | ProcedureReturn (\VersionS) 131 | Else 132 | ProcedureReturn ("") 133 | EndIf 134 | EndWith 135 | EndProcedure 136 | 137 | Procedure.i Get7ZipBuildNumber() 138 | With __7Zip 139 | If (\Init) 140 | ProcedureReturn (\VersionI) 141 | Else 142 | ProcedureReturn (0) 143 | EndIf 144 | EndWith 145 | EndProcedure 146 | 147 | Procedure.i Add7ZipFile(Archive.s, File.s) 148 | Protected Result.i = #False 149 | With __7Zip 150 | If (\Init) 151 | If (FileSize(File) >= 0) 152 | Protected Param.s = "a" 153 | Param + " " + #DQUOTE$ + Archive + #DQUOTE$ 154 | Param + " " + #DQUOTE$ + File + #DQUOTE$ 155 | If (\Password) 156 | Param + " -p" + \Password 157 | If (\Flags & #SevenZip_EncryptNames) 158 | Param + " -mhe" 159 | EndIf 160 | EndIf 161 | If (__7Zip_Run(\Executable, Param, GetPathPart(Archive))) 162 | If (\ExitCode = 0) 163 | Result = #True 164 | EndIf 165 | EndIf 166 | EndIf 167 | EndIf 168 | EndWith 169 | ProcedureReturn (Result) 170 | EndProcedure 171 | 172 | Procedure.i Extract7ZipFile(Archive.s, File.s, Destination.s = "") 173 | Protected Result.i = #False 174 | With __7Zip 175 | If (\Init) 176 | If ((FileSize(Archive) >= 0) And (File)) 177 | If (GetPathPart(Archive) = "") 178 | Archive = GetCurrentDirectory() + Archive 179 | EndIf 180 | If (Destination) 181 | If (GetPathPart(Destination) = "") 182 | Destination = GetPathPart(Archive) + Destination 183 | EndIf 184 | Else 185 | Destination = GetPathPart(Archive) 186 | EndIf 187 | If (FileSize(Destination) = -2) 188 | Destination = RTrim(Destination, "\") + "\" + File 189 | EndIf 190 | Protected TempDir.s = GetTemporaryDirectory() + "7ZPB" + "\" 191 | CreateDirectory(TempDir) 192 | Protected TempFile.s = TempDir + GetFilePart(File) 193 | DeleteFile(TempFile) 194 | Protected Param.s = "e" 195 | Param + " " + #DQUOTE$ + Archive + #DQUOTE$ 196 | Param + " -o" + #DQUOTE$ + TempDir + #DQUOTE$ 197 | Param + " " + #DQUOTE$ + File + #DQUOTE$ 198 | Param + " -y" 199 | If (\Password) 200 | Param + " -p" + \Password 201 | If (\Flags & #SevenZip_EncryptNames) 202 | Param + " -mhe" 203 | EndIf 204 | EndIf 205 | If (__7Zip_Run(\Executable, Param, GetPathPart(Archive))) 206 | If (\ExitCode = 0) 207 | CreateDirectory(GetPathPart(Destination)) 208 | DeleteFile(Destination) 209 | If (RenameFile(TempFile, Destination)) 210 | Result = #True 211 | Else 212 | DeleteFile(TempFile) 213 | EndIf 214 | EndIf 215 | EndIf 216 | DeleteDirectory(TempDir, "") 217 | EndIf 218 | EndIf 219 | EndWith 220 | ProcedureReturn (Result) 221 | EndProcedure 222 | 223 | Procedure.i Examine7ZipFiles(Archive.s) 224 | Protected Result.i = 0 225 | With __7Zip 226 | If (\Init) 227 | If (FileSize(Archive) >= 0) 228 | Protected Param.s = "l" 229 | Param + " " + #DQUOTE$ + Archive + #DQUOTE$ 230 | If (\Password) 231 | Param + " -p" + \Password 232 | EndIf 233 | If (__7Zip_Run(\Executable, Param, GetPathPart(Archive))) 234 | If (\ExitCode = 0) 235 | Protected Lines.i = 1 + CountString(\Output, #LF$) 236 | \nFiles = 0 237 | \FileList = "" 238 | \nFolders = 0 239 | \FolderList = "" 240 | Protected i.i 241 | Protected InList.i = #False 242 | Protected NameOffset.i 243 | For i = 1 To Lines 244 | Protected Line.s = StringField(\Output, i, #LF$) 245 | If (InList) 246 | If (Left(Line, 19) = "-------------------") 247 | Break 248 | Else 249 | If (Mid(Line, 21, 1) = "D") 250 | \FolderList + #LF$ + Mid(Line, NameOffset) 251 | \nFolders + 1 252 | Else 253 | \FileList + #LF$ + Mid(Line, NameOffset) 254 | \nFiles + 1 255 | EndIf 256 | EndIf 257 | Else 258 | If Right(Line, 6) = " Name" 259 | NameOffset = Len(Line) - 4 + 1 260 | ElseIf (Left(Line, 19) = "-------------------") 261 | InList = #True 262 | EndIf 263 | EndIf 264 | Next i 265 | \FileList = Mid(\FileList, 2) 266 | \FolderList = Mid(\FolderList, 2) 267 | Result = #True 268 | EndIf 269 | EndIf 270 | EndIf 271 | EndIf 272 | EndWith 273 | ProcedureReturn (Result) 274 | EndProcedure 275 | 276 | Procedure.i Get7ZipFileCount() 277 | ProcedureReturn (__7Zip\nFiles) 278 | EndProcedure 279 | 280 | Procedure.s Get7ZipFileList() 281 | ProcedureReturn (__7Zip\FileList) 282 | EndProcedure 283 | 284 | Procedure.i Get7ZipFolderCount() 285 | ProcedureReturn (__7Zip\nFolders) 286 | EndProcedure 287 | 288 | Procedure.s Get7ZipFolderList() 289 | ProcedureReturn (__7Zip\FolderList) 290 | EndProcedure 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | ;- 300 | ;- Demo Program 301 | 302 | CompilerIf (#PB_Compiler_IsMainFile) 303 | DisableExplicit 304 | 305 | If (Not Init7Zip()) 306 | File.s = OpenFileRequester("7-Zip Commandline", GetHomeDirectory() + "7za.exe", "Executables (*.exe)|*.exe", 0) 307 | If (File) 308 | Init7Zip(File) 309 | Else 310 | End 311 | EndIf 312 | EndIf 313 | 314 | If (Init7Zip()) 315 | Debug "Initialized..." 316 | Debug "Creating dummy files..." 317 | CreateDirectory(GetTemporaryDirectory() + "7Zip_Demo") 318 | SetCurrentDirectory(GetTemporaryDirectory() + "7Zip_Demo") 319 | DeleteFile("simple.7z") 320 | DeleteFile("password.7z") 321 | DeleteFile("encrypted.7z") 322 | If CreateFile(0, "text.txt") 323 | WriteString(0, "Hello World!!!") 324 | CloseFile(0) 325 | EndIf 326 | If CreateFile(0, "chars.bin") 327 | For i = 0 To 255 328 | WriteAsciiCharacter(0, i) 329 | Next i 330 | CloseFile(0) 331 | EndIf 332 | 333 | Debug "Creating simple archive..." 334 | Add7ZipFile("simple.7z", "text.txt") 335 | Add7ZipFile("simple.7z", "chars.bin") 336 | 337 | Debug "Creating archive with password..." 338 | Set7ZipPassword("pWord") 339 | Add7ZipFile("password.7z", "text.txt") 340 | Add7ZipFile("password.7z", "chars.bin") 341 | 342 | Debug "Creating archive with encrypted names..." 343 | Set7ZipFlags(#SevenZip_EncryptNames) 344 | Add7ZipFile("encrypted.7z", "text.txt") 345 | Add7ZipFile("encrypted.7z", "chars.bin") 346 | 347 | Debug "Examining encrypted archive..." 348 | Set7ZipPassword("pWord") 349 | If (Examine7ZipFiles("encrypted.7z")) 350 | CreateDirectory("Extracted") 351 | n = Get7ZipFileCount() 352 | FileList.s = Get7ZipFileList() 353 | For i = 1 To n 354 | File.s = StringField(FileList, i, #LF$) 355 | Debug "Extracting '" + File + "'..." 356 | Extract7ZipFile("encrypted.7z", File, "Extracted\" + File) 357 | Next i 358 | EndIf 359 | 360 | Reset7Zip() 361 | DeleteFile("text.txt") 362 | DeleteFile("chars.bin") 363 | Debug "Done" 364 | RunProgram(GetTemporaryDirectory() + "7Zip_Demo") 365 | Else 366 | Debug "7-Zip could not be initialized" 367 | EndIf 368 | 369 | CompilerEndIf 370 | CompilerEndIf 371 | ;- 372 | -------------------------------------------------------------------------------- /CocoaHelper.pbi: -------------------------------------------------------------------------------- 1 | ; +-------------+ 2 | ; | CocoaHelper | 3 | ; +-------------+ 4 | ; | 2015.11.20 . Creation (PureBasic 5.31) 5 | ; | 2017.05.18 . Multiple-include safe 6 | ; | 2020-06-27 . Added IsDarkMode(), GetSysColor(), GuessWindowColor() 7 | ; | 2021-02-21 . Key-Value Observer for theme changes, setCurrentAppearance 8 | 9 | ;- 10 | CompilerIf (Not Defined(__CocoaHelper_Included, #PB_Constant)) 11 | #__CocoaHelper_Included = #True 12 | 13 | CompilerIf (#PB_Compiler_OS = #PB_OS_MacOS) 14 | 15 | CompilerIf (Not Defined(CocoaHelper_TrackThemeChanges, #PB_Constant)) 16 | #CocoaHelper_TrackThemeChanges = #False 17 | CompilerEndIf 18 | 19 | CompilerIf (#PB_Compiler_IsMainFile) 20 | EnableExplicit 21 | CompilerEndIf 22 | 23 | 24 | ;- Imports 25 | 26 | EnumerationBinary 27 | #NSKeyValueObservingOptionNew 28 | #NSKeyValueObservingOptionOld 29 | EndEnumeration 30 | 31 | #kThemeBrushAlertBackgroundActive = 3 32 | 33 | ImportC "" 34 | HIThemeBrushCreateCGColor(Brush, *Color) 35 | CGColorGetComponents(Color) 36 | CGColorGetNumberOfComponents(Color) 37 | CGColorRelease(Color) 38 | EndImport 39 | 40 | 41 | 42 | ;- 43 | ;- Procedures 44 | 45 | Procedure.i NSColor(RGB.i) 46 | Protected.CGFloat r, g, b, a 47 | r = Red(RGB) / 255.0 48 | g = Green(RGB) / 255.0 49 | b = Blue(RGB) / 255.0 50 | a = 1.0 51 | ProcedureReturn (CocoaMessage(0, 0, "NSColor colorWithDeviceRed:@", @r, "green:@", @g, "blue:@", @b, "alpha:@", @a)) 52 | EndProcedure 53 | 54 | Procedure.i Cocoa_IsDarkMode() 55 | Protected *appearance = CocoaMessage(0, CocoaMessage(0, 0, "NSUserDefaults standardUserDefaults"), "stringForKey:$", @"AppleInterfaceStyle") 56 | If (*appearance) 57 | *appearance = CocoaMessage(0, *appearance, "UTF8String") 58 | If (FindString(PeekS(*appearance, -1, #PB_UTF8), "Dark")) 59 | ProcedureReturn (#True) 60 | EndIf 61 | EndIf 62 | ProcedureReturn (#False) 63 | EndProcedure 64 | 65 | Procedure.i Cocoa_GetSysColor(NSColorName.s) 66 | ; "windowBackgroundColor" 67 | ; "systemGrayColor" 68 | ; "controlBackgroundColor" 69 | ; "textColor" 70 | 71 | Protected.CGFloat r, g, b 72 | Protected NSColor.i, NSColorSpace.i 73 | 74 | ; There is no controlAccentColor on macOS < 10.14 75 | If ((NSColorName = "controlAccentColor") And (OSVersion() < #PB_OS_MacOSX_10_14)) 76 | ProcedureReturn ($D5ABAD) 77 | EndIf 78 | 79 | ; There are no system colors on macOS < 10.10 80 | If ((Left(NSColorName, 6) = "system") And (OSVersion() < #PB_OS_MacOSX_10_10)) 81 | NSColorName = LCase(Mid(NSColorName, 7, 1)) + Mid(NSColorName, 8) 82 | EndIf 83 | 84 | NSColorSpace = CocoaMessage(0, 0, "NSColorSpace deviceRGBColorSpace") 85 | NSColor = CocoaMessage(0, CocoaMessage(0, 0, "NSColor " + NSColorName), "colorUsingColorSpace:", NSColorSpace) 86 | If (NSColor) 87 | CocoaMessage(@r, NSColor, "redComponent") 88 | CocoaMessage(@g, NSColor, "greenComponent") 89 | CocoaMessage(@b, NSColor, "blueComponent") 90 | ProcedureReturn (RGB(r * 255.0, g * 255.0, b * 255.0)) 91 | EndIf 92 | EndProcedure 93 | 94 | Procedure.i Cocoa_GuessWindowColor() 95 | If (OSVersion() >= #PB_OS_MacOSX_10_14) 96 | ProcedureReturn (Cocoa_GetSysColor("windowBackgroundColor")) 97 | Else 98 | Protected Result.i 99 | Protected CGColor.i 100 | HIThemeBrushCreateCGColor(#kThemeBrushAlertBackgroundActive, @CGColor) 101 | If (CGColor) 102 | Protected.i NbComponents = CGColorGetNumberOfComponents(CGColor) 103 | Protected *Components = CGColorGetComponents(CGColor) 104 | 105 | Protected.i r, g, b, c 106 | If (*Components And (NbComponents = 2)) ; gray and alpha 107 | 108 | CompilerIf (#PB_Compiler_Processor = #PB_Processor_x64) ; CGFloat is a double on 64-bit system 109 | c = 255 * PeekD(*Components) 110 | CompilerElse 111 | c = 255 * PeekF(*Components) 112 | CompilerEndIf 113 | 114 | Result = RGB(c, c, c) 115 | 116 | ElseIf (*Components And (NbComponents = 4)) ; RGBA 117 | 118 | CompilerIf (#PB_Compiler_Processor = #PB_Processor_x64) 119 | r = 255 * PeekD(*Components) 120 | g = 255 * PeekD(*Components + 8) 121 | b = 255 * PeekD(*Components + 16) 122 | CompilerElse 123 | r = 255 * PeekF(*Components) 124 | g = 255 * PeekF(*Components + 4) 125 | b = 255 * PeekF(*Components + 8) 126 | CompilerEndIf 127 | 128 | Result = RGB(r, g, b) 129 | EndIf 130 | 131 | CGColorRelease(CGColor) 132 | ProcedureReturn (Result) 133 | EndIf 134 | EndIf 135 | EndProcedure 136 | 137 | Procedure.i Cocoa_SetBackgroundColor(Object.i, RGB.i) 138 | ProcedureReturn (CocoaMessage(0, Object, "setBackgroundColor:", NSColor(RGB))) 139 | EndProcedure 140 | 141 | Procedure.s Cocoa_ClassName(Object.i) 142 | Protected Result.s = "" 143 | If (Object) 144 | CocoaMessage(@Object, Object, "className") 145 | CocoaMessage(@Object, Object, "UTF8String") 146 | Result = PeekS(Object, -1, #PB_UTF8) 147 | EndIf 148 | ProcedureReturn (Result) 149 | EndProcedure 150 | 151 | Procedure.i Cocoa_Superclass(Object.i) 152 | ProcedureReturn (CocoaMessage(0, Object, "superclass")) 153 | EndProcedure 154 | 155 | Procedure.i Cocoa_Superview(Object.i) 156 | ProcedureReturn (CocoaMessage(0, Object, "superview")) 157 | EndProcedure 158 | 159 | 160 | 161 | ;- 162 | ;- Theme Change Detection 163 | 164 | CompilerIf (#CocoaHelper_TrackThemeChanges) ; Monitor OS color scheme changes 165 | 166 | Global *NSKeyValueChangeNewKey.Integer = dlsym_(#RTLD_DEFAULT, "NSKeyValueChangeNewKey") 167 | Global *NSKeyValueChangeOldKey.Integer = dlsym_(#RTLD_DEFAULT, "NSKeyValueChangeOldKey") 168 | 169 | DeclareC KVO(obj, sel, keyPath, object, change, context) 170 | 171 | Global _Cocoa_KVO_Class.i = objc_allocateClassPair_(objc_getClass_("NSObject"), "_Cocoa_KVO", 0) 172 | class_addMethod_(_Cocoa_KVO_Class, sel_registerName_("observeValueForKeyPath:ofObject:change:context:"), @KVO(), "v@:@@@^v") 173 | objc_registerClassPair_(_Cocoa_KVO_Class) 174 | 175 | Global _Cocoa_KVO.i = CocoaMessage(0, 0, "_Cocoa_KVO new") 176 | Global _Cocoa_NSApp.i = CocoaMessage(0, 0, "NSApplication sharedApplication") 177 | CocoaMessage(0, _Cocoa_NSApp, "addObserver:", _Cocoa_KVO, "forKeyPath:$", @"effectiveAppearance", "options:", #NSKeyValueObservingOptionNew, "context:", #nil) 178 | 179 | Global _Cocoa_ThemeChanged.i = #False 180 | 181 | ProcedureC KVO(obj, sel, keyPath, object, change, context) 182 | Select PeekS(CocoaMessage(0, keyPath, "UTF8String"), -1, #PB_UTF8) 183 | 184 | Case "effectiveAppearance": 185 | CocoaMessage(0, 0, "NSAppearance setCurrentAppearance:", CocoaMessage(0, change, "objectForKey:", *NSKeyValueChangeNewKey\i)) 186 | _Cocoa_ThemeChanged = #True 187 | 188 | EndSelect 189 | EndProcedure 190 | 191 | Procedure.i Cocoa_ThemeChanged() 192 | Protected Result.i = _Cocoa_ThemeChanged 193 | _Cocoa_ThemeChanged = #False 194 | ProcedureReturn (Result) 195 | EndProcedure 196 | 197 | CompilerEndIf 198 | 199 | 200 | 201 | 202 | CompilerEndIf 203 | CompilerEndIf 204 | ;- 205 | -------------------------------------------------------------------------------- /ColorRequesterEx.pbi: -------------------------------------------------------------------------------- 1 | ; +------------------+ 2 | ; | ColorRequesterEx | 3 | ; +------------------+ 4 | ; | 2017.05.09 . Creation (PureBasic 5.60) 5 | 6 | ;- 7 | CompilerIf (Not Defined(__ColorRequesterEx, #PB_Constant)) 8 | #__ColorRequesterEx_Included = #True 9 | 10 | CompilerIf (#PB_Compiler_IsMainFile) 11 | EnableExplicit 12 | CompilerEndIf 13 | 14 | 15 | 16 | 17 | ;- Constants (Public) 18 | 19 | Enumeration 20 | #ColorReq_UseFile = $0001 21 | #ColorReq_PartOpen = $0100 ; effect only on Windows 22 | #ColorReq_NoReorder = $0200 ; effect only on Windows 23 | EndEnumeration 24 | 25 | ;#ColorReq_Default = #PB_Default 26 | 27 | 28 | ;- 29 | ;- Constants (Private) 30 | 31 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 32 | #__ColorReq_RecentCount = 16 33 | CompilerElse 34 | #__ColorReq_RecentCount = 1 35 | CompilerEndIf 36 | 37 | 38 | 39 | 40 | 41 | ;- 42 | ;- Variables (Private) 43 | 44 | Global Dim __ColorReq_Recent.l(#__ColorReq_RecentCount - 1) 45 | __ColorReq_Recent(0) = #PB_Default 46 | 47 | Global __ColorReq_SaveFile.s 48 | 49 | 50 | 51 | 52 | ;- 53 | ;- Macros (Public) 54 | 55 | Macro GetColorReqExRecentCount() 56 | #__ColorReq_RecentCount 57 | EndMacro 58 | 59 | 60 | ;- 61 | ;- Procedures (Private) 62 | 63 | Procedure __ColorReq_CheckSaveFile() 64 | If (__ColorReq_SaveFile = "") 65 | __ColorReq_SaveFile = GetTemporaryDirectory() + GetFilePart(ProgramFilename()) + ".colors" 66 | EndIf 67 | EndProcedure 68 | 69 | Procedure __ColorReq_Load() 70 | __ColorReq_CheckSaveFile() 71 | Protected FN.i = ReadFile(#PB_Any, __ColorReq_SaveFile) 72 | If (FN) 73 | Protected i.i = 0 74 | Protected Line.s 75 | While ((i < #__ColorReq_RecentCount) And (Not Eof(FN))) 76 | Line = ReadString(FN) 77 | If ((Left(Line, 1) = "$") And (Len(Line) = 7)) 78 | __ColorReq_Recent(i) = Val(Line) 79 | i + 1 80 | Else 81 | Break 82 | EndIf 83 | Wend 84 | CloseFile(FN) 85 | EndIf 86 | EndProcedure 87 | 88 | Procedure __ColorReq_Save() 89 | __ColorReq_CheckSaveFile() 90 | Protected FN.i = CreateFile(#PB_Any, __ColorReq_SaveFile) 91 | If (FN) 92 | Protected i.i 93 | For i = 0 To #__ColorReq_RecentCount - 1 94 | WriteStringN(FN, "$" + RSet(Hex(__ColorReq_Recent(i)), 6, "0")) 95 | Next i 96 | CloseFile(FN) 97 | EndIf 98 | EndProcedure 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | ;- 108 | ;- Procedures (Public) 109 | 110 | Procedure.i ColorRequesterEx(Color.i = #PB_Default, Flags.i = #PB_Default, WindowID.i = #PB_Default) 111 | Protected Result.i = -1 112 | 113 | If (Flags = #PB_Default) 114 | Flags = #Null 115 | EndIf 116 | If (WindowID = #PB_Default) 117 | WindowID = #Null 118 | EndIf 119 | 120 | Protected i.i, j.i 121 | If (__ColorReq_Recent(0) = #PB_Default) 122 | CompilerIf (#__ColorReq_RecentCount > 1) 123 | For i = 0 To #__ColorReq_RecentCount - 1 124 | j = i * (255 / (#__ColorReq_RecentCount - 1)) 125 | __ColorReq_Recent(i) = RGB(j, j, j) 126 | Next i 127 | CompilerElse 128 | __ColorReq_Recent(0) = $000000 129 | CompilerEndIf 130 | EndIf 131 | If (Flags & #ColorReq_UseFile) 132 | __ColorReq_Load() 133 | EndIf 134 | 135 | If (Color = #PB_Default) 136 | Color = __ColorReq_Recent(0) 137 | EndIf 138 | Result = -1 139 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 140 | Protected CC.CHOOSECOLOR 141 | CC\lStructSize = SizeOf(CHOOSECOLOR) 142 | CC\hwndOwner = WindowID 143 | CC\rgbResult = Color 144 | CC\lpCustColors = @__ColorReq_Recent(0) 145 | CC\Flags = #CC_ANYCOLOR | #CC_RGBINIT 146 | If (Not (Flags & #ColorReq_PartOpen)) 147 | CC\Flags | #CC_FULLOPEN 148 | EndIf 149 | If (ChooseColor_(@CC)) 150 | Result = CC\rgbResult 151 | EndIf 152 | CompilerElse 153 | Result = ColorRequester(Color) 154 | CompilerEndIf 155 | 156 | If (Result <> -1) 157 | 158 | ; Update recent colors list 159 | j = -1 160 | For i = 0 To #__ColorReq_RecentCount - 1 161 | If (__ColorReq_Recent(i) = Result) 162 | j = i 163 | Break 164 | EndIf 165 | Next i 166 | If ((j = -1) Or ((j >= 1) And (Not (Flags & #ColorReq_NoReorder)))) 167 | ; Not found, or it's found but not most-recent 168 | If (j = -1) 169 | j = #__ColorReq_RecentCount - 1 170 | EndIf 171 | For i = j To 1 Step -1 172 | __ColorReq_Recent(i) = __ColorReq_Recent(i - 1) 173 | Next i 174 | __ColorReq_Recent(0) = Result 175 | EndIf 176 | If (Flags & #ColorReq_UseFile) 177 | __ColorReq_Save() 178 | EndIf 179 | 180 | EndIf 181 | ProcedureReturn (Result) 182 | EndProcedure 183 | 184 | 185 | Procedure.i GetColorReqExRecent(Index.i) 186 | If ((Index >= 0) And (Index < #__ColorReq_RecentCount)) 187 | ProcedureReturn (__ColorReq_Recent(Index)) 188 | EndIf 189 | ProcedureReturn (-1) 190 | EndProcedure 191 | 192 | Procedure.i SetColorReqExRecent(Index.i, Color.i) 193 | If ((Index >= 0) And (Index < #__ColorReq_RecentCount)) 194 | __ColorReq_Recent(Index) = Color 195 | ProcedureReturn (#True) 196 | EndIf 197 | ProcedureReturn (#False) 198 | EndProcedure 199 | 200 | Procedure.s GetColorReqExFile() 201 | __ColorReq_CheckSaveFile() 202 | ProcedureReturn (__ColorReq_SaveFile) 203 | EndProcedure 204 | 205 | Procedure.i SetColorReqExFile(Path.s) 206 | __ColorReq_SaveFile = Path 207 | ProcedureReturn (#True) 208 | EndProcedure 209 | 210 | 211 | 212 | 213 | 214 | 215 | ;- 216 | ;- Demo Program 217 | 218 | CompilerIf (#PB_Compiler_IsMainFile) 219 | DisableExplicit 220 | 221 | 222 | ; Specify where to save custom colors (optional) 223 | SetColorReqExFile(GetTemporaryDirectory() + "custom.colors") 224 | 225 | ; Set default colors (optional) 226 | If (FileSize(GetColorReqExFile()) <= 0) 227 | For i = 0 To (GetColorReqExRecentCount() - 1) 228 | SetColorReqExRecent(i, RGB(0, i*17, 255)) 229 | ;Debug Hex(GetColorReqExRecent(i)) 230 | Next i 231 | EndIf 232 | 233 | 234 | OpenWindow(0, 0, 0, 480, 360, "ColorRequesterEx", #PB_Window_ScreenCentered | #PB_Window_SystemMenu) 235 | Color = #PB_Default 236 | Repeat 237 | ;Color = ColorRequester(Color) ; For comparison 238 | Color = ColorRequesterEx(Color, #ColorReq_UseFile, WindowID(0)) 239 | If (Color <> -1) 240 | SetWindowColor(0, Color) 241 | EndIf 242 | Until (Color = -1) 243 | ;DeleteFile(GetColorReqExFile()) 244 | 245 | 246 | CompilerEndIf 247 | CompilerEndIf 248 | ;- -------------------------------------------------------------------------------- /Complex.pbi: -------------------------------------------------------------------------------- 1 | ; +---------+ 2 | ; | Complex | 3 | ; +---------+ 4 | ; | 2016.02.03 . Creation (PureBasic 5.42b1) 5 | 6 | ;- 7 | CompilerIf (Not Defined(__Complex_Included, #PB_Constant)) 8 | #__Complex_Included = #True 9 | 10 | ;- Constants (Private) 11 | 12 | CompilerIf (SizeOf(QUAD) <> 8) 13 | CompilerError #PB_Compiler_Filename + ": SizeOf(QUAD) is incorrect" 14 | CompilerElseIf (SizeOf(FLOAT) <> 4) 15 | CompilerError #PB_Compiler_Filename + ": SizeOf(FLOAT) is incorrect" 16 | CompilerEndIf 17 | 18 | CompilerIf (#PB_Compiler_IsMainFile) 19 | EnableExplicit 20 | CompilerEndIf 21 | 22 | 23 | 24 | 25 | 26 | 27 | ;- 28 | ;- Structures (Private) 29 | 30 | Structure _Complex 31 | re.f 32 | im.f 33 | EndStructure 34 | 35 | 36 | 37 | 38 | 39 | 40 | ;- 41 | ;- Macros (Private) 42 | 43 | Macro Complex 44 | q 45 | EndMacro 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | ;- 54 | ;- Macros (Public) 55 | 56 | CompilerIf (#True) 57 | 58 | Macro cUnity() 59 | Complex_Unity() 60 | EndMacro 61 | 62 | Macro cNew(Real, Imaginary = 0.0) 63 | Complex_New(Real, Imaginary) 64 | EndMacro 65 | Macro cReal(x) 66 | Complex_Real(x) 67 | EndMacro 68 | Macro cImag(x) 69 | Complex_Imaginary(x) 70 | EndMacro 71 | Macro cStr(x) 72 | Complex_Str(x) 73 | EndMacro 74 | Macro cConj(x) 75 | Complex_Conjugate(x) 76 | EndMacro 77 | Macro cNeg(x) 78 | Complex_Negate(x) 79 | EndMacro 80 | Macro cRecip(x) 81 | Complex_Reciprocal(x) 82 | EndMacro 83 | Macro cMag(x) 84 | Complex_Magnitude(x) 85 | EndMacro 86 | Macro cPhase(x) 87 | Complex_Phase(x) 88 | EndMacro 89 | 90 | Macro cAdd(x, y) 91 | Complex_Add(x, y) 92 | EndMacro 93 | Macro cSub(x, y) 94 | Complex_Subtract(x, y) 95 | EndMacro 96 | Macro cMult(x, y) 97 | Complex_Multiply(x, y) 98 | EndMacro 99 | Macro cDiv(x, y) 100 | Complex_Divide(x, y) 101 | EndMacro 102 | 103 | CompilerEndIf 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | ;- 115 | ;- Unary Operations 116 | 117 | Procedure.Complex Complex_Unity() 118 | Protected Result.Complex 119 | PokeF(@Result, 1.0) 120 | PokeF(@Result + 4, 0.0) 121 | ProcedureReturn Result 122 | EndProcedure 123 | 124 | Procedure.Complex Complex_New(Real.f, Imaginary.f = 0.0) 125 | Protected Result.Complex 126 | PokeF(@Result, Real) 127 | PokeF(@Result + 4, Imaginary) 128 | ProcedureReturn Result 129 | EndProcedure 130 | 131 | Procedure.f Complex_Real(x.Complex) 132 | ProcedureReturn PeekF(@x) 133 | EndProcedure 134 | 135 | Procedure.f Complex_Imaginary(x.Complex) 136 | ProcedureReturn PeekF(@x + 4) 137 | EndProcedure 138 | 139 | Procedure.s Complex_Str(x.Complex) 140 | Protected *x._Complex = @x 141 | If (*x\im < 0.0) 142 | ProcedureReturn (StrF(*x\re) + " - " + StrF(-*x\im) + "i") 143 | EndIf 144 | ProcedureReturn (StrF(*x\re) + " + " + StrF(*x\im) + "i") 145 | EndProcedure 146 | 147 | Procedure.Complex Complex_Conjugate(x.Complex) 148 | Protected Result.Complex 149 | PokeF(@Result, PeekF(@x)) 150 | PokeF(@Result + 4, -PeekF(@x + 4)) 151 | ProcedureReturn Result 152 | EndProcedure 153 | 154 | Procedure.Complex Complex_Negate(x.Complex) 155 | Protected Result.Complex 156 | PokeF(@Result, -PeekF(@x)) 157 | PokeF(@Result + 4, -PeekF(@x + 4)) 158 | ProcedureReturn Result 159 | EndProcedure 160 | 161 | Procedure.Complex Complex_Reciprocal(x.Complex) 162 | Protected Result.Complex 163 | Protected *x._Complex = @x 164 | PokeF(@Result, *x\re / (*x\re * *x\re + *x\im * *x\im)) 165 | PokeF(@Result + 4, -*x\im / (*x\re * *x\re + *x\im * *x\im)) 166 | ProcedureReturn Result 167 | EndProcedure 168 | 169 | Procedure.f Complex_Magnitude(x.Complex) 170 | Protected *x._Complex = @x 171 | ProcedureReturn Sqr(*x\re * *x\re + *x\im * *x\im) 172 | EndProcedure 173 | 174 | Procedure.f Complex_Phase(x.Complex) 175 | Protected *x._Complex = @x 176 | ProcedureReturn ATan2(*x\re, *x\im) 177 | EndProcedure 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | ;- 187 | ;- Binary Operations 188 | 189 | Procedure.Complex Complex_Add(x.Complex, y.Complex) 190 | Protected Result.Complex 191 | PokeF(@Result, PeekF(@x) + PeekF(@y)) 192 | PokeF(@Result + 4, PeekF(@x + 4) + PeekF(@y + 4)) 193 | ProcedureReturn Result 194 | EndProcedure 195 | 196 | Procedure.Complex Complex_Subtract(x.Complex, y.Complex) 197 | Protected Result.Complex 198 | PokeF(@Result, PeekF(@x) - PeekF(@y)) 199 | PokeF(@Result + 4, PeekF(@x + 4) - PeekF(@y + 4)) 200 | ProcedureReturn Result 201 | EndProcedure 202 | 203 | Procedure.Complex Complex_Multiply(x.Complex, y.Complex) 204 | Protected Result.Complex 205 | Protected *x._Complex = @x 206 | Protected *y._Complex = @y 207 | PokeF(@Result, *x\re * *y\re - *x\im * *y\im) 208 | PokeF(@Result + 4, *x\re * *y\im + *x\im * *y\re) 209 | ProcedureReturn Result 210 | EndProcedure 211 | 212 | Procedure.Complex Complex_Divide(x.Complex, y.Complex) 213 | Protected Result.Complex 214 | Protected *x._Complex = @x 215 | Protected *y._Complex = @y 216 | PokeF(@Result, (*x\re * *y\re + *x\im * *y\im) / (*y\re * *y\re + *y\im * *y\im)) 217 | PokeF(@Result + 4, (*x\im * *y\re - *x\re * *y\im) / (*y\re * *y\re + *y\im * *y\im)) 218 | ProcedureReturn Result 219 | EndProcedure 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | ;- 228 | ;- Demo Program 229 | CompilerIf (#PB_Compiler_IsMainFile) 230 | DisableExplicit 231 | 232 | a.Complex = cNew(3, -4) 233 | Debug "a = " + cStr(a) 234 | Debug "Real Part = " + StrF(cReal(a)) 235 | Debug "Imaginary Part = " + StrF(cImag(a)) 236 | Debug "Magnitude = " + StrF(cMag(a)) 237 | Debug "Phase = " + StrF(Degree(cPhase(a)), 1) + " deg" 238 | Debug "Negate = " + cStr(cNeg(a)) 239 | Debug "Conjugate = " + cStr(cConj(a)) 240 | Debug "Reciprocal = " + cStr(cRecip(a)) 241 | Debug "" 242 | 243 | b.Complex = cNew(2, 1) 244 | Debug "b = " + cStr(b) 245 | Debug "Add(a,b) = " + cStr(cAdd(a, b)) 246 | Debug "Subtract(a,b) = " + cStr(cSub(a, b)) 247 | Debug "Multiply(a,b) = " + cStr(cMult(a, b)) 248 | Debug "Divide(a,b) = " + cStr(cDiv(a, b)) 249 | Debug "" 250 | 251 | CompilerEndIf 252 | CompilerEndIf 253 | ;- -------------------------------------------------------------------------------- /CompressHelper.pbi: -------------------------------------------------------------------------------- 1 | ; +----------------+ 2 | ; | CompressHelper | 3 | ; +----------------+ 4 | ; | 2015.05.28 . Creation (PureBasic 5.31) 5 | ; | .29 . Added minimum buffer size (for tiny compressions) 6 | 7 | ;- 8 | CompilerIf (Not Defined(__CompressHelper_Included, #PB_Constant)) 9 | #__CompressHelper_Included = #True 10 | 11 | CompilerIf (#PB_Compiler_IsMainFile) 12 | EnableExplicit 13 | CompilerEndIf 14 | 15 | CompilerIf (#PB_Compiler_Version < 510) 16 | CompilerError #PB_Compiler_Filename + " requires PB 5.10 or newer" 17 | CompilerEndIf 18 | 19 | 20 | 21 | 22 | ;- Constants (Private) 23 | 24 | #_CompressHelper_HeaderID = $504C4843 ; 'CHLP' 25 | 26 | #_CompressHelper_BufferMin = 128 27 | 28 | 29 | 30 | 31 | ;- 32 | ;- Constants (Public) 33 | 34 | #Compress_BriefLZ = #PB_PackerPlugin_BriefLZ 35 | #Compress_Zip = #PB_PackerPlugin_Zip 36 | #Compress_LZMA = #PB_PackerPlugin_Lzma 37 | 38 | #Compress_DefaultPlugin = #Compress_Zip 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | ;- 52 | ;- Structures (Private) 53 | 54 | Structure _COMPRESSHELPER_HEADER 55 | HelperID.l 56 | PluginID.l 57 | UncompressedBytes.q 58 | CompressedBytes.q 59 | Reserved.q 60 | EndStructure 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | ;- 78 | ;- Procedures (Private) 79 | 80 | CompilerIf (#PB_Compiler_Debugger) 81 | 82 | Procedure _CompressHelper_CheckPlugin(PluginID.i) 83 | Protected TempLong.l 84 | Protected TempString.s = Space(#_CompressHelper_BufferMin) 85 | If (CompressMemory(@TempLong, SizeOf(TempLong), @TempString, StringByteLength(TempString), PluginID)) 86 | ; OK 87 | Else 88 | Select (PluginID) 89 | Case #Compress_BriefLZ 90 | Debug "You must call UseBriefLZPacker()." 91 | Case #Compress_LZMA 92 | Debug "You must call UseLZMAPacker()." 93 | Case #Compress_Zip 94 | Debug "You must call UseZipPacker()." 95 | Default 96 | Debug "Compression plugin not recognized or not supported." 97 | EndSelect 98 | EndIf 99 | EndProcedure 100 | 101 | CompilerElse 102 | 103 | Macro _CompressHelper_CheckPlugin(PluginID) 104 | ; 105 | EndMacro 106 | 107 | CompilerEndIf 108 | 109 | Procedure.i _CompressHelper_Size(*Memory, CompressedSize.i = #False) 110 | Protected Result.i = 0 111 | 112 | If (*Memory) 113 | Protected *Header._COMPRESSHELPER_HEADER = *Memory 114 | *Header = *Memory 115 | If (*Header\HelperID = #_CompressHelper_HeaderID) 116 | If (CompressedSize) 117 | Result = *Header\CompressedBytes 118 | Else 119 | Result = *Header\UncompressedBytes 120 | EndIf 121 | EndIf 122 | EndIf 123 | 124 | ProcedureReturn (Result) 125 | EndProcedure 126 | 127 | 128 | ;- 129 | ;- Procedures (Public) 130 | 131 | ;- 132 | 133 | CompilerIf (Not Defined(CopyMemoryToFile, #PB_Procedure)) 134 | Procedure.i CopyMemoryToFile(*Memory, Bytes.i, File.s) 135 | Protected Result.i = #False 136 | 137 | If (*Memory) 138 | If (Bytes >= 0) 139 | If (File) 140 | Protected FID.i = CreateFile(#PB_Any, File) 141 | If (FID) 142 | If (Bytes > 0) 143 | If (WriteData(FID, *Memory, Bytes) = Bytes) 144 | Result = #True 145 | EndIf 146 | Else 147 | Result = #True 148 | EndIf 149 | CloseFile(FID) 150 | EndIf 151 | EndIf 152 | EndIf 153 | EndIf 154 | 155 | ProcedureReturn (Result) 156 | EndProcedure 157 | CompilerEndIf 158 | 159 | CompilerIf (Not Defined(CopyFileToMemory, #PB_Procedure)) 160 | Procedure.i CopyFileToMemory(File.s) 161 | Protected *Buffer = #Null 162 | 163 | If (File) 164 | Protected FID.i = ReadFile(#PB_Any, File) 165 | If (FID) 166 | Protected BufferBytes.i = Lof(FID) 167 | If (BufferBytes > 0) 168 | *Buffer = AllocateMemory(BufferBytes, #PB_Memory_NoClear) 169 | If (*Buffer) 170 | If (ReadData(FID, *Buffer, BufferBytes) = BufferBytes) 171 | ; 172 | Else 173 | FreeMemory(*Buffer) 174 | *Buffer = #Null 175 | EndIf 176 | EndIf 177 | EndIf 178 | CloseFile(FID) 179 | EndIf 180 | EndIf 181 | 182 | ProcedureReturn (*Buffer) 183 | EndProcedure 184 | CompilerEndIf 185 | 186 | ;- 187 | 188 | Procedure.i CompressMemoryToMemory(*Memory, Bytes.i, PluginID.i = #Compress_DefaultPlugin) 189 | Protected *Compressed = #Null 190 | 191 | _CompressHelper_CheckPlugin(PluginID) 192 | If (*Memory) 193 | If (Bytes > 0) 194 | Select (PluginID) 195 | Case #Compress_BriefLZ, #Compress_Zip, #Compress_LZMA 196 | Protected BufferBytes.i = Int(Bytes * 1.40) 197 | If (BufferBytes < #_CompressHelper_BufferMin) 198 | BufferBytes = #_CompressHelper_BufferMin 199 | EndIf 200 | Protected *Buffer = AllocateMemory(BufferBytes, #PB_Memory_NoClear) 201 | If (*Buffer) 202 | Protected UsedBytes.i = CompressMemory(*Memory, Bytes, *Buffer, BufferBytes, PluginID) 203 | If (UsedBytes > 0) 204 | Protected Offset.i = SizeOf(_COMPRESSHELPER_HEADER) 205 | *Compressed = AllocateMemory(Offset + UsedBytes, #PB_Memory_NoClear) 206 | If (*Compressed) 207 | Protected *Header._COMPRESSHELPER_HEADER = *Compressed 208 | *Header\HelperID = #_CompressHelper_HeaderID 209 | *Header\PluginID = PluginID 210 | *Header\UncompressedBytes = Bytes 211 | *Header\CompressedBytes = UsedBytes 212 | *Header\Reserved = #Null 213 | CopyMemory(*Buffer, *Compressed + Offset, UsedBytes) 214 | EndIf 215 | EndIf 216 | FreeMemory(*Buffer) 217 | EndIf 218 | Default 219 | ; 220 | EndSelect 221 | EndIf 222 | EndIf 223 | 224 | ProcedureReturn (*Compressed) 225 | EndProcedure 226 | 227 | Procedure.i UncompressMemoryToMemory(*Memory, Bytes.i = #PB_Default) 228 | Protected *Uncompressed = #Null 229 | 230 | If (*Memory) 231 | Protected *Header._COMPRESSHELPER_HEADER = *Memory 232 | If (*Header\HelperID = #_CompressHelper_HeaderID) 233 | If (*Header\UncompressedBytes > 0) 234 | If (*Header\CompressedBytes > 0) 235 | Protected Offset.i = SizeOf(_COMPRESSHELPER_HEADER) 236 | If (Bytes <= 0) 237 | Bytes = MemorySize(*Memory) 238 | EndIf 239 | If (Bytes = Offset + *Header\CompressedBytes) 240 | Select (*Header\PluginID) 241 | Case #Compress_BriefLZ, #Compress_Zip, #Compress_LZMA 242 | _CompressHelper_CheckPlugin(*Header\PluginID) 243 | Protected *Buffer = AllocateMemory(*Header\UncompressedBytes, #PB_Memory_NoClear) 244 | If (*Buffer) 245 | If (UncompressMemory(*Memory + Offset, *Header\CompressedBytes, *Buffer, *Header\UncompressedBytes, *Header\PluginID) > 0) 246 | *Uncompressed = *Buffer 247 | Else 248 | FreeMemory(*Buffer) 249 | *Buffer = #Null 250 | EndIf 251 | EndIf 252 | Default 253 | ; 254 | EndSelect 255 | EndIf 256 | EndIf 257 | EndIf 258 | EndIf 259 | EndIf 260 | 261 | ProcedureReturn (*Uncompressed) 262 | EndProcedure 263 | 264 | ;- 265 | 266 | Procedure.i CompressMemoryToFile(*Memory, Bytes.i, File.s, PluginID.i = #Compress_DefaultPlugin) 267 | Protected Result.i = #False 268 | 269 | If (File) 270 | Protected *Compressed = CompressMemoryToMemory(*Memory, Bytes, PluginID) 271 | If (*Compressed) 272 | Result = CopyMemoryToFile(*Compressed, MemorySize(*Compressed), File) 273 | FreeMemory(*Compressed) 274 | EndIf 275 | EndIf 276 | 277 | ProcedureReturn (Result) 278 | EndProcedure 279 | 280 | Procedure.i UncompressFileToMemory(File.s) 281 | Protected *Uncompressed = #Null 282 | 283 | If (File) 284 | Protected *Buffer = CopyFileToMemory(File) 285 | If (*Buffer) 286 | *Uncompressed = UncompressMemoryToMemory(*Buffer) 287 | FreeMemory(*Buffer) 288 | EndIf 289 | EndIf 290 | 291 | ProcedureReturn (*Uncompressed) 292 | EndProcedure 293 | 294 | ;- 295 | 296 | Procedure.i CompressFileToFile(InputFile.s, OutputFile.s, PluginID.i = #Compress_DefaultPlugin) 297 | Protected Result.i = #False 298 | 299 | If (InputFile) 300 | If (OutputFile) 301 | Protected *Uncompressed = CopyFileToMemory(InputFile) 302 | If (*Uncompressed) 303 | Result = CompressMemoryToFile(*Uncompressed, MemorySize(*Uncompressed), OutputFile, PluginID) 304 | FreeMemory(*Uncompressed) 305 | EndIf 306 | EndIf 307 | EndIf 308 | 309 | ProcedureReturn (Result) 310 | EndProcedure 311 | 312 | Procedure.i UncompressFileToFile(InputFile.s, OutputFile.s) 313 | Protected Result.i = #False 314 | 315 | If (InputFile) 316 | If (OutputFile) 317 | Protected *Uncompressed = UncompressFileToMemory(InputFile) 318 | If (*Uncompressed) 319 | Result = CopyMemoryToFile(*Uncompressed, MemorySize(*Uncompressed), OutputFile) 320 | FreeMemory(*Uncompressed) 321 | EndIf 322 | EndIf 323 | EndIf 324 | 325 | ProcedureReturn (Result) 326 | EndProcedure 327 | 328 | ;- 329 | 330 | Procedure.i CompressFileToMemory(File.s, PluginID.i = #Compress_DefaultPlugin) 331 | Protected *Compressed = #Null 332 | 333 | Protected *Buffer = CopyFileToMemory(File) 334 | If (*Buffer) 335 | *Compressed = CompressMemoryToMemory(*Buffer, MemorySize(*Buffer), PluginID) 336 | FreeMemory(*Buffer) 337 | EndIf 338 | 339 | ProcedureReturn (*Compressed) 340 | EndProcedure 341 | 342 | Procedure.i UncompressMemoryToFile(*Memory, File.s, Bytes.i = #PB_Default) 343 | Protected Result.i = #False 344 | 345 | If (*Memory) 346 | If (File) 347 | Protected *Uncompressed = UncompressMemoryToMemory(*Memory, Bytes) 348 | If (*Uncompressed) 349 | If (CopyMemoryToFile(*Uncompressed, MemorySize(*Uncompressed), File)) 350 | Result = #True 351 | EndIf 352 | FreeMemory(*Uncompressed) 353 | EndIf 354 | EndIf 355 | EndIf 356 | 357 | ProcedureReturn (Result) 358 | EndProcedure 359 | 360 | 361 | 362 | 363 | 364 | 365 | 366 | 367 | 368 | 369 | 370 | 371 | 372 | 373 | 374 | 375 | 376 | 377 | 378 | 379 | 380 | ;- 381 | ;- Demo Program 382 | 383 | CompilerIf (#PB_Compiler_IsMainFile) 384 | DisableExplicit 385 | 386 | RandomSeed(1) 387 | TestString.s = "" 388 | For i = 1 To 20 389 | TestString + RSet("", Random(30, 5), Chr(Random('z', 'a'))) 390 | Next i 391 | TestBytes.i = StringByteLength(TestString) + SizeOf(CHARACTER) 392 | ;Debug "Input String = " + TestString 393 | Debug "Input Bytes = " + Str(TestBytes) 394 | Debug "" 395 | 396 | UseZipPacker() 397 | UseBriefLZPacker() 398 | UseLZMAPacker() 399 | TestPlugin.i = #Compress_Zip 400 | 401 | *Compressed = CompressMemoryToMemory(@TestString, TestBytes, TestPlugin) 402 | If (*Compressed) 403 | NewBytes.i = MemorySize(*Compressed) 404 | Debug "Compressed Bytes = " + Str(NewBytes) + " (" + StrF(100.0 * NewBytes / TestBytes, 1) + "%)" 405 | *Uncompressed = UncompressMemoryToMemory(*Compressed) 406 | If (*Uncompressed) 407 | Debug "Uncompressed Bytes = " + Str(MemorySize(*Uncompressed)) 408 | If (PeekS(*Uncompressed) <> TestString) 409 | Debug "Uncompressed string does not match test string!" 410 | EndIf 411 | FreeMemory(*Uncompressed) 412 | Else 413 | Debug "Failed to uncompress memory!" 414 | EndIf 415 | FreeMemory(*Compressed) 416 | Else 417 | Debug "Failed to compress memory!" 418 | EndIf 419 | Debug "" 420 | 421 | TempFile.s = GetTemporaryDirectory() + "temp.pack" 422 | If (CompressMemoryToFile(@TestString, TestBytes, TempFile, TestPlugin)) 423 | NewBytes.i = FileSize(TempFile) 424 | Debug "Compressed File Bytes = " + Str(NewBytes) + " (" + StrF(100.0 * NewBytes / TestBytes, 1) + "%)" 425 | *Uncompressed = UncompressFileToMemory(TempFile) 426 | If (*Uncompressed) 427 | Debug "Uncompressed File Bytes = " + Str(MemorySize(*Uncompressed)) 428 | If (PeekS(*Uncompressed) <> TestString) 429 | Debug "Uncompressed string does not match test string!" 430 | EndIf 431 | FreeMemory(*Uncompressed) 432 | Else 433 | Debug "Failed to uncompress memory!" 434 | EndIf 435 | DeleteFile(TempFile) 436 | Else 437 | Debug "Failed to compress to file!" 438 | EndIf 439 | Debug "" 440 | 441 | CompilerEndIf 442 | CompilerEndIf 443 | ;- -------------------------------------------------------------------------------- /DesktopHelper.pbi: -------------------------------------------------------------------------------- 1 | ; +---------------+ 2 | ; | DesktopHelper | 3 | ; +---------------+ 4 | ; | 2016.01.21 . Creation (PureBasic 5.41) 5 | ; | 2017.05.05 . Cleaned up demo 6 | ; | 2019.10.18 . Added Global/Desktop conversions, Size matching 7 | ; | 2020-04-03 . Added TopLeft/Center XY, PointInWindow, SetTopWindow 8 | 9 | CompilerIf (Not Defined(__DesktopHelper_Included, #PB_Constant)) 10 | #__DesktopHelper_Included = #True 11 | 12 | CompilerIf (#PB_Compiler_IsMainFile) 13 | EnableExplicit 14 | CompilerEndIf 15 | 16 | 17 | ;- 18 | ;- Procedures 19 | 20 | Procedure.i DesktopCount() 21 | ProcedureReturn (ExamineDesktops()) 22 | EndProcedure 23 | 24 | Procedure.i DesktopExists(Desktop.i) 25 | ProcedureReturn (Bool((Desktop >= 0) And (Desktop < DesktopCount()))) 26 | EndProcedure 27 | 28 | Procedure.i DesktopFromPoint(x.i, y.i) 29 | Protected Result.i = 0; -1 30 | Protected n.i = DesktopCount() 31 | If (n > 0) 32 | Protected i.i 33 | For i = 0 To n - 1 34 | If ((x >= DesktopX(i)) And (y >= DesktopY(i))) 35 | If (x < DesktopX(i) + DesktopWidth(i)) 36 | If (y < DesktopY(i) + DesktopHeight(i)) 37 | Result = i 38 | Break 39 | EndIf 40 | EndIf 41 | EndIf 42 | Next i 43 | EndIf 44 | ProcedureReturn (Result) 45 | EndProcedure 46 | 47 | Procedure.i DesktopFromWindow(Window.i) 48 | Protected x.i = WindowX(Window) + WindowWidth(Window, #PB_Window_FrameCoordinate)/2 49 | Protected y.i = WindowY(Window) + WindowHeight(Window, #PB_Window_FrameCoordinate)/4;/2 50 | ProcedureReturn (DesktopFromPoint(x, y)) 51 | EndProcedure 52 | 53 | Procedure.i GlobalToDesktopX(GlobalX.i, Desktop.i) 54 | ProcedureReturn (GlobalX - DesktopX(Desktop)) 55 | EndProcedure 56 | 57 | Procedure.i GlobalToDesktopY(GlobalY.i, Desktop.i) 58 | ProcedureReturn (GlobalY - DesktopY(Desktop)) 59 | EndProcedure 60 | 61 | Procedure.i DesktopToGlobalX(DesktopX.i, Desktop.i) 62 | ProcedureReturn (DesktopX + DesktopX(Desktop)) 63 | EndProcedure 64 | 65 | Procedure.i DesktopToGlobalY(DesktopY.i, Desktop.i) 66 | ProcedureReturn (DesktopY + DesktopY(Desktop)) 67 | EndProcedure 68 | 69 | Procedure.i DesktopWindowX(Window.i, Desktop.i = -1) 70 | Protected Result.i = 0 71 | If (Desktop < 0) 72 | Desktop = DesktopFromWindow(Window) 73 | EndIf 74 | If (Desktop >= 0) 75 | Result = GlobalToDesktopX(WindowX(Window), Desktop) 76 | EndIf 77 | ProcedureReturn (Result) 78 | EndProcedure 79 | 80 | Procedure.i DesktopWindowY(Window.i, Desktop.i = -1) 81 | Protected Result.i = 0 82 | If (Desktop < 0) 83 | Desktop = DesktopFromWindow(Window) 84 | EndIf 85 | If (Desktop >= 0) 86 | Result = GlobalToDesktopY(WindowY(Window), Desktop) 87 | EndIf 88 | ProcedureReturn (Result) 89 | EndProcedure 90 | 91 | Procedure GetWindowTopLeftXY(Window.i, *x.INTEGER, *y.INTEGER) 92 | If (*x) 93 | *x\i = WindowX(Window) 94 | EndIf 95 | If (*y) 96 | *y\i = WindowY(Window) 97 | EndIf 98 | EndProcedure 99 | 100 | Procedure GetWindowCenterXY(Window.i, *cx.INTEGER, *cy.INTEGER) 101 | If (*cx) 102 | *cx\i = WindowX(Window) + WindowWidth(Window)/2 103 | EndIf 104 | If (*cy) 105 | *cy\i = WindowY(Window) + WindowHeight(Window)/2 106 | EndIf 107 | EndProcedure 108 | 109 | Procedure.i PointInWindow(x.i, y.i, Window.i) 110 | If ((x >= WindowX(Window)) And (x < WindowX(Window) + WindowWidth(Window))) 111 | If ((y >= WindowY(Window)) And (y < WindowY(Window) + WindowHeight(Window))) 112 | ProcedureReturn (#True) 113 | EndIf 114 | EndIf 115 | ProcedureReturn (#False) 116 | EndProcedure 117 | 118 | Procedure.i DesktopMatchesSize(Desktop.i, Width.i, Height.i) 119 | Protected Result.i = #False 120 | If ((Width > 0) And (Height > 0)) 121 | If ((Desktop >= 0) And (Desktop < DesktopCount())) 122 | If ((DesktopWidth(Desktop) = Width) And (DesktopHeight(Desktop) = Height)) 123 | Result = #True 124 | EndIf 125 | EndIf 126 | EndIf 127 | ProcedureReturn (Result) 128 | EndProcedure 129 | 130 | Procedure.i DesktopBySize(Width.i, Height.i, NotFoundResult.i = -1) 131 | Protected Result.i = NotFoundResult 132 | If ((Width > 0) And (Height > 0)) 133 | Protected n.i = DesktopCount() 134 | Protected i.i 135 | For i = 0 To n - 1 136 | If (DesktopMatchesSize(i, Width, Height)) 137 | Result = i 138 | Break 139 | EndIf 140 | Next i 141 | EndIf 142 | ProcedureReturn (Result) 143 | EndProcedure 144 | 145 | Procedure.i GuessWhichDesktop(Width.i, Height.i, PreviousDesktop.i = -1) 146 | Protected Result.i = 0 ; Default to main screen 147 | 148 | If ((PreviousDesktop >= 0) And DesktopMatchesSize(PreviousDesktop, Width, Height)) 149 | ; Previous known desktop ID matches current size = retain it 150 | Result = PreviousDesktop 151 | Else 152 | Protected SizeMatch.i = DesktopBySize(Width, Height, -1) 153 | If (SizeMatch >= 0) 154 | ; Found matching display size - ID order probably changed 155 | Result = SizeMatch 156 | Else 157 | If (DesktopExists(PreviousDesktop)) 158 | ; No matching size, so use previous ID (maybe resized?) 159 | Result = PreviousDesktop 160 | EndIf 161 | EndIf 162 | EndIf 163 | ProcedureReturn (Result) 164 | EndProcedure 165 | 166 | Procedure.i IsMinimized(Window.i) 167 | ProcedureReturn (Bool(GetWindowState(Window) = #PB_Window_Minimize)) 168 | EndProcedure 169 | 170 | Procedure.i IsMaximized(Window.i) 171 | ProcedureReturn (Bool(GetWindowState(Window) = #PB_Window_Maximize)) 172 | EndProcedure 173 | 174 | Procedure CenterWindowInWindow(Window.i, Parent.i) 175 | If (GetWindowState(Window) <> #PB_Window_Normal) 176 | SetWindowState(Window, #PB_Window_Normal) 177 | EndIf 178 | Protected x.i = WindowX(Parent) + (WindowWidth(Parent) - WindowWidth(Window))/2 179 | Protected y.i = WindowY(Parent) + (WindowHeight(Parent) - WindowHeight(Window))/2 180 | ResizeWindow(Window, x, y, #PB_Ignore, #PB_Ignore) 181 | EndProcedure 182 | 183 | Procedure.i SameDesktop(Window.i, Parent.i) 184 | ProcedureReturn (Bool(DesktopFromWindow(Window) = DesktopFromWindow(Parent))) 185 | EndProcedure 186 | 187 | Procedure EnsureSameDesktop(Window.i, Parent.i) 188 | If (Not SameDesktop(Window, Parent)) 189 | CenterWindowInWindow(Window, Parent) 190 | EndIf 191 | EndProcedure 192 | 193 | Procedure CenterWindowInDesktop(Window.i, Desktop.i = 0, Maximized.i = #False) 194 | Protected n.i = DesktopCount() 195 | If (n > 0) 196 | If ((Desktop < 0) Or (Desktop >= n)) 197 | Desktop = 0 198 | EndIf 199 | If (GetWindowState(Window) <> #PB_Window_Normal) 200 | SetWindowState(Window, #PB_Window_Normal) 201 | EndIf 202 | Protected x.i = DesktopX(Desktop) + (DesktopWidth(Desktop) - WindowWidth(Window, #PB_Window_FrameCoordinate))/2 203 | Protected y.i = DesktopY(Desktop) + (DesktopHeight(Desktop) - WindowHeight(Window, #PB_Window_FrameCoordinate))/2 204 | ResizeWindow(Window, x, y, #PB_Ignore, #PB_Ignore) 205 | If (Maximized) 206 | SetWindowState(Window, #PB_Window_Maximize) 207 | EndIf 208 | EndIf 209 | EndProcedure 210 | 211 | Procedure LocateWindowInDesktop(Window.i, x.i, y.i, Desktop.i = 0, Maximized.i = #False) 212 | Protected n.i = DesktopCount() 213 | If (n > 0) 214 | If ((Desktop < 0) Or (Desktop >= n)) 215 | Desktop = 0 216 | EndIf 217 | If (GetWindowState(Window) <> #PB_Window_Normal) 218 | SetWindowState(Window, #PB_Window_Normal) 219 | EndIf 220 | x = DesktopX(Desktop) + x 221 | y = DesktopY(Desktop) + y 222 | ResizeWindow(Window, x, y, #PB_Ignore, #PB_Ignore) 223 | If (Maximized) 224 | SetWindowState(Window, #PB_Window_Maximize) 225 | EndIf 226 | EndIf 227 | EndProcedure 228 | 229 | Procedure EnsureWindowVisible(Window.i) 230 | Protected Visible.i = #False 231 | If (GetWindowState(Window) = #PB_Window_Normal) 232 | Protected WinX.i = WindowX(Window) 233 | Protected WinY.i = WindowY(Window) 234 | Protected WinW.i = WindowWidth(Window) 235 | Protected WinH.i = WindowHeight(Window) 236 | Protected n.i = DesktopCount() 237 | Protected i.i 238 | For i = 0 To n - 1 239 | If (WinX < DesktopX(i) + DesktopWidth(i)) 240 | If (WinY < DesktopY(i) + DesktopHeight(i)) 241 | If (WinX + WinW > DesktopX(i)) 242 | If (WinY + WinH > DesktopY(i)) 243 | Visible = #True 244 | Break 245 | EndIf 246 | EndIf 247 | EndIf 248 | EndIf 249 | Next i 250 | If (Not Visible) 251 | CenterWindowInDesktop(Window, 0, #False) 252 | EndIf 253 | EndIf 254 | EndProcedure 255 | 256 | Procedure.i SetTopWindow(Window.i, NoActivate.i = #False) 257 | Protected Result.i = #False 258 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 259 | If (NoActivate) 260 | Protected CurTopmost.i = GetWindowLongPtr_(WindowID(Window), #GWL_EXSTYLE) & #WS_EX_TOPMOST 261 | SetWindowPos_(WindowID(Window), #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE | #SWP_NOACTIVATE) 262 | If (Not CurTopmost) 263 | SetWindowPos_(WindowID(Window), #HWND_NOTOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE | #SWP_NOACTIVATE) 264 | EndIf 265 | Else 266 | Result = Bool(SetForegroundWindow_(WindowID(Window))) 267 | EndIf 268 | CompilerElse 269 | StickyWindow(Window, #True) 270 | If (Not NoActivate) 271 | SetActiveWindow(Window) 272 | EndIf 273 | StickyWindow(Window, #False) 274 | CompilerEndIf 275 | ProcedureReturn (Result) 276 | EndProcedure 277 | 278 | 279 | 280 | 281 | 282 | 283 | 284 | 285 | 286 | 287 | 288 | ;- 289 | ;- Demo Program 290 | 291 | CompilerIf (#PB_Compiler_IsMainFile) 292 | DisableExplicit 293 | 294 | OpenWindow(1, 400, 0, 480, 360, "Parent Window", #PB_Window_SystemMenu) 295 | ButtonGadget(1, 40, 40, 400, 280, "Center in Screen") 296 | OpenWindow(0, 0, 0, 240, 180, "Child Window", #PB_Window_SystemMenu, WindowID(1)) 297 | ButtonGadget(0, 40, 40, 160, 100, "Center in Parent Window") 298 | 299 | Repeat 300 | Event = WaitWindowEvent() 301 | If (Event = #PB_Event_Gadget) 302 | If (EventGadget() = 0) 303 | CenterWindowInWindow(0, 1) 304 | ElseIf (EventGadget() = 1) 305 | CenterWindowInDesktop(1, DesktopFromWindow(1)) 306 | EndIf 307 | EndIf 308 | Until (Event = #PB_Event_CloseWindow) 309 | 310 | 311 | CompilerEndIf 312 | CompilerEndIf 313 | ;- -------------------------------------------------------------------------------- /EnvironmentPaths.pbi: -------------------------------------------------------------------------------- 1 | ; +------------------+ 2 | ; | EnvironmentPaths | 3 | ; +------------------+ 4 | ; | 2016.03.23 . Creation 5 | ; | 2017.05.05 . Multiple-include safe, cleaned up code 6 | ; | 2018.10.30 . Added ResetEnvironmentPath(), FindEnvironmentFile() 7 | 8 | ;- 9 | CompilerIf (Not Defined(__EnvironmentPaths_Included, #PB_Constant)) 10 | #__EnvironmentPaths_Included = #True 11 | 12 | CompilerIf (#PB_Compiler_IsMainFile) 13 | EnableExplicit 14 | CompilerEndIf 15 | 16 | ;- Constants (Public) 17 | 18 | Enumeration 19 | #EnvPaths_Sort = $01 20 | #EnvPaths_NoDuplicates = $02 21 | #EnvPaths_NoMissing = $04 22 | EndEnumeration 23 | 24 | ;- 25 | ;- Lists (Private) 26 | 27 | Global NewList _EnvPath.s() 28 | 29 | ;- 30 | ;- Procedures (Public) 31 | 32 | Procedure.i ExamineEnvironmentPaths(Flags.i = #Null) 33 | ClearList(_EnvPath()) 34 | AddElement(_EnvPath()) : _EnvPath() = GetCurrentDirectory() 35 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 36 | Protected Raw.s = GetEnvironmentVariable("PATH") 37 | If (Raw) 38 | Protected n.i = 1 + CountString(Raw, ";") 39 | Protected Invalid.i 40 | Protected i.i 41 | For i = 1 To n 42 | Protected Path.s = StringField(Raw, i, ";") 43 | If (Path) 44 | If (Right(Path, 1) <> "\") 45 | Path + "\" 46 | EndIf 47 | Select (FileSize(Path)) 48 | Case -2 49 | Invalid = #False 50 | Case -1 51 | Invalid = Bool(Flags & #EnvPaths_NoMissing) 52 | Default 53 | Invalid = #True 54 | EndSelect 55 | If (Flags & #EnvPaths_NoDuplicates) 56 | ForEach (_EnvPath()) 57 | If (LCase(_EnvPath()) = LCase(Path)) 58 | Invalid = #True 59 | LastElement(_EnvPath()) 60 | Break 61 | EndIf 62 | Next 63 | EndIf 64 | If (Not Invalid) 65 | AddElement(_EnvPath()) 66 | _EnvPath() = Path 67 | EndIf 68 | EndIf 69 | Next i 70 | If (Flags & #EnvPaths_Sort) 71 | SortList(_EnvPath(), #PB_Sort_Ascending | #PB_Sort_NoCase) 72 | EndIf 73 | EndIf 74 | CompilerElse 75 | ;? TODO: Examine paths on Unix-like systems 76 | AddElement(_EnvPath()) : _EnvPath() = "/" 77 | AddElement(_EnvPath()) : _EnvPath() = GetHomeDirectory() 78 | CompilerEndIf 79 | ResetList(_EnvPath()) 80 | ProcedureReturn (ListSize(_EnvPath())) 81 | EndProcedure 82 | 83 | Procedure ResetEnvironmentPath() 84 | ResetList(_EnvPath()) 85 | EndProcedure 86 | 87 | Procedure.i NextEnvironmentPath() 88 | ProcedureReturn (NextElement(_EnvPath())) 89 | EndProcedure 90 | 91 | Procedure.s EnvironmentPath() 92 | If (ListIndex(_EnvPath()) >= 0) 93 | ProcedureReturn (_EnvPath()) 94 | EndIf 95 | EndProcedure 96 | 97 | Procedure AddEnvironmentPath(Path.s) 98 | If (Path) 99 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 100 | Protected PathList.s = ";" + GetEnvironmentVariable("Path") + ";" 101 | Path = RTrim(ReplaceString(Path, "/", "\"), "\") 102 | If (FindString(LCase(PathList), ";" + LCase(Path) + ";") Or 103 | FindString(LCase(PathList), ";" + LCase(Path) + "\;")) 104 | Else 105 | PathList + Path + "\" 106 | EndIf 107 | PathList = Trim(PathList, ";") 108 | SetEnvironmentVariable("Path", PathList) 109 | CompilerEndIf 110 | EndIf 111 | EndProcedure 112 | 113 | Procedure.s FindEnvironmentFile(Name.s) 114 | Protected Result.s 115 | If (ExamineEnvironmentPaths(#EnvPaths_NoDuplicates | #EnvPaths_NoMissing)) 116 | While (NextEnvironmentPath()) 117 | If (FileSize(EnvironmentPath() + Name) >= 0) 118 | Result = EnvironmentPath() + Name 119 | Break 120 | EndIf 121 | Wend 122 | If (Result = "") 123 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 124 | If (GetExtensionPart(Name) = "") 125 | Protected ExtList.s = GetEnvironmentVariable("PATHEXT") 126 | Protected N.i = 1 + CountString(ExtList, ";") 127 | Protected i.i 128 | ResetEnvironmentPath() 129 | While (NextEnvironmentPath()) 130 | For i = 1 To N 131 | Protected Try.s = Name + "." + LCase(Trim(StringField(ExtList, i, ";"), ".")) 132 | Try = EnvironmentPath() + Try 133 | If (FileSize(Try) >= 0) 134 | Result = Try 135 | Break 136 | EndIf 137 | Next i 138 | Wend 139 | EndIf 140 | CompilerEndIf 141 | EndIf 142 | EndIf 143 | ProcedureReturn (Result) 144 | EndProcedure 145 | 146 | 147 | 148 | 149 | ;- 150 | ;- Demo Program 151 | 152 | CompilerIf (#PB_Compiler_IsMainFile) 153 | DisableExplicit 154 | 155 | Macro Underline(_Text, _Character = "-") 156 | (_Text + #LF$ + RSet("", 3*Len(_Text)/2, (_Character))) 157 | EndMacro 158 | 159 | 160 | AddEnvironmentPath("C:\MyFakePath") 161 | 162 | Debug Underline("All Paths") 163 | If ExamineEnvironmentPaths() 164 | While NextEnvironmentPath() 165 | Debug EnvironmentPath() 166 | Wend 167 | EndIf 168 | 169 | Debug #LF$ 170 | Debug Underline("Sort, NoDuplicates, NoMissing") 171 | If ExamineEnvironmentPaths(#EnvPaths_Sort | #EnvPaths_NoDuplicates | #EnvPaths_NoMissing) 172 | While NextEnvironmentPath() 173 | Debug EnvironmentPath() 174 | Wend 175 | EndIf 176 | 177 | CompilerEndIf 178 | CompilerEndIf 179 | ;- 180 | -------------------------------------------------------------------------------- /FTPHelper.pbi: -------------------------------------------------------------------------------- 1 | ; +---------------+ 2 | ; | FTPHelper.pbi | 3 | ; +---------------+ 4 | ; | 2015.06.05 . Creation (PureBasic 5.31) 5 | ; | 2017.05.22 . Cleanup 6 | ; | 2018.06.15 . Added QuickFTPUpload() 7 | ; | 2018.07.07 . Moved RemoteFile formatting from QuickUpload into Upload 8 | ; | 2018.11.08 . Upload and Download now default to current FTP/Local dirs 9 | ; | 2018.11.09 . Added OpenFTPFromFile 10 | ; | 2020-06-19 . Remove Preferences calls (only use helper File functions) 11 | 12 | ;- 13 | CompilerIf (Not Defined(__FTPHelper_Included, #PB_Constant)) 14 | #__FTPHelper_Included = #True 15 | 16 | CompilerIf (#PB_Compiler_IsMainFile) 17 | EnableExplicit 18 | CompilerEndIf 19 | 20 | 21 | 22 | ;- Procedures (Private) 23 | 24 | Procedure.i _FTPHelper_FindGroup(FN.i, GroupName.s) 25 | Protected Result.i = #False 26 | FileSeek(FN, 0) 27 | ReadStringFormat(FN) 28 | If (GroupName) 29 | GroupName = LCase("[" + Trim(GroupName) + "]") 30 | While (Not Eof(FN)) 31 | Protected Line.s = ReadString(FN) 32 | If (LCase(Trim(Line)) = GroupName) 33 | Result = #True 34 | Break 35 | EndIf 36 | Wend 37 | EndIf 38 | ProcedureReturn (Result) 39 | EndProcedure 40 | 41 | Procedure.s _FTPHelper_FindString(FN.i, Key.s, DefaultValue.s = "") 42 | Protected Result.s = DefaultValue 43 | Protected Location.i = Loc(FN) 44 | Key = LCase(Trim(Key)) 45 | While (Not Eof(FN)) 46 | Protected Line.s = ReadString(FN) 47 | If (Left(LTrim(Line), 1) = ";") 48 | Continue 49 | ElseIf (Left(LTrim(Line), 1) = "[") 50 | Break 51 | Else 52 | Protected i.i = FindString(Line, "=") 53 | If (i) 54 | If (LCase(Trim(Left(Line, i-1))) = Key) 55 | Result = Trim(Mid(Line, i+1)) 56 | Break 57 | EndIf 58 | EndIf 59 | EndIf 60 | Wend 61 | FileSeek(FN, Location) 62 | ProcedureReturn (Result) 63 | EndProcedure 64 | 65 | 66 | 67 | ;- 68 | ;- Procedures (Public) 69 | 70 | Procedure.i ChangeFTPDirectory(FTP.i, Directory.s, Create.i = #False) 71 | Protected Result.i = #False 72 | If (IsFTP(FTP)) 73 | If (CheckFTPConnection(FTP)) 74 | If (Directory) 75 | ReplaceString(Directory, "\", "/", #PB_String_InPlace) 76 | Directory = RTrim(Directory, "/") + "/" 77 | Protected Current.s 78 | Current = RTrim(GetFTPDirectory(FTP), "/") + "/" 79 | If (Left(Directory, 1) <> "/") 80 | Directory = Current + Directory 81 | EndIf 82 | If (Current <> Directory) 83 | Result = #True 84 | While (Current <> Left(Directory, Len(Current))) 85 | If (Not SetFTPDirectory(FTP, "..")) 86 | Result = #False 87 | Break 88 | EndIf 89 | Current = RTrim(GetFTPDirectory(FTP), "/") + "/" 90 | Wend 91 | If (Result) 92 | While (Len(Current) < Len(Directory)) 93 | Protected Sub.s 94 | Sub = StringField(Mid(Directory, Len(Current) + 1), 1, "/") 95 | If (Create) 96 | CreateFTPDirectory(FTP, Sub) 97 | EndIf 98 | If (Not SetFTPDirectory(FTP, Sub)) 99 | Result = #False 100 | Break 101 | EndIf 102 | Current = RTrim(GetFTPDirectory(FTP), "/") + "/" 103 | Wend 104 | EndIf 105 | Else 106 | Result = #True 107 | EndIf 108 | Else 109 | Result = #True 110 | EndIf 111 | EndIf 112 | EndIf 113 | ProcedureReturn (Result) 114 | EndProcedure 115 | 116 | Procedure.i UploadFTPFile(FTP.i, LocalFile.s, RemoteFile.s = "") 117 | Protected Result.i = #False 118 | If (IsFTP(FTP)) 119 | If (LocalFile) 120 | If (RemoteFile = "") 121 | ;RemoteFile = "/" + GetFilePart(LocalFile) 122 | RemoteFile = GetFTPDirectory(FTP) + "/" + GetFilePart(LocalFile) 123 | ElseIf (Right(RemoteFile, 1) = "/") 124 | RemoteFile + GetFilePart(LocalFile) 125 | EndIf 126 | If (ChangeFTPDirectory(FTP, GetPathPart(RemoteFile), #True)) 127 | Result = Bool(SendFTPFile(FTP, LocalFile, GetFilePart(RemoteFile))) 128 | EndIf 129 | EndIf 130 | EndIf 131 | ProcedureReturn (Result) 132 | EndProcedure 133 | 134 | Procedure.i DownloadFTPFile(FTP.i, RemoteFile.s, LocalFile.s = "") 135 | Protected Result.i = #False 136 | If (IsFTP(FTP)) 137 | If (RemoteFile) 138 | If (GetPathPart(RemoteFile) = "") 139 | RemoteFile = GetFTPDirectory(FTP) + "/" + RemoteFile 140 | EndIf 141 | If (LocalFile = "") 142 | LocalFile = GetCurrentDirectory() + GetFilePart(RemoteFile) 143 | EndIf 144 | If (ChangeFTPDirectory(FTP, GetPathPart(RemoteFile), #False)) 145 | Result = Bool(ReceiveFTPFile(FTP, GetFilePart(RemoteFile), LocalFile)) 146 | EndIf 147 | EndIf 148 | EndIf 149 | ProcedureReturn (Result) 150 | EndProcedure 151 | 152 | Procedure.i QuickFTPUpload(File.s, Server.s, RemoteFile.s = "", User.s = "", Pass.s = "", Port.i = 21, Passive.i = #True) 153 | Protected Result.i = #False 154 | If (File And (FileSize(File) >= 0) And Server) 155 | If (InitNetwork()) 156 | Protected FTP.i = OpenFTP(#PB_Any, Server, User, Pass, Passive, Port) 157 | If (FTP) 158 | Result = UploadFTPFile(FTP, File, RemoteFile) 159 | CloseFTP(FTP) 160 | EndIf 161 | EndIf 162 | EndIf 163 | ProcedureReturn (Result) 164 | EndProcedure 165 | 166 | Procedure.s FTPDirectoryContents(FTP.i, IncludeParent.i = #False) 167 | Protected Result.s 168 | If (ExamineFTPDirectory(FTP)) 169 | While (NextFTPDirectoryEntry(FTP)) 170 | Protected Name.s = FTPDirectoryEntryName(FTP) 171 | Select (Name) 172 | Case "." 173 | ; skip 174 | Case".." 175 | If (IncludeParent) 176 | Result + #LF$ + ".." 177 | EndIf 178 | Default 179 | Result + #LF$ + FTPDirectoryEntryName(FTP) 180 | If (FTPDirectoryEntryType(FTP) = #PB_FTP_Directory) 181 | Result + "/" 182 | EndIf 183 | EndSelect 184 | Wend 185 | FinishFTPDirectory(FTP) 186 | EndIf 187 | ProcedureReturn (Mid(Result, 2)) 188 | EndProcedure 189 | 190 | Procedure.i OpenFTPFromFile(FTP.i, File.s, Group.s = "") 191 | Protected Result.i = #Null 192 | Protected FN.i = ReadFile(#PB_Any, File) 193 | If (FN) 194 | If ((Group = "") Or (_FTPHelper_FindGroup(FN, Group))) 195 | Protected RemoveChar.s = Left(_FTPHelper_FindString(FN, "rc"), 1) 196 | Protected Server.s = RemoveString(_FTPHelper_FindString(FN, "s"), RemoveChar) 197 | Protected User.s = RemoveString(_FTPHelper_FindString(FN, "u"), RemoveChar) 198 | Protected Pass.s = RemoveString(_FTPHelper_FindString(FN, "p"), RemoveChar) 199 | Protected Dir.s = RemoveString(_FTPHelper_FindString(FN, "d"), RemoveChar) 200 | Protected Port.i = Val(_FTPHelper_FindString(FN, "port", "21")) 201 | Protected Passive.i = Bool(Val(_FTPHelper_FindString(FN, "passive", "1"))) 202 | If (FindString(Server, "://")) 203 | Server = StringField(Server, 2, "://") 204 | EndIf 205 | Server = RTrim(Server, "/") 206 | If (Server And User And Pass And (Port > 0)) 207 | Result = OpenFTP(FTP, Server, User, Pass, Passive, Port) 208 | PokeS(@Pass, Space(Len(Pass))) 209 | If (Result) 210 | If (FTP = #PB_Any) 211 | FTP = Result 212 | EndIf 213 | If (Dir) 214 | If (Right(Dir, 1) <> "/") 215 | Dir + "/" 216 | EndIf 217 | If (ChangeFTPDirectory(FTP, Dir, #False)) 218 | ; 219 | Else 220 | CloseFTP(FTP) 221 | Result = #Null 222 | EndIf 223 | EndIf 224 | EndIf 225 | EndIf 226 | EndIf 227 | CloseFile(FN) 228 | EndIf 229 | ProcedureReturn (Result) 230 | EndProcedure 231 | 232 | 233 | 234 | 235 | 236 | 237 | ;- 238 | ;- Demo Program 239 | 240 | CompilerIf (#PB_Compiler_IsMainFile) 241 | DisableExplicit 242 | 243 | ; ========================================== 244 | ; Fill these in to test! 245 | Server.s = "" 246 | User.s = "myUser" 247 | Password.s = "myPassword" 248 | RemoteFile.s = "/www/files/myFile.dat" 249 | ; ========================================== 250 | 251 | Passive.i = #True 252 | Port.i = 21 253 | 254 | LocalFile.s = GetTemporaryDirectory() + GetFilePart(RemoteFile) 255 | RemoteFile2.s = RemoteFile + ".new" 256 | 257 | If (Server) 258 | If InitNetwork() 259 | Debug "Connecting to " + Server + "..." 260 | If OpenFTP(0, Server, User, Password, Passive, Port) 261 | 262 | Debug "OK" + #LF$ + "Downloading file..." 263 | If (DownloadFTPFile(0, RemoteFile, LocalFile)) 264 | Debug "OK" + #LF$ + "Uploading file..." 265 | If (UploadFTPFile(0, LocalFile, RemoteFile2)) 266 | Debug "OK" + #LF$ + "Resetting to root directory..." 267 | If (ChangeFTPDirectory(0, "/")) 268 | Debug "OK" + #LF$ + "Done" 269 | Else 270 | Debug "Failed!" 271 | EndIf 272 | Else 273 | Debug "Failed!" 274 | EndIf 275 | Else 276 | Debug "Failed!" 277 | EndIf 278 | 279 | CloseFTP(0) 280 | Else 281 | Debug "Could not open FTP connection!" 282 | EndIf 283 | EndIf 284 | Else 285 | Debug "Please specify a server and username in code" 286 | EndIf 287 | 288 | CompilerEndIf 289 | CompilerEndIf 290 | ;- -------------------------------------------------------------------------------- /FormatDatePHP.pbi: -------------------------------------------------------------------------------- 1 | ; +---------------+ 2 | ; | FormatDatePHP | 3 | ; +---------------+ 4 | ; | 8.21.2011 . Creation (PB 4.51) 5 | ; | .22. . Added full date/time combos, Swatch time, difference from GMT 6 | ; | .23. - Version 1.0 (for PB forums) 7 | ; | 5.11.2016 - Version 1.1 (corrected day prefixes such as "st") 8 | ; | 1.23.2017 - Version 1.2 (corrected GMT offset bug when passing midnight) 9 | ; | 4.13.2018 - Version 1.3 (multiple-include safe, EnableExplicit-safe, 10 | ; | use time() for GMT calc, cleaned up demo) 11 | ; 12 | ;- 13 | ; 14 | ; This procedure mimics the native date() function of the PHP language. 15 | ; It can be used as an expanded replacement for PB's FormatDate() function, 16 | ; but be aware that it uses completely different syntax! 17 | ; The Timestamp argument defaults to -1, which is replaced by the current time. 18 | ; 19 | ; The format syntax (list of character codes) matches PHP's syntax here: 20 | ; *** http://php.net/manual/en/function.date.php *** 21 | ; 22 | ; 23 | ; 24 | ; Note the following exceptions, and their contribution to the result: 25 | ; 26 | ; 'u' (microseconds) PB timestamps do not use microseconds, always becomes "000000" 27 | ; 'W' (ISO week number) not implemented, becomes "?" 28 | ; 'o' (ISO year) not implemented, becomes "?" 29 | ; 'e' (time zone ID) not implemented, becomes "?" 30 | ; 'I' (daylight savings flag) not implemented, becomes "?" 31 | ; 'T' (time zone abbreviation) not implemented, becomes "?" 32 | ; 33 | 34 | CompilerIf (Not Defined(__FormatDatePHP_Included, #PB_Constant)) 35 | #__FormatDatePHP_Included = #True 36 | 37 | CompilerIf (#PB_Compiler_IsMainFile) 38 | EnableExplicit 39 | CompilerEndIf 40 | 41 | 42 | 43 | 44 | ;- Imports 45 | 46 | CompilerIf (Not Defined(time, #PB_Procedure)) 47 | ImportC "" 48 | time(*t = #Null) 49 | EndImport 50 | CompilerEndIf 51 | 52 | 53 | 54 | 55 | ;- 56 | ;- Procedures 57 | 58 | Procedure.s FormatDatePHP(Format.s, Timestamp.i = -1) 59 | Protected Result.s 60 | Protected Year.i, Month.i, Day.i, Hour.i, Minute.i, Second.i 61 | Protected FromGMT.i, GMTHour.s, GMTMinute.s, Temp.i 62 | Protected *C.CHARACTER 63 | 64 | 65 | ; Use current date, by default 66 | If (Timestamp = -1) 67 | Timestamp = Date() 68 | EndIf 69 | 70 | 71 | ; Get time zone / GMT offset 72 | CompilerIf (#True) 73 | 74 | ; Use cross-platform time() function 75 | Protected GMTTime.i = time() 76 | Protected LocalTime.i = Date() 77 | FromGMT = (LocalTime - GMTTime)/60 78 | 79 | CompilerElseIf ((#PB_Compiler_OS = #PB_OS_Windows) And (#True)) 80 | 81 | ; Use Windows API functions 82 | Protected GMTTime.SYSTEMTIME, LocalTime.SYSTEMTIME 83 | GetSystemTime_(GMTTime) 84 | GetLocalTime_(LocalTime) 85 | FromGMT = (LocalTime\wHour - GMTTime\wHour)*60 + (LocalTime\wMinute - GMTTime\wMinute) 86 | If (GMTTime\wDayOfWeek = (LocalTime\wDayOfWeek + 1) % 7) 87 | FromGMT - 24*60 88 | ElseIf (GMTTime\wDayOfWeek = (LocalTime\wDayOfWeek + 7 - 1) % 7) 89 | FromGMT + 24*60 90 | EndIf 91 | 92 | CompilerElse 93 | FromGMT = 0 94 | CompilerEndIf 95 | 96 | If (FromGMT >= 0) 97 | GMTHour = "+" + RSet(Str(FromGMT / 60), 2, "0") 98 | GMTMinute = RSet(Str(FromGMT % 60), 2, "0") 99 | Else 100 | GMTHour = "-" + RSet(Str((0-FromGMT) / 60), 2, "0") 101 | GMTMinute = RSet(Str((0-FromGMT) % 60), 2, "0") 102 | EndIf 103 | 104 | 105 | ; Extract numeric timestamp values 106 | Year = Year (Timestamp) 107 | Month = Month (Timestamp) 108 | Day = Day (Timestamp) 109 | Hour = Hour (Timestamp) 110 | Minute = Minute(Timestamp) 111 | Second = Second(Timestamp) 112 | 113 | 114 | ; Parse through each format character 115 | Result = "" 116 | *C = @Format 117 | While (*C\c) 118 | Select (*C\c) 119 | 120 | ; Day representations 121 | Case 'd' : Result + RSet(Str(Day), 2, "0") 122 | Case 'D' 123 | Select (DayOfWeek(Timestamp)) 124 | Case 0 : Result + "Sun" 125 | Case 1 : Result + "Mon" 126 | Case 2 : Result + "Tue" 127 | Case 3 : Result + "Wed" 128 | Case 4 : Result + "Thu" 129 | Case 5 : Result + "Fri" 130 | Case 6 : Result + "Sat" 131 | EndSelect 132 | Case 'j' : Result + Str(Day) 133 | Case 'l' 134 | Select (DayOfWeek(Timestamp)) 135 | Case 0 : Result + "Sunday" 136 | Case 1 : Result + "Monday" 137 | Case 2 : Result + "Tuesday" 138 | Case 3 : Result + "Wednesday" 139 | Case 4 : Result + "Thursday" 140 | Case 5 : Result + "Friday" 141 | Case 6 : Result + "Saturday" 142 | EndSelect 143 | Case 'N' : Result + Str(((DayOfWeek(Timestamp) + 6) % 7) + 1) 144 | Case 'S' 145 | Select (Day) 146 | Case 1, 21, 31 : Result + "st" 147 | Case 2, 22 : Result + "nd" 148 | Case 3, 23 : Result + "rd" 149 | Default : Result + "th" 150 | EndSelect 151 | Case 'w' : Result + Str(DayOfWeek(Timestamp)) 152 | Case 'z' : Result + Str(DayOfYear(Timestamp)-1) 153 | 154 | 155 | ; Week representations 156 | Case 'W' : Result + "?" ; ISO week (not implemented) 157 | 158 | 159 | ; Month representations 160 | Case 'F' 161 | Select (Month) 162 | Case 1 : Result + "January" 163 | Case 2 : Result + "February" 164 | Case 3 : Result + "March" 165 | Case 4 : Result + "April" 166 | Case 5 : Result + "May" 167 | Case 6 : Result + "June" 168 | Case 7 : Result + "July" 169 | Case 8 : Result + "August" 170 | Case 9 : Result + "September" 171 | Case 10 : Result + "October" 172 | Case 11 : Result + "November" 173 | Case 12 : Result + "December" 174 | EndSelect 175 | Case 'm' : Result + RSet(Str(Month), 2, "0") 176 | Case 'M' 177 | Select (Month) 178 | Case 1 : Result + "Jan" 179 | Case 2 : Result + "Feb" 180 | Case 3 : Result + "Mar" 181 | Case 4 : Result + "Apr" 182 | Case 5 : Result + "May" 183 | Case 6 : Result + "Jun" 184 | Case 7 : Result + "Jul" 185 | Case 8 : Result + "Aug" 186 | Case 9 : Result + "Sep" 187 | Case 10 : Result + "Oct" 188 | Case 11 : Result + "Nov" 189 | Case 12 : Result + "Dec" 190 | EndSelect 191 | Case 'n' : Result + Str(Month) 192 | Case 't' 193 | Select (Month) 194 | Case 1,3,5,7,8,10,12 195 | Result + "31" 196 | Case 2 197 | If (Year % 400 = 0) 198 | Result + "29" 199 | ElseIf (Year % 100 = 0) 200 | Result + "28" 201 | ElseIf (Year % 4 = 0) 202 | Result + "29" 203 | Else 204 | Result + "28" 205 | EndIf 206 | Case 4,6,9,11 207 | Result + "30" 208 | EndSelect 209 | 210 | 211 | ; Year representations 212 | Case 'L' 213 | If (Year % 400 = 0) 214 | Result + "1" 215 | ElseIf (Year % 100 = 0) 216 | Result + "0" 217 | ElseIf (Year % 4 = 0) 218 | Result + "1" 219 | Else 220 | Result + "0" 221 | EndIf 222 | Case 'o' : Result + "?" ; ISO year (not implemented) 223 | Case 'Y' : Result + Str(Year) 224 | Case 'y' : Result + RSet(Str(Year % 100), 2, "0") 225 | 226 | 227 | ; Time representations 228 | Case 'a' 229 | If (Hour >= 12) 230 | Result + "pm" 231 | Else 232 | Result + "am" 233 | EndIf 234 | Case 'A' 235 | If (Hour >= 12) 236 | Result + "PM" 237 | Else 238 | Result + "AM" 239 | EndIf 240 | Case 'B' 241 | Result + RSet(Str((36000*Hour + 600*Minute + 10*Second) / 864), 3, "0") 242 | Case 'g' : Result + Str(((Hour + 23) % 12) + 1) 243 | Case 'G' : Result + Str(Hour) 244 | Case 'h' : Result + RSet(Str(((Hour + 23) % 12) + 1), 2, "0") 245 | Case 'H' : Result + RSet(Str(Hour), 2, "0") 246 | Case 'i' : Result + RSet(Str(Minute), 2, "0") 247 | Case 's' : Result + RSet(Str(Second), 2, "0") 248 | Case 'u' : Result + "000000" ; microseconds (not implemented) 249 | 250 | 251 | ; Timezone representations 252 | Case 'e' : Result + "?" ; Timezone identifier (not implemented) 253 | Case 'I' : Result + "?" ; Daylight savings flag (not implemented) 254 | Case 'O' : Result + GMTHour + GMTMinute 255 | Case 'P' : Result + GMTHour + ":" + GMTMinute 256 | Case 'T' : Result + "?" ; Timezone abbreviation (not implemented) 257 | Case 'Z' : Result + Str(FromGMT*60) 258 | 259 | 260 | ; Full date/time 261 | Case 'c' : Result + FormatDatePHP("Y-m-d\TH:i:sP") 262 | Case 'r' : Result + FormatDatePHP("D, d M Y H:i:s O", Timestamp) 263 | Case 'U' : Result + RSet(Str(Timestamp), 11, "0") 264 | 265 | 266 | ; Escape or pass all other characters 267 | Case '\' : *C + SizeOf(CHARACTER) : Result + Chr(*C\c) 268 | Default : Result + Chr(*C\c) 269 | 270 | EndSelect 271 | *C + SizeOf(CHARACTER) 272 | Wend 273 | 274 | ProcedureReturn (Result) 275 | EndProcedure 276 | 277 | 278 | 279 | 280 | 281 | 282 | 283 | 284 | 285 | 286 | 287 | ;- 288 | ;- Demo Program 289 | 290 | CompilerIf (#PB_Compiler_IsMainFile) 291 | DisableExplicit 292 | 293 | ; Create array of all valid codes 294 | #PHPFormats = 39 295 | Define i.i = 0 296 | Dim Format.s(#PHPFormats - 1) 297 | Format(i) = "\I\t \i\s l \t\h\e jS, \o\f M Y." : i + 1 298 | Format(i) = "d" : i + 1 299 | Format(i) = "D" : i + 1 300 | Format(i) = "j" : i + 1 301 | Format(i) = "l" : i + 1 302 | Format(i) = "N" : i + 1 303 | Format(i) = "S" : i + 1 304 | Format(i) = "w" : i + 1 305 | Format(i) = "z" : i + 1 306 | Format(i) = "W" : i + 1 307 | Format(i) = "F" : i + 1 308 | Format(i) = "m" : i + 1 309 | Format(i) = "M" : i + 1 310 | Format(i) = "n" : i + 1 311 | Format(i) = "t" : i + 1 312 | Format(i) = "L" : i + 1 313 | Format(i) = "o" : i + 1 314 | Format(i) = "Y" : i + 1 315 | Format(i) = "y" : i + 1 316 | Format(i) = "a" : i + 1 317 | Format(i) = "A" : i + 1 318 | Format(i) = "B" : i + 1 319 | Format(i) = "g" : i + 1 320 | Format(i) = "G" : i + 1 321 | Format(i) = "h" : i + 1 322 | Format(i) = "H" : i + 1 323 | Format(i) = "i" : i + 1 324 | Format(i) = "s" : i + 1 325 | Format(i) = "u" : i + 1 326 | Format(i) = "e" : i + 1 327 | Format(i) = "I" : i + 1 328 | Format(i) = "O" : i + 1 329 | Format(i) = "P" : i + 1 330 | Format(i) = "T" : i + 1 331 | Format(i) = "Z" : i + 1 332 | Format(i) = "c" : i + 1 333 | Format(i) = "r" : i + 1 334 | Format(i) = "U" : i + 1 335 | Format(i) = "\\" : i + 1 336 | 337 | ; Create window with ListIcon 338 | OpenWindow(0, 0, 0, 440, 400, "FormatDatePHP Demo", 339 | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_Invisible | #PB_Window_SizeGadget) 340 | ListIconGadget(0, 0, 0, WindowWidth(0), WindowHeight(0), "Format", 195, 341 | #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect) 342 | AddGadgetColumn(0, 1, "Result", 195) 343 | SmartWindowRefresh(0, #True) 344 | 345 | ; Add all valid formats 346 | Define Event.i, Timestamp.i 347 | For i = 0 To #PHPFormats - 1 348 | AddGadgetItem(0, i+1, Format(i)) 349 | Next i 350 | 351 | ; Timer to update 352 | AddWindowTimer(0, 0, 1000) 353 | 354 | ; Resize 355 | Procedure ResizeCB() 356 | ResizeGadget(0, 0, 0, WindowWidth(0), WindowHeight(0)) 357 | EndProcedure 358 | BindEvent(#PB_Event_SizeWindow, @ResizeCB()) 359 | 360 | Repeat 361 | Event = WaitWindowEvent() 362 | 363 | ; Update all fields 364 | If (Event = #PB_Event_Timer) 365 | Timestamp.i = Date() 366 | For i = 0 To #PHPFormats - 1 367 | SetGadgetItemText(0, i, FormatDatePHP(Format(i), Timestamp), 1) 368 | Next i 369 | HideWindow(0, #False) 370 | EndIf 371 | Until (Event = #PB_Event_CloseWindow) 372 | 373 | CompilerEndIf 374 | CompilerEndIf 375 | ;- -------------------------------------------------------------------------------- /GadgetCommon.pbi: -------------------------------------------------------------------------------- 1 | ; +--------------+ 2 | ; | GadgetCommon | 3 | ; +--------------+ 4 | ; | 2017.04.20 . Expanded demo to 3 different gadgets instead of 1, 5 | ; | added SelectAll and CheckAll procedures 6 | 7 | CompilerIf (Not Defined(__GadgetCommon_Included, #PB_Constant)) 8 | #__GadgetCommon_Included = #True 9 | 10 | CompilerIf (#PB_Compiler_IsMainFile) 11 | EnableExplicit 12 | CompilerEndIf 13 | 14 | ;- 15 | ;- Constants 16 | 17 | #PB_ListView_Selected = $01 18 | 19 | ;- 20 | ;- Procedures 21 | 22 | Procedure.i _CountFlaggedGadgetItems(Gadget.i, Checked.i) 23 | Protected Result.i = 0 24 | Protected Flag.i 25 | Protected n.i 26 | Select (GadgetType(Gadget)) 27 | Case #PB_GadgetType_ListIcon 28 | n = CountGadgetItems(Gadget) 29 | If (Checked) 30 | Flag = #PB_ListIcon_Checked 31 | Else 32 | Flag = #PB_ListIcon_Selected 33 | EndIf 34 | Case #PB_GadgetType_ListView 35 | n = CountGadgetItems(Gadget) 36 | If (Not Checked) 37 | Flag = #PB_ListView_Selected 38 | EndIf 39 | Case #PB_GadgetType_Tree 40 | n = CountGadgetItems(Gadget) 41 | If (Checked) 42 | Flag = #PB_Tree_Checked 43 | Else 44 | Flag = #PB_Tree_Selected 45 | EndIf 46 | EndSelect 47 | If (Flag And (n > 0)) 48 | Protected i.i 49 | For i = 0 To n - 1 50 | If (GetGadgetItemState(Gadget, i) & Flag) 51 | Result + 1 52 | EndIf 53 | Next i 54 | EndIf 55 | ProcedureReturn (Result) 56 | EndProcedure 57 | 58 | Procedure.i CountSelectedGadgetItems(Gadget.i) 59 | ProcedureReturn (_CountFlaggedGadgetItems(Gadget, #False)) 60 | EndProcedure 61 | 62 | Procedure.i CountCheckedGadgetItems(Gadget.i) 63 | ProcedureReturn (_CountFlaggedGadgetItems(Gadget, #True)) 64 | EndProcedure 65 | 66 | Procedure.i GadgetItemByItemData(Gadget.i, ItemData.i) 67 | Protected Result.i = -1 68 | Protected n.i 69 | Select (GadgetType(Gadget)) 70 | Case #PB_GadgetType_ListIcon, #PB_GadgetType_ListView, #PB_GadgetType_Tree 71 | n = CountGadgetItems(Gadget) 72 | EndSelect 73 | If (n > 0) 74 | Protected i.i 75 | For i = 0 To n - 1 76 | If (GetGadgetItemData(Gadget, i) = ItemData) 77 | Result = i 78 | Break 79 | EndIf 80 | Next i 81 | EndIf 82 | ProcedureReturn (Result) 83 | EndProcedure 84 | 85 | Procedure.i SelectedGadgetItemData(Gadget.i) 86 | Protected Result.i = #Null 87 | Protected i.i = GetGadgetState(Gadget) 88 | If (i >= 0) 89 | Result = GetGadgetItemData(Gadget, i) 90 | EndIf 91 | ProcedureReturn (Result) 92 | EndProcedure 93 | 94 | Procedure _SetGadgetItemFlagged(Gadget.i, Item.i, State.i, Checked.i) 95 | Protected Flag.i 96 | Select (GadgetType(Gadget)) 97 | Case #PB_GadgetType_ListIcon 98 | If (Checked) 99 | Flag = #PB_ListIcon_Checked 100 | Else 101 | Flag = #PB_ListIcon_Selected 102 | EndIf 103 | Case #PB_GadgetType_ListView 104 | If (Not Checked) 105 | Flag = #PB_ListView_Selected 106 | EndIf 107 | Case #PB_GadgetType_Tree 108 | If (Checked) 109 | Flag = #PB_Tree_Checked 110 | Else 111 | Flag = #PB_Tree_Selected 112 | EndIf 113 | EndSelect 114 | If (Flag) 115 | Protected Flags.i = GetGadgetItemState(Gadget, Item) 116 | If (State) 117 | Flags | Flag 118 | Else 119 | Flags & ~Flag 120 | EndIf 121 | SetGadgetItemState(Gadget, Item, Flags) 122 | EndIf 123 | EndProcedure 124 | 125 | Procedure SetGadgetItemChecked(Gadget.i, Item.i, State.i) 126 | _SetGadgetItemFlagged(Gadget, Item, State, #True) 127 | EndProcedure 128 | 129 | Procedure SetGadgetItemSelected(Gadget.i, Item.i, State.i) 130 | _SetGadgetItemFlagged(Gadget, Item, State, #False) 131 | EndProcedure 132 | 133 | Procedure.i _GetGadgetItemFlagged(Gadget.i, Item.i, Checked.i) 134 | Protected Result.i = #False 135 | Protected Flag.i 136 | Select (GadgetType(Gadget)) 137 | Case #PB_GadgetType_ListIcon 138 | If (Checked) 139 | Flag = #PB_ListIcon_Checked 140 | Else 141 | Flag = #PB_ListIcon_Selected 142 | EndIf 143 | Case #PB_GadgetType_ListView 144 | If (Not Checked) 145 | Flag = #PB_ListView_Selected 146 | EndIf 147 | Case #PB_GadgetType_Tree 148 | If (Checked) 149 | Flag = #PB_Tree_Checked 150 | Else 151 | Flag = #PB_Tree_Selected 152 | EndIf 153 | EndSelect 154 | If (Flag) 155 | Result = Bool(GetGadgetItemState(Gadget, Item) & Flag) 156 | EndIf 157 | ProcedureReturn (Result) 158 | EndProcedure 159 | 160 | Procedure.i GetGadgetItemChecked(Gadget.i, Item.i) 161 | ProcedureReturn (_GetGadgetItemFlagged(Gadget, Item, #True)) 162 | EndProcedure 163 | 164 | Procedure.i GetGadgetItemSelected(Gadget.i, Item.i) 165 | ProcedureReturn (_GetGadgetItemFlagged(Gadget, Item, #False)) 166 | EndProcedure 167 | 168 | Procedure SelectAllGadgetItems(Gadget.i, Deselect.i = #False) 169 | Select (GadgetType(Gadget)) 170 | Case #PB_GadgetType_ListIcon 171 | Protected n.i = CountGadgetItems(Gadget) 172 | Protected i.i 173 | If (Deselect) 174 | SetGadgetState(Gadget, -1) 175 | Else 176 | For i = 0 To n - 1 177 | SetGadgetItemState(Gadget, i, GetGadgetItemState(Gadget, i) | #PB_ListIcon_Selected) 178 | Next i 179 | EndIf 180 | Case #PB_GadgetType_ListView 181 | n = CountGadgetItems(Gadget) 182 | If (Deselect) 183 | SetGadgetState(Gadget, -1) 184 | Else 185 | For i = 0 To n - 1 186 | SetGadgetItemState(Gadget, i, GetGadgetItemState(Gadget, i) | #PB_ListView_Selected) 187 | Next i 188 | EndIf 189 | Case #PB_GadgetType_Tree 190 | If (Deselect) 191 | SetGadgetState(Gadget, -1) 192 | EndIf 193 | EndSelect 194 | EndProcedure 195 | 196 | Procedure CheckAllGadgetItems(Gadget.i, Uncheck.i = #False) 197 | Select (GadgetType(Gadget)) 198 | Case #PB_GadgetType_ListIcon 199 | Protected n.i = CountGadgetItems(Gadget) 200 | Protected i.i 201 | If (Uncheck) 202 | For i = 0 To n - 1 203 | SetGadgetItemState(Gadget, i, GetGadgetItemState(Gadget, i) & (~#PB_ListIcon_Checked)) 204 | Next i 205 | Else 206 | For i = 0 To n - 1 207 | SetGadgetItemState(Gadget, i, GetGadgetItemState(Gadget, i) | #PB_ListIcon_Checked) 208 | Next i 209 | EndIf 210 | Case #PB_GadgetType_ListView 211 | ; 212 | Case #PB_GadgetType_Tree 213 | n = CountGadgetItems(Gadget) 214 | If (Uncheck) 215 | For i = 0 To n - 1 216 | SetGadgetItemState(Gadget, i, GetGadgetItemState(Gadget, i) & (~#PB_Tree_Checked)) 217 | Next i 218 | Else 219 | For i = 0 To n - 1 220 | SetGadgetItemState(Gadget, i, GetGadgetItemState(Gadget, i) | #PB_Tree_Checked) 221 | Next i 222 | EndIf 223 | EndSelect 224 | EndProcedure 225 | 226 | ;- 227 | ;- Demo Program 228 | 229 | CompilerIf (#PB_Compiler_IsMainFile) 230 | DisableExplicit 231 | 232 | OpenWindow(0, 10, 10, 600, 360, "GadgetCommon", #PB_Window_ScreenCentered | #PB_Window_SystemMenu) 233 | ListIconGadget(0, 0, 0, 200, 200, "ListIcon", 100, #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_CheckBoxes | #PB_ListIcon_FullRowSelect | #PB_ListIcon_MultiSelect) 234 | ListViewGadget(2, 200, 0, 200, 200, #PB_ListView_MultiSelect) 235 | TreeGadget(4, 400, 0, 200, 200, #PB_Tree_CheckBoxes | #PB_Tree_AlwaysShowSelection) 236 | For g = 0 To 2 237 | For i = 0 To 5 238 | AddGadgetItem(g * 2, i, Chr('A' + i)) 239 | SetGadgetItemData(g * 2, i, i + 100) 240 | If (g <> 2) 241 | SetGadgetItemSelected(g * 2, i, Random(1)) 242 | EndIf 243 | If (g <> 1) 244 | SetGadgetItemChecked(g * 2, i, Random(1)) 245 | EndIf 246 | Next i 247 | TextGadget(g*2 + 1, 2 + 200*g, GadgetHeight(0), 200-4, WindowHeight(0) - GadgetHeight(0), "") 248 | Next g 249 | 250 | Procedure Update() 251 | For g = 0 To 2 252 | Out.s = "CountSelectedGadgetItems = " + Str(CountSelectedGadgetItems(g*2)) 253 | Out.s + #LF$ + "CountCheckedGadgetItems = " + Str(CountCheckedGadgetItems(g*2)) 254 | Out.s + #LF$ + "SelectedGadgetItemData = " + Str(SelectedGadgetItemData(g*2)) 255 | Out.s + #LF$ + "GetGadgetItemSelected(" + Str(g*2) + ", 2) = " + Str(GetGadgetItemSelected(g*2, 2)) 256 | Out.s + #LF$ + "GetGadgetItemChecked(" + Str(g*2) + ", 2) = " + Str(GetGadgetItemChecked(g*2, 2)) 257 | SetGadgetText(g*2+1, Out) 258 | Next g 259 | EndProcedure 260 | ;Debug GadgetItemByItemData(0, 102) 261 | 262 | Update() 263 | SetActiveGadget(0) 264 | AddKeyboardShortcut(0, #PB_Shortcut_A | #PB_Shortcut_Command, 0) 265 | AddKeyboardShortcut(0, #PB_Shortcut_Escape, 1) 266 | 267 | Repeat 268 | Event = WaitWindowEvent() 269 | If (Event = #PB_Event_CloseWindow) 270 | Done = #True 271 | ElseIf (Event = #PB_Event_Gadget) 272 | Update() 273 | ElseIf (Event = #PB_Event_Menu) 274 | Select (EventMenu()) 275 | Case 0 276 | SelectAllGadgetItems(GetActiveGadget()) 277 | Update() 278 | Case 1 279 | Done = #True 280 | EndSelect 281 | EndIf 282 | Until (Done) 283 | 284 | CompilerEndIf 285 | CompilerEndIf 286 | ;- -------------------------------------------------------------------------------- /GetExifData.pbi: -------------------------------------------------------------------------------- 1 | ; +-------------+ 2 | ; | GetExifData | 3 | ; +-------------+ 4 | ; | 2019-11-22 : Creation 5 | ; | 2020-08-30 : Added LoadImageEXIFRotated() - requires RotateImage.pbi 6 | ; | 2020-08-31 : Added multiple Include guard 7 | ; | 2022-02-09 : Fix bug in reading Little Endian ("Intel") orientations 8 | 9 | ;- 10 | CompilerIf (Not Defined(_GetExifData_Included, #PB_Constant)) 11 | #_GetExifData_Included = #True 12 | 13 | CompilerIf (#PB_Compiler_IsMainFile) 14 | EnableExplicit 15 | CompilerEndIf 16 | 17 | CompilerIf (Not Defined(ReadU16BE, #PB_Procedure)) 18 | Procedure.u ReadU16BE(File.i) 19 | Protected Result.u 20 | ReadData(File, @Result + 1, 1) 21 | ReadData(File, @Result + 0, 1) 22 | ProcedureReturn (Result) 23 | EndProcedure 24 | CompilerEndIf 25 | 26 | CompilerIf (Not Defined(ReadU16Endian, #PB_Procedure)) 27 | Procedure.u ReadU16Endian(File.i, BE.i) 28 | If (BE) 29 | ProcedureReturn (ReadU16BE(File)) 30 | EndIf 31 | ProcedureReturn (ReadUnicodeCharacter(File)) 32 | EndProcedure 33 | CompilerEndIf 34 | 35 | CompilerIf (Not Defined(ReadS32BE, #PB_Procedure)) 36 | Procedure.l ReadS32BE(File.i) 37 | Protected Result.l 38 | ReadData(File, @Result + 3, 1) 39 | ReadData(File, @Result + 2, 1) 40 | ReadData(File, @Result + 1, 1) 41 | ReadData(File, @Result + 0, 1) 42 | ProcedureReturn (Result) 43 | EndProcedure 44 | CompilerEndIf 45 | 46 | CompilerIf (Not Defined(ReadS32Endian, #PB_Procedure)) 47 | Procedure.l ReadS32Endian(File.i, BE.i) 48 | If (BE) 49 | ProcedureReturn (ReadS32BE(File)) 50 | EndIf 51 | ProcedureReturn (ReadLong(File)) 52 | EndProcedure 53 | CompilerEndIf 54 | 55 | ;- 56 | ;- EXIF Procedures 57 | 58 | Procedure.i GetExifRotation(File.s) 59 | Protected Result.i = -1 60 | ; 0 = is rotated correctly 61 | ; 1 = needs CW rotation (is -90 deg) 62 | ; 2 = needs 180 rotation 63 | ; 3 = needs CCW rotation (is +90 deg) 64 | ; -1 = unknown 65 | 66 | Protected FN.i = ReadFile(#PB_Any, File) 67 | If (FN) 68 | If (ReadU16BE(FN) = $FFD8) ; SOI Marker 69 | While (Not Eof(FN)) 70 | Protected Marker.i = ReadU16BE(FN) 71 | Select (Marker) 72 | Case $FFE1 ; APP1 Marker 73 | Protected App1DataSize.i = ReadU16BE(FN) 74 | If ((ReadS32BE(FN) = $45786966) And (ReadU16BE(FN) = $0000)) ; EXIF Header 75 | ; $4d4d = 'MM' = "Motorola" = Big Endian 76 | ; $4949 = 'II' = "Intel" = Little Endian 77 | Protected BE.i = Bool(ReadU16BE(FN) = $4d4d) 78 | If (ReadU16Endian(FN, BE) = $002A) ; TIFF Header 79 | Protected IFD0Offset.i = ReadS32Endian(FN, BE) ; Offset to the first IFD 80 | FileSeek(FN, IFD0Offset-8, #PB_Relative) 81 | While (#True) 82 | Protected NumEntries.i = ReadU16Endian(FN, BE) 83 | Protected i.i 84 | For i = 0 To NumEntries-1 85 | Protected Tag.i = ReadU16Endian(FN, BE) 86 | Protected Format.i = ReadU16Endian(FN, BE) 87 | Protected Components.i = ReadS32Endian(FN, BE) 88 | If (Tag = $0112) 89 | Protected Dat.i = ReadU16Endian(FN, BE) 90 | ReadWord(FN) ; Skip 2 bytes 91 | Select (Dat) 92 | Case 1 : Result = 0 93 | Case 3 : Result = 2 94 | Case 6 : Result = 1 95 | Case 8 : Result = 3 96 | EndSelect 97 | Break 2 98 | Else 99 | ReadLong(FN) ; Skip 4 bytes 100 | EndIf 101 | Next i 102 | Protected NextOffset.i = ReadS32Endian(FN, BE) 103 | If (NextOffset = 0) 104 | Break 105 | EndIf 106 | ; jump to next IFD 107 | Break 108 | Wend 109 | EndIf 110 | EndIf 111 | Break 112 | Case $FFD9 113 | Break 114 | Default 115 | If (Marker & $FF00) = $FF00 116 | Break 117 | Else 118 | Break 119 | EndIf 120 | EndSelect 121 | Wend 122 | EndIf 123 | CloseFile(FN) 124 | EndIf 125 | ProcedureReturn (Result) 126 | EndProcedure 127 | 128 | Procedure.i LoadImageEXIFRotated(Image.i, File.s) 129 | CompilerIf (Defined(RotateImage, #PB_Procedure)) 130 | 131 | Protected Result.i = #Null 132 | Protected NeededRot.i = GetExifRotation(File) 133 | If (NeededRot > 0) 134 | If (Image = #PB_Any) 135 | Protected Temp.i = LoadImage(#PB_Any, File) 136 | If (Temp) 137 | Result = RotateImage(Temp, NeededRot, #PB_Any) 138 | FreeImage(Temp) 139 | EndIf 140 | Else 141 | Result = LoadImage(Image, File) 142 | If (Result) 143 | RotateImage(Image, NeededRot) 144 | EndIf 145 | EndIf 146 | Else 147 | Result = LoadImage(Image, File) 148 | EndIf 149 | ProcedureReturn (Result) 150 | 151 | CompilerElse 152 | CompilerIf (Defined(DebuggerError, #PB_Function)) 153 | DebuggerError(#PB_Compiler_Procedure + "() requires RotateImage.pbi to be included first") 154 | CompilerEndIf 155 | ProcedureReturn (#Null) 156 | CompilerEndIf 157 | EndProcedure 158 | 159 | ;- 160 | ;- 161 | ;- Demo Program 162 | 163 | CompilerIf (#PB_Compiler_IsMainFile) 164 | DisableExplicit 165 | 166 | File.s = OpenFileRequester("", "", "JPG|*.jpg;*.jpeg", 0) 167 | If (File) 168 | Debug File 169 | Select GetExifRotation(File) 170 | Case 1 171 | Debug "Need to turn CW" 172 | Case 2 173 | Debug "Need to turn 180" 174 | Case 3 175 | Debug "Need to turn CCW" 176 | Case 0 177 | Debug "0 deg (orientation unchanged)" 178 | Default 179 | Debug "Invalid EXIF or Orientation Unknown" 180 | EndSelect 181 | EndIf 182 | 183 | CompilerEndIf 184 | CompilerEndIf 185 | ;- 186 | -------------------------------------------------------------------------------- /ImproveGadgets.pbi: -------------------------------------------------------------------------------- 1 | ; +--------------------+ 2 | ; | ImproveGadgets.pbi | 3 | ; +--------------------+ 4 | ; | 2014.06.14 . Creation (PureBasic 5.22) 5 | ; | 2016.08.01 . Made Unicode safe, improved backspace deletion 6 | ; | .11 . Added ImproveWebGadget to prevent Script Error popups 7 | ; | 2017.02.01 . Cleanup, made multiple-include safe 8 | ; | 2019.01.02 . Added hooks to remove native hotkeys from Windows WebGadget 9 | ; | .03 . Merged in SetBrowserEmulation() 10 | ; | 2020-09-03 . Add Ctrl+S to the hotkeys you can hook 11 | ; | 2021-08-25 . Add Ctrl+A handling for Select All on Win XP StringGadgets 12 | 13 | 14 | ; Various simple improvements to PB gadgets (effects on Windows only) 15 | ; 16 | ; ImproveStringGadget(), ImproveComboBoxGadget() 17 | ; Enables Ctrl+Backspace for deleting words, delimited by spaces 18 | ; 19 | ; ImproveContainerGadget() 20 | ; For containers that are entirely covered by child gadgets! 21 | ; Disables ERASEBKGND and NCPAINT messages, which reduces resize flickering 22 | ; 23 | ; ImproveWebGadget() 24 | ; Disables "Script Error" popups 25 | ; Set 'Emulation' to a newer IE version 26 | ; Use keyboard hooks to disable Windows native dialogs (requires events) 27 | 28 | 29 | 30 | CompilerIf (Not Defined(__ImproveGadgets_Included, #PB_Constant)) 31 | #__ImproveGadgets_Included = #True 32 | 33 | CompilerIf (#PB_Compiler_IsMainFile) 34 | EnableExplicit 35 | CompilerEndIf 36 | 37 | 38 | 39 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 40 | 41 | ;- 42 | ;- Variables - Private 43 | 44 | Global *_WebGadgetHook = #Null 45 | 46 | Global _WebGadgetMenuWin.i = 0 47 | Global _WebGadgetMenuIDN.i = -1 48 | Global _WebGadgetMenuIDO.i = -1 49 | Global _WebGadgetMenuIDS.i = -1 50 | 51 | 52 | ;- 53 | ;- Structures - Private 54 | 55 | CompilerIf (Not Defined(COMBOBOXINFO, #PB_Structure)) 56 | 57 | Structure COMBOBOXINFO Align #PB_Structure_AlignC 58 | cbSize.l 59 | rcItem.RECT 60 | rcButton.RECT 61 | stateButton.l 62 | hwndCombo.i 63 | hwndItem.i 64 | hwndList.i 65 | EndStructure 66 | 67 | CompilerEndIf 68 | 69 | 70 | ;- 71 | ;- Procedures - Private 72 | 73 | Procedure.i __WebGadgetHookCB(nCode.i, wParam.i, lParam.i) 74 | Protected Ctrl.i = Bool(GetAsyncKeyState_(#VK_CONTROL) & $8000) 75 | If (Ctrl) 76 | Protected FirstHit.i = Bool(Not (lParam & $C0000000)) ; MSB = KEYUP, MSB-1 = REPEAT 77 | Select (nCode) 78 | Case (#HC_ACTION) 79 | Select (wParam) 80 | Case #VK_N 81 | If ((_WebGadgetMenuIDN >= 0) And (FirstHit)) 82 | PostEvent(#PB_Event_Menu, _WebGadgetMenuWin, _WebGadgetMenuIDN) 83 | EndIf 84 | ProcedureReturn (#True) ; block 85 | Case #VK_O 86 | If ((_WebGadgetMenuIDO >= 0) And (FirstHit)) 87 | PostEvent(#PB_Event_Menu, _WebGadgetMenuWin, _WebGadgetMenuIDO) 88 | EndIf 89 | ProcedureReturn (#True) ; block 90 | Case #VK_S 91 | If ((_WebGadgetMenuIDS >= 0) And (FirstHit)) 92 | PostEvent(#PB_Event_Menu, _WebGadgetMenuWin, _WebGadgetMenuIDS) 93 | EndIf 94 | ProcedureReturn (#True) ; block 95 | Case #VK_P, #VK_L 96 | ProcedureReturn (#True) ; block 97 | Default 98 | ; 99 | EndSelect 100 | EndSelect 101 | EndIf 102 | ProcedureReturn (CallNextHookEx_(0, nCode, wParam, lParam)) 103 | EndProcedure 104 | 105 | Procedure.i __ImproveStringGadgetCB(hWnd.i, uMsg.i, wParam.i, lParam.i) 106 | Protected StartPos.i, EndPos.i, *Buffer 107 | Protected Length.i, *Char.CHARACTER, Spaced.i 108 | 109 | If ((uMsg = #WM_CHAR) And (wParam = $7F)) 110 | SendMessage_(hWnd, #EM_GETSEL, @StartPos, @EndPos) 111 | If (EndPos > StartPos) 112 | SendMessage_(hWnd, #EM_REPLACESEL, #True, @"") 113 | ElseIf (StartPos > 0) 114 | Length = 2 * GetWindowTextLength_(hWnd) + 2 115 | *Buffer = AllocateMemory(Length) 116 | If (*Buffer) 117 | GetWindowText_(hWnd, *Buffer, Length) 118 | *Char = *Buffer + SizeOf(CHARACTER) * (StartPos - 1) 119 | While (*Char >= *Buffer) 120 | Select (*Char\c) 121 | Case ' ', #TAB, #CR, #LF, #NUL 122 | If (Spaced) 123 | Break 124 | EndIf 125 | Default 126 | Spaced = #True 127 | EndSelect 128 | *Char - SizeOf(CHARACTER) 129 | StartPos - 1 130 | Wend 131 | If (Not Spaced) 132 | StartPos = 0 133 | EndIf 134 | If (EndPos > StartPos) 135 | SendMessage_(hWnd, #EM_SETSEL, StartPos, EndPos) 136 | SendMessage_(hWnd, #EM_REPLACESEL, #True, @"") 137 | EndIf 138 | FreeMemory(*Buffer) 139 | EndIf 140 | EndIf 141 | ProcedureReturn (#True) 142 | ElseIf ((uMsg = #WM_KEYDOWN) And (wParam = 'A') And ((lParam & $40000000) = 0) And (GetAsyncKeyState_(#VK_CONTROL) & $8000)) 143 | ; Windows XP Ctrl+A fix (PB 5.73 x86) 144 | If ((OSVersion() = #PB_OS_Windows_XP) Or (#False)) 145 | PostMessage_(hWnd, #EM_SETSEL, 0, -1) 146 | Else 147 | ProcedureReturn (CallWindowProc_(GetWindowLongPtr_(hWnd, #GWL_USERDATA), hWnd, uMsg, wParam, lParam)) 148 | EndIf 149 | Else 150 | ProcedureReturn (CallWindowProc_(GetWindowLongPtr_(hWnd, #GWL_USERDATA), hWnd, uMsg, wParam, lParam)) 151 | EndIf 152 | EndProcedure 153 | 154 | Procedure.i __ImproveContainerGadgetCB(hWnd.i, uMsg.i, wParam.i, lParam.i) 155 | If ((uMsg = #WM_ERASEBKGND) Or (uMsg = #WM_NCPAINT)) 156 | ProcedureReturn (#Null) 157 | Else 158 | ProcedureReturn (CallWindowProc_(GetWindowLongPtr_(hWnd, #GWL_USERDATA), hWnd, uMsg, wParam, lParam)) 159 | EndIf 160 | EndProcedure 161 | 162 | ;- 163 | ;- Procedures - Public 164 | 165 | Procedure ImproveStringGadget(Gadget.i) 166 | If (GadgetType(Gadget) = #PB_GadgetType_String) 167 | SetWindowLongPtr_(GadgetID(Gadget), #GWL_USERDATA, GetWindowLongPtr_(GadgetID(Gadget), #GWL_WNDPROC)) 168 | SetWindowLongPtr_(GadgetID(Gadget), #GWL_WNDPROC, @__ImproveStringGadgetCB()) 169 | EndIf 170 | EndProcedure 171 | 172 | Procedure ImproveComboBoxGadget(Gadget.i) 173 | If (GadgetType(Gadget) = #PB_GadgetType_ComboBox) 174 | Protected CBI.COMBOBOXINFO 175 | CBI\cbSize = SizeOf(COMBOBOXINFO) 176 | If (GetComboBoxInfo_(GadgetID(Gadget), @CBI)) 177 | SetWindowLongPtr_(CBI\hwndItem, #GWL_USERDATA, GetWindowLongPtr_(CBI\hwndItem, #GWL_WNDPROC)) 178 | SetWindowLongPtr_(CBI\hwndItem, #GWL_WNDPROC, @__ImproveStringGadgetCB()) 179 | EndIf 180 | EndIf 181 | EndProcedure 182 | 183 | Procedure ImproveContainerGadget(Gadget.i) 184 | If (GadgetType(Gadget) = #PB_GadgetType_Container) 185 | SetWindowLongPtr_(GadgetID(Gadget), #GWL_USERDATA, GetWindowLongPtr_(GadgetID(Gadget), #GWL_WNDPROC)) 186 | SetWindowLongPtr_(GadgetID(Gadget), #GWL_WNDPROC, @__ImproveContainerGadgetCB()) 187 | EndIf 188 | EndProcedure 189 | 190 | Procedure ImproveWebGadget(Gadget.i) 191 | If (GadgetType(Gadget) = #PB_GadgetType_Web) 192 | Protected *IWB2.IWebBrowser2 = GetWindowLong_(GadgetID(Gadget), #GWL_USERDATA) 193 | If (*IWB2) 194 | *IWB2\put_Silent(#True) 195 | EndIf 196 | EndIf 197 | EndProcedure 198 | 199 | Procedure SetBrowserEmulation(IEVersion.i = 10) 200 | Protected lpIEVersion 201 | Select (IEVersion) 202 | Case (11) : lpIEVersion = 11001 203 | Case (10) : lpIEVersion = 10001 204 | Case ( 9) : lpIEVersion = 9999 205 | Case ( 8) : lpIEVersion = 8888 206 | Default 207 | If (IEVersion >= 7000) 208 | lpIEVersion = IEVersion 209 | Else 210 | lpIEVersion = 7000 211 | EndIf 212 | EndSelect 213 | 214 | Protected lpValueName.s = GetFilePart(ProgramFilename()) 215 | Protected phkResult.i 216 | Protected lpdwDisposition.l 217 | If (RegCreateKeyEx_(#HKEY_CURRENT_USER, 218 | "SOFTWARE\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION", 219 | 0, #Null, #REG_OPTION_VOLATILE, #KEY_ALL_ACCESS, #Null, @phkResult, @lpdwDisposition) = #ERROR_SUCCESS) 220 | RegSetValueEx_(phkResult, lpValueName, 0, #REG_DWORD, @lpIEVersion, SizeOf(LONG)) 221 | RegCloseKey_(phkResult) 222 | EndIf 223 | EndProcedure 224 | CompilerIf (#True) 225 | SetBrowserEmulation() 226 | CompilerEndIf 227 | 228 | 229 | 230 | ;- 231 | ;- Macros - Public 232 | 233 | Macro HookWebGadgets(State) 234 | If ((State) And (Not *_WebGadgetHook)) 235 | *_WebGadgetHook = SetWindowsHookEx_(#WH_KEYBOARD, @__WebGadgetHookCB(), 0, GetCurrentThreadId_()) 236 | ElseIf ((Not State) And (*_WebGadgetHook)) 237 | UnhookWindowsHookEx_(*_WebGadgetHook) 238 | *_WebGadgetHook = #Null 239 | EndIf 240 | EndMacro 241 | 242 | Macro SetWebGadgetHooks(Window = 0, CtrlN = -1, CtrlO = -1, CtrlS = -1) 243 | _WebGadgetMenuWin = (Window) 244 | _WebGadgetMenuIDN = (CtrlN) 245 | _WebGadgetMenuIDO = (CtrlO) 246 | _WebGadgetMenuIDS = (CtrlS) 247 | EndMacro 248 | 249 | 250 | 251 | 252 | 253 | CompilerElse 254 | 255 | ;- 256 | ;- Macros - Public 257 | 258 | Macro ImproveStringGadget(Gadget) 259 | ; 260 | EndMacro 261 | 262 | Macro ImproveComboBoxGadget(Gadget) 263 | ; 264 | EndMacro 265 | 266 | Macro ImproveContainerGadget(Gadget) 267 | ; 268 | EndMacro 269 | 270 | Macro ImproveWebGadget(Gadget) 271 | ; 272 | EndMacro 273 | 274 | Macro HookWebGadgets(State) 275 | ; 276 | EndMacro 277 | 278 | Macro SetWebGadgetHooks(Window = 0, CtrlN = -1, CtrlO = -1) 279 | ; 280 | EndMacro 281 | 282 | 283 | 284 | CompilerEndIf 285 | 286 | 287 | 288 | ;- 289 | ;- Demo Program 290 | 291 | CompilerIf (#PB_Compiler_IsMainFile) 292 | 293 | OpenWindow(0, 0, 0, 240, 40, "ImproveStringGadget()", #PB_Window_ScreenCentered|#PB_Window_SystemMenu) 294 | StringGadget(0, 10, 10, 220, 20, "This is a test") 295 | CompilerIf (Defined(PB_Gadget_RequiredSize, #PB_Constant)) 296 | ResizeWindow(0, #PB_Ignore, #PB_Ignore, 2*10 + GadgetWidth(0), 2*10 + GadgetHeight(0, #PB_Gadget_RequiredSize)) 297 | CompilerEndIf 298 | ImproveStringGadget(0) 299 | SetActiveGadget(0) 300 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 301 | SendMessage_(GadgetID(0), #EM_SETSEL, Len(GetGadgetText(0)), Len(GetGadgetText(0))) 302 | CompilerEndIf 303 | Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow 304 | 305 | CompilerEndIf 306 | 307 | CompilerEndIf 308 | ;- 309 | 310 | -------------------------------------------------------------------------------- /IntStack.pbi: -------------------------------------------------------------------------------- 1 | ; +----------+ 2 | ; | IntStack | 3 | ; +----------+ 4 | ; | 2017.02.23 . Creation (PureBasic 5.51) 5 | ; | .05.05 . Added return value to PushStack() for convenience 6 | 7 | ;- 8 | CompilerIf (Not Defined(__IntStack_Included, #PB_Constant)) 9 | #__IntStack_Included = #True 10 | 11 | CompilerIf (#PB_Compiler_IsMainFile) 12 | EnableExplicit 13 | CompilerEndIf 14 | 15 | 16 | 17 | ;- Macros 18 | 19 | Macro NewStack 20 | NewList 21 | EndMacro 22 | 23 | Macro Stack 24 | List 25 | EndMacro 26 | 27 | Macro StackSize(_Stack) 28 | ListSize(_Stack) 29 | EndMacro 30 | 31 | Macro StackEmpty(_Stack) 32 | Bool(StackSize(_Stack) = 0) 33 | EndMacro 34 | 35 | Macro FreeStack(_Stack) 36 | FreeList(_Stack) 37 | EndMacro 38 | 39 | Macro ClearStack(_Stack) 40 | ClearList(_Stack) 41 | EndMacro 42 | 43 | ;- 44 | ;- Procedures 45 | 46 | Procedure.i PushStack(Stack _Stack(), Value.i) 47 | ;FirstElement(_Stack()) 48 | InsertElement(_Stack()) 49 | _Stack() = Value 50 | ProcedureReturn (Value) 51 | EndProcedure 52 | 53 | Procedure.i PopStack(Stack _Stack()) 54 | ;FirstElement(_Stack()) 55 | Protected Result.i = _Stack() 56 | DeleteElement(_Stack(), 1) 57 | ProcedureReturn (Result) 58 | EndProcedure 59 | 60 | Procedure.i PeekStack(Stack _Stack()) 61 | ;FirstElement(_Stack()) 62 | ProcedureReturn (_Stack()) 63 | EndProcedure 64 | 65 | 66 | 67 | 68 | ;- 69 | ;- Demo 70 | 71 | CompilerIf (#PB_Compiler_IsMainFile) 72 | DisableExplicit 73 | 74 | NewStack MyStack() ; can also use NewList so that IDE Auto-completion works 75 | 76 | Debug "Push: " + Str(PushStack(MyStack(), 1)) 77 | Debug "Push: " + Str(PushStack(MyStack(), 42)) 78 | Debug "Push: " + Str(PushStack(MyStack(), 585)) 79 | Debug "" 80 | 81 | Debug "Size = " + Str(StackSize(MyStack())) 82 | Debug "Peek: " + Str(PeekStack(MyStack())) 83 | Debug "" 84 | 85 | Debug "Pop: " + Str(PopStack(MyStack())) 86 | Debug "Pop: " + Str(PopStack(MyStack())) 87 | Debug "Pop: " + Str(PopStack(MyStack())) 88 | Debug "" 89 | 90 | Debug "Size = " + Str(StackSize(MyStack())) 91 | ;ClearStack(MyStack()) 92 | FreeStack(MyStack()) 93 | 94 | CompilerEndIf 95 | CompilerEndIf 96 | ;- -------------------------------------------------------------------------------- /OS_Names.pbi: -------------------------------------------------------------------------------- 1 | ; +----------+ 2 | ; | OS_Names | 3 | ; +----------+ 4 | ; | 2014.12.02 . Creation (PureBasic 5.31) 5 | ; | .05 . Added future support for Win 10, OS X 10.9 and 10.10 6 | ; | 2015.07.16 . Added (incomplete) list of OS X nickname constants 7 | ; | .28 . Added OS X 10.11 (El Capitan) 8 | ; | 2017.05.18 . Multiple-include safe 9 | ; | 2018.02.22 . Placeholders for OS X 10.12, 10.13 10 | ; | 2021-09-21 . Placeholders for macOS 10.14, 10.15 11 | ; | 2024-09-19 . Update to PB 6.12 (Windows 11, macOS 15) 12 | 13 | ;- 14 | CompilerIf (Not Defined(__OS_Names_Included, #PB_Constant)) 15 | #__OS_Names_Included = #True 16 | 17 | 18 | ;- Constants (Public) 19 | 20 | ; MacOSX version aliases 21 | ;#PB_OS_MacOSX_Cheetah = #PB_OS_MacOSX_10_0 22 | ;#PB_OS_MacOSX_Puma = #PB_OS_MacOSX_10_1 23 | ;#PB_OS_MacOSX_Jaguar = #PB_OS_MacOSX_10_2 24 | ;#PB_OS_MacOSX_Panther = #PB_OS_MacOSX_10_3 25 | ;#PB_OS_MacOSX_Tiger = #PB_OS_MacOSX_10_4 26 | ;#PB_OS_MacOSX_Leopard = #PB_OS_MacOSX_10_5 27 | ;#PB_OS_MacOSX_SnowLeopard = #PB_OS_MacOSX_10_6 28 | ;#PB_OS_MacOSX_Lion = #PB_OS_MacOSX_10_7 29 | ;#PB_OS_MacOSX_MountainLion = #PB_OS_MacOSX_10_8 30 | ;CompilerIf (Defined(PB_OS_MacOSX_10_9, #PB_Constant)) 31 | ; #PB_OS_MacOSX_Mavericks = #PB_OS_MacOSX_10_9 32 | ;CompilerEndIf 33 | CompilerIf (Defined(PB_OS_MacOSX_10_10, #PB_Constant)) 34 | #PB_OS_MacOSX_Yosemite = #PB_OS_MacOSX_10_10 35 | CompilerEndIf 36 | CompilerIf (Defined(PB_OS_MacOSX_10_11, #PB_Constant)) 37 | #PB_OS_MacOSX_ElCapitan = #PB_OS_MacOSX_10_11 38 | CompilerEndIf 39 | CompilerIf (Defined(PB_OS_MacOSX_10_12, #PB_Constant)) 40 | #PB_OS_MacOSX_Sierra = #PB_OS_MacOSX_10_12 41 | CompilerEndIf 42 | CompilerIf (Defined(PB_OS_MacOSX_10_13, #PB_Constant)) 43 | #PB_OS_MacOSX_HighSierra = #PB_OS_MacOSX_10_13 44 | CompilerEndIf 45 | CompilerIf (Defined(PB_OS_MacOSX_10_14, #PB_Constant)) 46 | #PB_OS_MacOSX_Mojave = #PB_OS_MacOSX_10_14 47 | CompilerEndIf 48 | CompilerIf (Defined(PB_OS_MacOSX_10_15, #PB_Constant)) 49 | #PB_OS_MacOSX_Catalina = #PB_OS_MacOSX_10_15 50 | CompilerEndIf 51 | CompilerIf (Defined(PB_OS_MacOSX_11, #PB_Constant)) 52 | #PB_OS_MacOSX_BigSur = #PB_OS_MacOSX_11 53 | CompilerEndIf 54 | CompilerIf (Defined(PB_OS_MacOSX_12, #PB_Constant)) 55 | #PB_OS_MacOSX_Monterey = #PB_OS_MacOSX_12 56 | CompilerEndIf 57 | CompilerIf (Defined(PB_OS_MacOSX_13, #PB_Constant)) 58 | #PB_OS_MacOSX_Ventura = #PB_OS_MacOSX_13 59 | CompilerEndIf 60 | CompilerIf (Defined(PB_OS_MacOSX_14, #PB_Constant)) 61 | #PB_OS_MacOSX_Sonoma = #PB_OS_MacOSX_14 62 | CompilerEndIf 63 | CompilerIf (Defined(PB_OS_MacOSX_15, #PB_Constant)) 64 | #PB_OS_MacOSX_Sequoia = #PB_OS_MacOSX_15 65 | CompilerEndIf 66 | 67 | 68 | 69 | 70 | ;- 71 | ;- Structures (Private) 72 | 73 | Structure _OS_Pair 74 | Value.i 75 | Name.s 76 | EndStructure 77 | 78 | 79 | 80 | ;- 81 | ;- Procedures (Public) 82 | 83 | Procedure.s OSName() 84 | CompilerSelect (#PB_Compiler_OS) 85 | CompilerCase (#PB_OS_Windows) 86 | ProcedureReturn "Windows" 87 | CompilerCase (#PB_OS_Linux) 88 | ProcedureReturn "Linux" 89 | CompilerCase (#PB_OS_MacOS) 90 | ProcedureReturn "Mac OS X" 91 | CompilerCase (#PB_OS_AmigaOS) 92 | ProcedureReturn "Amiga" 93 | CompilerDefault 94 | CompilerError "Target OS not recognized" 95 | CompilerEndSelect 96 | EndProcedure 97 | 98 | Procedure.s OSVersionName() 99 | Protected *Pair._OS_Pair = ?_OS_VersionNames 100 | While (*Pair\Value) 101 | If (*Pair\Value = OSVersion()) 102 | ProcedureReturn *Pair\Name 103 | EndIf 104 | *Pair + SizeOf(_OS_Pair) 105 | Wend 106 | ProcedureReturn OSName() 107 | EndProcedure 108 | 109 | 110 | 111 | 112 | ;- 113 | ;- Data Section (OS Version Names) 114 | 115 | DataSection 116 | 117 | _OS_VersionNames: 118 | 119 | ;- - Windows 120 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 121 | Data.i #PB_OS_Windows_NT3_51 122 | Data.i @"Windows NT 3.51" 123 | Data.i #PB_OS_Windows_95 124 | Data.i @"Windows 95" 125 | Data.i #PB_OS_Windows_NT_4 126 | Data.i @"Windows NT 4.0" 127 | Data.i #PB_OS_Windows_98 128 | Data.i @"Windows 98" 129 | Data.i #PB_OS_Windows_ME 130 | Data.i @"Windows ME" 131 | Data.i #PB_OS_Windows_2000 132 | Data.i @"Windows 2000" 133 | Data.i #PB_OS_Windows_XP 134 | Data.i @"Windows XP" 135 | Data.i #PB_OS_Windows_Server_2003 136 | Data.i @"Windows Server 2003" 137 | Data.i #PB_OS_Windows_Vista 138 | Data.i @"Windows Vista" 139 | Data.i #PB_OS_Windows_Server_2008 140 | Data.i @"Windows Server 2008" 141 | Data.i #PB_OS_Windows_7 142 | Data.i @"Windows 7" 143 | Data.i #PB_OS_Windows_Server_2008_R2 144 | Data.i @"Windows Server 2008 R2" 145 | Data.i #PB_OS_Windows_8 146 | Data.i @"Windows 8" 147 | Data.i #PB_OS_Windows_Server_2012 148 | Data.i @"Windows Server 2012" 149 | CompilerIf (Defined(PB_OS_Windows_10, #PB_Constant)) 150 | Data.i #PB_OS_Windows_10 151 | Data.i @"Windows 10" 152 | CompilerEndIf 153 | CompilerIf (Defined(PB_OS_Windows_11, #PB_Constant)) 154 | Data.i #PB_OS_Windows_11 155 | Data.i @"Windows 11" 156 | CompilerEndIf 157 | OSVersion() 158 | CompilerEndIf 159 | 160 | ;- - Mac 161 | CompilerIf (#PB_Compiler_OS = #PB_OS_MacOS) 162 | Data.i #PB_OS_MacOSX_10_0 163 | Data.i @"Mac OS X 10.0" 164 | Data.i #PB_OS_MacOSX_10_1 165 | Data.i @"Mac OS X 10.1" 166 | Data.i #PB_OS_MacOSX_10_2 167 | Data.i @"Mac OS X 10.2" 168 | Data.i #PB_OS_MacOSX_10_3 169 | Data.i @"Mac OS X 10.3" 170 | Data.i #PB_OS_MacOSX_10_4 171 | Data.i @"Mac OS X 10.4" 172 | Data.i #PB_OS_MacOSX_10_5 173 | Data.i @"Mac OS X 10.5" 174 | Data.i #PB_OS_MacOSX_10_6 175 | Data.i @"Mac OS X 10.6" 176 | Data.i #PB_OS_MacOSX_10_7 177 | Data.i @"OS X 10.7" 178 | Data.i #PB_OS_MacOSX_10_8 179 | Data.i @"OS X 10.8" 180 | CompilerIf (Defined(PB_OS_MacOSX_10_9, #PB_Constant)) 181 | Data.i #PB_OS_MacOSX_10_9 182 | Data.i @"OS X 10.9" 183 | CompilerEndIf 184 | CompilerIf (Defined(PB_OS_MacOSX_10_10, #PB_Constant)) 185 | Data.i #PB_OS_MacOSX_10_10 186 | Data.i @"OS X 10.10" 187 | CompilerEndIf 188 | CompilerIf (Defined(PB_OS_MacOSX_10_11, #PB_Constant)) 189 | Data.i #PB_OS_MacOSX_10_11 190 | Data.i @"OS X 10.11" 191 | CompilerEndIf 192 | CompilerIf (Defined(PB_OS_MacOSX_10_12, #PB_Constant)) 193 | Data.i #PB_OS_MacOSX_10_12 194 | Data.i @"macOS 10.12" 195 | CompilerEndIf 196 | CompilerIf (Defined(PB_OS_MacOSX_10_13, #PB_Constant)) 197 | Data.i #PB_OS_MacOSX_10_13 198 | Data.i @"macOS 10.13" 199 | CompilerEndIf 200 | CompilerIf (Defined(PB_OS_MacOSX_10_14, #PB_Constant)) 201 | Data.i #PB_OS_MacOSX_10_14 202 | Data.i @"macOS 10.14" 203 | CompilerEndIf 204 | CompilerIf (Defined(PB_OS_MacOSX_10_15, #PB_Constant)) 205 | Data.i #PB_OS_MacOSX_10_15 206 | Data.i @"macOS 10.15" 207 | CompilerEndIf 208 | CompilerIf (Defined(PB_OS_MacOSX_11, #PB_Constant)) 209 | Data.i #PB_OS_MacOSX_11 210 | Data.i @"macOS 11" 211 | CompilerEndIf 212 | CompilerIf (Defined(PB_OS_MacOSX_12, #PB_Constant)) 213 | Data.i #PB_OS_MacOSX_12 214 | Data.i @"macOS 12" 215 | CompilerEndIf 216 | CompilerIf (Defined(PB_OS_MacOSX_13, #PB_Constant)) 217 | Data.i #PB_OS_MacOSX_13 218 | Data.i @"macOS 13" 219 | CompilerEndIf 220 | CompilerIf (Defined(PB_OS_MacOSX_14, #PB_Constant)) 221 | Data.i #PB_OS_MacOSX_14 222 | Data.i @"macOS 14" 223 | CompilerEndIf 224 | CompilerIf (Defined(PB_OS_MacOSX_15, #PB_Constant)) 225 | Data.i #PB_OS_MacOSX_15 226 | Data.i @"macOS 15" 227 | CompilerEndIf 228 | CompilerEndIf 229 | 230 | ;- - Linux 231 | CompilerIf (#PB_Compiler_OS = #PB_OS_Linux) 232 | Data.i #PB_OS_Linux_2_2 233 | Data.i @"Linux 2.2" 234 | Data.i #PB_OS_Linux_2_4 235 | Data.i @"Linux 2.4" 236 | Data.i #PB_OS_Linux_2_6 237 | Data.i @"Linux 2.6" 238 | CompilerEndIf 239 | 240 | Data.i #Null, #Null 241 | 242 | EndDataSection 243 | 244 | 245 | 246 | 247 | ;- 248 | ;- Demo Program 249 | 250 | CompilerIf (#PB_Compiler_IsMainFile) 251 | Debug "OSName() = " + OSName() 252 | Debug "OSVersionName() = " + OSVersionName() 253 | CompilerEndIf 254 | 255 | CompilerEndIf 256 | ;- 257 | 258 | -------------------------------------------------------------------------------- /PBP_Projects.pbi: -------------------------------------------------------------------------------- 1 | ; +--------------+ 2 | ; | PBP_Projects | 3 | ; +--------------+ 4 | ; | 2015.01.23 . Creation (PureBasic 5.31) 5 | ; | 2016.10.26 . Added "dll", "so", "dylib" recognition 6 | ; | 2017.05.08 . Multiple-include safe, added demo, path separator fixing, 7 | ; | added OS guessing based on icon file 8 | ; | 2019.05.24 . Added support for DPIAWARE compile flag (PB 5.70) 9 | 10 | ;- 11 | CompilerIf (Not Defined(__PBP_Projects_Included, #PB_Constant)) 12 | #__PBP_Projects_Included = #True 13 | 14 | CompilerIf (#PB_Compiler_IsMainFile) 15 | EnableExplicit 16 | CompilerEndIf 17 | 18 | 19 | 20 | 21 | 22 | ;- Procedures - PRIVATE 23 | 24 | Procedure.i _PBP_IsValidProject(*Project) 25 | Protected Result.i = #False 26 | If (*Project And IsXML(*Project)) 27 | Protected *Node = MainXMLNode(*Project) 28 | If (*Node) 29 | If (GetXMLNodeName(*Node) = "project") 30 | Result = #True 31 | EndIf 32 | EndIf 33 | EndIf 34 | ProcedureReturn (Result) 35 | EndProcedure 36 | 37 | Procedure.i _PBP_IsValidTarget(*Target) 38 | Protected Result.i = #False 39 | If (*Target) 40 | If (XMLNodeType(*Target) = #PB_XML_Normal) 41 | If (GetXMLNodeName(*Target) = "target") 42 | Result = #True 43 | EndIf 44 | EndIf 45 | EndIf 46 | ProcedureReturn (Result) 47 | EndProcedure 48 | 49 | Procedure.i _PBP_GetTargetsNode(*Project) 50 | Protected *Result = #Null 51 | If (_PBP_IsValidProject(*Project)) 52 | *Result = ChildXMLNode(MainXMLNode(*Project)) 53 | While (*Result) 54 | If (XMLNodeType(*Result) = #PB_XML_Normal) 55 | If (GetXMLNodeName(*Result) = "section") 56 | If (GetXMLAttribute(*Result, "name") = "targets") 57 | Break 58 | EndIf 59 | EndIf 60 | EndIf 61 | *Result = NextXMLNode(*Result) 62 | Wend 63 | EndIf 64 | ProcedureReturn (*Result) 65 | EndProcedure 66 | 67 | Procedure.s _PBP_GetTargetValue(*Target, Name.s, Attribute.s = "value") 68 | Protected Result.s = "" 69 | If (Name) 70 | If (_PBP_IsValidTarget(*Target)) 71 | Protected *Node = XMLNodeFromPath(*Target, Name) 72 | If (*Node) 73 | Result = GetXMLAttribute(*Node, Attribute) 74 | EndIf 75 | EndIf 76 | EndIf 77 | ProcedureReturn (Result) 78 | EndProcedure 79 | 80 | Procedure.i _PBP_GetTargetOption(*Target, Name.s) 81 | Protected Result.i = #False 82 | If (Name) 83 | If (_PBP_IsValidTarget(*Target)) 84 | Protected *Node = XMLNodeFromPath(*Target, "options") 85 | If (*Node) 86 | Result = Bool(GetXMLAttribute(*Node, Name) = "1") 87 | EndIf 88 | EndIf 89 | EndIf 90 | ProcedureReturn (Result) 91 | EndProcedure 92 | 93 | Procedure.s _PBP_QuoteIfNeeded(Input.s) 94 | If ((Input = "") Or (FindString(Input, " "))) 95 | Input = #DQUOTE$ + Input + #DQUOTE$ 96 | EndIf 97 | ProcedureReturn (Input) 98 | EndProcedure 99 | 100 | 101 | 102 | 103 | 104 | ;- 105 | ;- Procedures - PUBLIC 106 | 107 | Procedure.i PBP_LoadProject(File.s) 108 | Protected XML.i = LoadXML(#PB_Any, File) 109 | If (XML) 110 | If (Not _PBP_IsValidProject(XML)) 111 | FreeXML(XML) 112 | XML = #Null 113 | EndIf 114 | EndIf 115 | ProcedureReturn (XML) 116 | EndProcedure 117 | 118 | Procedure.i PBP_FreeProject(*Project) 119 | If (*Project And IsXML(*Project)) 120 | FreeXML(*Project) 121 | EndIf 122 | ProcedureReturn (#Null) 123 | EndProcedure 124 | 125 | Procedure.i PBP_CountTargets(*Project) 126 | Protected Result.i = -1 127 | Protected *Targets = _PBP_GetTargetsNode(*Project) 128 | If (*Targets) 129 | Result = 0 130 | Protected *Child = ChildXMLNode(*Targets) 131 | While (*Child) 132 | If (XMLNodeType(*Child) = #PB_XML_Normal) 133 | If (GetXMLNodeName(*Child) = "target") 134 | Result + 1 135 | EndIf 136 | EndIf 137 | *Child = NextXMLNode(*Child) 138 | Wend 139 | EndIf 140 | ProcedureReturn (Result) 141 | EndProcedure 142 | 143 | Procedure.i PBP_GetTarget(*Project, Index.i) 144 | Protected *Result = #Null 145 | If (Index >= 0) 146 | Protected *Targets = _PBP_GetTargetsNode(*Project) 147 | If (*Targets) 148 | Protected Found.i = 0 149 | Protected *Child = ChildXMLNode(*Targets) 150 | While (*Child) 151 | If (XMLNodeType(*Child) = #PB_XML_Normal) 152 | If (GetXMLNodeName(*Child) = "target") 153 | If (Found = Index) 154 | *Result = *Child 155 | Break 156 | Else 157 | Found + 1 158 | EndIf 159 | EndIf 160 | EndIf 161 | *Child = NextXMLNode(*Child) 162 | Wend 163 | EndIf 164 | EndIf 165 | ProcedureReturn (*Result) 166 | EndProcedure 167 | 168 | Procedure.s PBP_TargetName(*Target) 169 | Protected Result.s = "" 170 | If (_PBP_IsValidTarget(*Target)) 171 | Result = GetXMLAttribute(*Target, "name") 172 | EndIf 173 | ProcedureReturn (Result) 174 | EndProcedure 175 | 176 | Procedure.i PBP_TargetByName(*Project, Name.s) 177 | Protected *Result = #Null 178 | If (Name) 179 | Protected n.i = PBP_CountTargets(*Project) 180 | If (n > 0) 181 | Protected i.i 182 | For i = 0 To n -1 183 | Protected *Target = PBP_GetTarget(*Project, i) 184 | If (PBP_TargetName(*Target) = Name) 185 | *Result = *Target 186 | Break 187 | EndIf 188 | Next i 189 | EndIf 190 | EndIf 191 | ProcedureReturn (*Result) 192 | EndProcedure 193 | 194 | Procedure.s PBP_TargetInputFile(*Target) 195 | ProcedureReturn (_PBP_GetTargetValue(*Target, "inputfile")) 196 | EndProcedure 197 | 198 | Procedure.s PBP_TargetOutputFile(*Target) 199 | ProcedureReturn (_PBP_GetTargetValue(*Target, "outputfile")) 200 | EndProcedure 201 | 202 | Procedure.i PBP_TargetCurrentOS(*Target) 203 | Protected Result.i = #False 204 | Protected OutputFile.s = PBP_TargetOutputFile(*Target) 205 | If (OutputFile) 206 | Select (LCase(GetExtensionPart(OutputFile))) 207 | Case "exe", "dll" 208 | Result = Bool(#PB_Compiler_OS = #PB_OS_Windows) 209 | Case "app", "dylib" 210 | Result = Bool(#PB_Compiler_OS = #PB_OS_MacOS) 211 | Case "so" 212 | Result = Bool(#PB_Compiler_OS = #PB_OS_Linux) 213 | Default 214 | Protected IconFile.s 215 | Protected *IconNode = XMLNodeFromPath(*Target, "icon") 216 | If (*IconNode) 217 | IconFile = GetXMLNodeText(*IconNode) 218 | EndIf 219 | If (IconFile) 220 | Select (LCase(GetExtensionPart(IconFile))) 221 | Case "ico" 222 | Result = Bool(#PB_Compiler_OS = #PB_OS_Windows) 223 | Case "icns" 224 | Result = Bool(#PB_Compiler_OS = #PB_OS_MacOS) 225 | Default 226 | Result = #True 227 | EndSelect 228 | Else 229 | Result = #True 230 | EndIf 231 | EndSelect 232 | EndIf 233 | ProcedureReturn (Result) 234 | EndProcedure 235 | 236 | Procedure.s PBP_TargetBuildString(*Target, ProjectPath.s = "") 237 | Protected Result.s = "" 238 | If (_PBP_IsValidTarget(*Target)) 239 | Protected *Node 240 | Protected Value.s 241 | 242 | If (ProjectPath And (FileSize(ProjectPath) > 0)) 243 | ProjectPath = GetPathPart(ProjectPath) 244 | EndIf 245 | 246 | Value = _PBP_GetTargetValue(*Target, "inputfile") 247 | If (Value) 248 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 249 | ReplaceString(Value, "/", "\", #PB_String_InPlace) 250 | CompilerEndIf 251 | Result = _PBP_QuoteIfNeeded(ProjectPath + Value) 252 | ; 253 | Value = _PBP_GetTargetValue(*Target, "outputfile") 254 | If (Value) 255 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 256 | ReplaceString(Value, "/", "\", #PB_String_InPlace) 257 | CompilerEndIf 258 | Result + " /EXE " + _PBP_QuoteIfNeeded(ProjectPath + Value) 259 | EndIf 260 | ; 261 | *Node = XMLNodeFromPath(*Target, "icon") 262 | If (*Node) 263 | Value = GetXMLNodeText(*Node) 264 | If (Value) 265 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 266 | ReplaceString(Value, "/", "\", #PB_String_InPlace) 267 | CompilerEndIf 268 | If (GetXMLAttribute(*Node, "enable") = "1") 269 | Result + " /ICON " + _PBP_QuoteIfNeeded(ProjectPath + Value) 270 | EndIf 271 | EndIf 272 | EndIf 273 | ; 274 | If (_PBP_GetTargetOption(*Target, "unicode")) 275 | Result + " /UNICODE" 276 | EndIf 277 | If (_PBP_GetTargetOption(*Target, "thread")) 278 | Result + " /THREAD" 279 | EndIf 280 | If (_PBP_GetTargetOption(*Target, "onerror")) 281 | Result + " /LINENUMBERING" 282 | EndIf 283 | If (_PBP_GetTargetOption(*Target, "xpskin")) 284 | Result + " /XP" 285 | EndIf 286 | If (_PBP_GetTargetOption(*Target, "dpiaware")) 287 | Result + " /DPIAWARE" 288 | EndIf 289 | If (_PBP_GetTargetOption(*Target, "admin")) 290 | Result + " /ADMINISTRATOR" 291 | ElseIf (_PBP_GetTargetOption(*Target, "user")) 292 | Result + " /USER" 293 | EndIf 294 | ; 295 | Value = _PBP_GetTargetValue(*Target, "subsystem") 296 | If (Value) 297 | Result + " /SUBSYSTEM " + _PBP_QuoteIfNeeded(Value) 298 | EndIf 299 | ; 300 | Select (_PBP_GetTargetValue(*Target, "format", "exe")) 301 | Case "console" 302 | Result + " /CONSOLE" 303 | Case "dll" 304 | Result + " /DLL" 305 | Default 306 | ; 307 | EndSelect 308 | ; 309 | *Node = XMLNodeFromPath(*Target, "constants") 310 | If (*Node) 311 | *Node = ChildXMLNode(*Node) 312 | While (*Node) 313 | If (XMLNodeType(*Node) = #PB_XML_Normal) 314 | If (GetXMLNodeName(*Node) = "constant") 315 | If (GetXMLAttribute(*Node, "enable") = "1") 316 | Value = GetXMLAttribute(*Node, "value") 317 | Value = RemoveString(Value, " ") 318 | Value = RemoveString(Value, "#") 319 | Result + " /CONSTANT " + Value 320 | EndIf 321 | EndIf 322 | EndIf 323 | *Node = NextXMLNode(*Node) 324 | Wend 325 | EndIf 326 | ; 327 | If (#True) 328 | Result + " /QUIET" 329 | EndIf 330 | EndIf 331 | EndIf 332 | ProcedureReturn (Result) 333 | EndProcedure 334 | 335 | ;- 336 | ;- Demo Program 337 | 338 | CompilerIf (#PB_Compiler_IsMainFile) 339 | DisableExplicit 340 | 341 | ProjectFile.s = OpenFileRequester("Open PB Project", GetHomeDirectory(), "PureBasic Projects (*.pbp)|*.pbp", 0) 342 | If (ProjectFile) 343 | *Project = PBP_LoadProject(ProjectFile) 344 | If (*Project) 345 | NumTargets = PBP_CountTargets(*Project) 346 | Debug ProjectFile 347 | Debug "Targets: " + Str(NumTargets) 348 | 349 | For i = 0 To NumTargets - 1 350 | *Target = PBP_GetTarget(*Project, i) 351 | Debug "" 352 | Debug "[" + PBP_TargetName(*Target) + "]" 353 | Debug "Targets this OS? Guess = " + Str(PBP_TargetCurrentOS(*Target)) 354 | Debug "Input = " + PBP_TargetInputFile(*Target) 355 | Debug "Output = " + PBP_TargetOutputFile(*Target) 356 | Debug "Compile params = " + PBP_TargetBuildString(*Target, ProjectFile) 357 | Next i 358 | 359 | PBP_FreeProject(*Project) 360 | Else 361 | Debug "Could not load project:" 362 | Debug ProjectFile 363 | EndIf 364 | EndIf 365 | 366 | CompilerEndIf 367 | CompilerEndIf 368 | ;- -------------------------------------------------------------------------------- /Podcast.pbi: -------------------------------------------------------------------------------- 1 | ; +---------+ 2 | ; | Podcast | 3 | ; +---------+ 4 | ; | 2017-08-17 . Creation 5 | ; | 2017-09-26 . Items are now populated 6 | ; | 2017-10-13 . Real buildDate/pubDate attributes 7 | ; | 2018-01-07 . Fixed last of escaping in 'itunes:subtitle', 255 char limit 8 | ; | 2018-04-30 . Added per-episode 'itunes:image' attribute 9 | ; | 2018-06-15 . Added Reverse episode order option 10 | ; | 2018-06-25 . Added per-episode 'Link' attribute 11 | ; | 2018-07-14 . Cleaned up demo 12 | ; | 2020-02-23 . Escape single and double quote characters 13 | ; | 2020-04-04 . Added Bytes property to items 14 | ; | 2020-08-23 . Added SortPodcastByDates() 15 | 16 | ; TODO 17 | ; 18 | 19 | CompilerIf (Not Defined(__Podcast_Included, #PB_Constant)) 20 | #__Podcast_Included = #True 21 | 22 | CompilerIf (#PB_Compiler_IsMainFile) 23 | EnableExplicit 24 | CompilerEndIf 25 | 26 | 27 | 28 | ;- 29 | ;- Structures 30 | 31 | Structure PODCASTITEM 32 | GUID.s 33 | Link.s 34 | Title.s 35 | UTCDate.i 36 | Desc.s 37 | Seconds.i 38 | Bytes.i 39 | Image.s 40 | EndStructure 41 | 42 | Structure PODCAST 43 | Title.s 44 | Description.s 45 | Website.s 46 | Copyright.s 47 | FeedURL.s 48 | Email.s 49 | Author.s 50 | Image.s 51 | List Item.PODCASTITEM() 52 | Reverse.i 53 | EndStructure 54 | 55 | ;- 56 | ;- Imports 57 | 58 | CompilerIf (Not Defined(time, #PB_Procedure)) 59 | ImportC "" 60 | time(*seconds.Integer = #Null) 61 | EndImport 62 | CompilerEndIf 63 | 64 | ;- 65 | ;- Procedures 66 | 67 | Procedure.s PodcastDateString(UTCDate.i) 68 | Protected Result.s 69 | Result = Mid("SunMonTueWedThuFriSat", 1 + DayOfWeek(UTCDate)*3, 3) + ", " 70 | Result + RSet(Str(Day(UTCDate)), 2, "0") + " " 71 | Result + Mid("JanFebMarAprMayJunJulAugSepOctNovDec", 1 + (Month(UTCDate)-1)*3, 3) + " " 72 | Result + RSet(Str(Year(UTCDate)), 4, "0") + " " 73 | Result + RSet(Str(Hour(UTCDate)), 2, "0") + ":" 74 | Result + RSet(Str(Minute(UTCDate)), 2, "0") + ":" 75 | Result + RSet(Str(Second(UTCDate)), 2, "0") + " " 76 | Result + "+0000" 77 | ProcedureReturn (Result) 78 | EndProcedure 79 | 80 | Procedure.s PodcastEscape(Text.s) 81 | Text = ReplaceString(Text, "&", "&") 82 | Text = ReplaceString(Text, "<", "<") 83 | Text = ReplaceString(Text, ">", ">") 84 | Text = ReplaceString(Text, "'", "'") 85 | Text = ReplaceString(Text, #DQUOTE$, """) 86 | ProcedureReturn (Text) 87 | EndProcedure 88 | 89 | Procedure.s ComposePodcast(*Pod.PODCAST) 90 | Protected Result.s 91 | Protected Indent.i = 2 92 | Protected DefDate.i = time() 93 | Protected BuildDateString.s = PodcastDateString(DefDate) 94 | If (*Pod) 95 | Result + Space(0 * Indent) + "" + #LF$ 96 | Result + Space(0 * Indent) + "" + #LF$ 97 | Result + Space(1 * Indent) + "" + #LF$ 98 | Result + Space(2 * Indent) + "" + #LF$ 99 | Result + Space(2 * Indent) + "" + PodcastEscape(*Pod\Title) + "" + #LF$ 100 | Result + Space(2 * Indent) + "" + PodcastEscape(*Pod\Description) + "" + #LF$ 101 | Result + Space(2 * Indent) + "" + PodcastEscape(*Pod\Website) + "" + #LF$ 102 | Result + Space(2 * Indent) + "en-us" + #LF$ 103 | If (*Pod\Copyright) 104 | Result + Space(2 * Indent) + "" + PodcastEscape(*Pod\Copyright) + "" + #LF$ 105 | Else 106 | Result + Space(2 * Indent) + "Copyright " + Str(Year(Date())) + "" + #LF$ 107 | EndIf 108 | Result + Space(2 * Indent) + ReplaceString("$1", "$1", BuildDateString) + #LF$ 109 | Result + Space(2 * Indent) + ReplaceString("$1", "$1", BuildDateString) + #LF$ 110 | Result + Space(2 * Indent) + "http://blogs.law.harvard.edu/tech/rss" + #LF$ 111 | If (*Pod\Author) 112 | Result + Space(2 * Indent) + "" + *Pod\Email + " (" + *Pod\Author + ")" + #LF$ 113 | Else 114 | Result + Space(2 * Indent) + "" + *Pod\Email + "" + #LF$ 115 | EndIf 116 | Result + Space(2 * Indent) + "" + #LF$ 117 | Result + Space(2 * Indent) + "" + #LF$ 118 | Result + Space(2 * Indent) + "" + PodcastEscape(*Pod\Author) + "" + #LF$ 119 | Result + Space(2 * Indent) + ReplaceString("$1", "$1", PodcastEscape(Left(*Pod\Description, 255))) + #LF$ 120 | Result + Space(2 * Indent) + ReplaceString("$1", "$1", PodcastEscape(*Pod\Description)) + #LF$ 121 | Result + Space(2 * Indent) + "" + #LF$ 122 | Result + Space(3 * Indent) + "" + PodcastEscape(*Pod\Author) + "" + #LF$ 123 | Result + Space(3 * Indent) + "" + PodcastEscape(*Pod\Email) + "" + #LF$ 124 | Result + Space(2 * Indent) + "" + #LF$ 125 | Result + Space(2 * Indent) + "No" + #LF$ 126 | Result + Space(2 * Indent) + ReplaceString("", "$1", PodcastEscape(*Pod\Image)) + #LF$ 127 | Result + Space(2 * Indent) + "" + #LF$ 128 | Result + Space(2 * Indent) + "" + #LF$ 129 | 130 | Protected Valid.i 131 | If (*Pod\Reverse) 132 | Valid = LastElement(*Pod\Item()) 133 | Else 134 | Valid = FirstElement(*Pod\Item()) 135 | EndIf 136 | While (Valid) 137 | Result + Space(2 * Indent) + "" + #LF$ 138 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", PodcastEscape(*Pod\Item()\Title)) + #LF$ 139 | If (*Pod\Item()\Link) 140 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", PodcastEscape(*Pod\Item()\Link)) + #LF$ 141 | Else 142 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", PodcastEscape(*Pod\Website)) + #LF$ 143 | EndIf 144 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", PodcastEscape(*Pod\Item()\GUID)) + #LF$ 145 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", PodcastEscape(*Pod\Item()\Desc)) + #LF$ 146 | Protected Bytes.i = *Pod\Item()\Bytes 147 | If (Bytes <= 0) 148 | Bytes = 50 * 1024 * 1024 149 | EndIf 150 | Result + Space(3 * Indent) + ReplaceString(ReplaceString("", "$1", PodcastEscape(*Pod\Item()\GUID)), "$2", Str(Bytes)) + #LF$ 151 | Result + Space(3 * Indent) + "Music" + #LF$ 152 | If (*Pod\Item()\UTCDate) 153 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", PodcastDateString(*Pod\Item()\UTCDate)) + #LF$ 154 | Else 155 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", PodcastDateString(DefDate)) + #LF$ 156 | If (*Pod\Reverse) 157 | DefDate - 60 158 | Else 159 | DefDate + 60 160 | EndIf 161 | EndIf 162 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", PodcastEscape(*Pod\Author)) + #LF$ 163 | Result + Space(3 * Indent) + "No" + #LF$ 164 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", PodcastEscape(Left(*Pod\Item()\Desc, 255))) + #LF$ 165 | If (*Pod\Item()\Image) 166 | Result + Space(3 * Indent) + ReplaceString("", "$1", PodcastEscape(*Pod\Item()\Image)) + #LF$ 167 | EndIf 168 | If (*Pod\Item()\Seconds > 0) 169 | Result + Space(3 * Indent) + ReplaceString("$1", "$1", FormatDate("%hh:%ii:%ss", *Pod\Item()\Seconds)) + #LF$ 170 | Else 171 | Result + Space(3 * Indent) + "1:00:00" + #LF$ 172 | EndIf 173 | Result + Space(2 * Indent) + "" + #LF$ 174 | If (*Pod\Reverse) 175 | Valid = PreviousElement(*Pod\Item()) 176 | Else 177 | Valid = NextElement(*Pod\Item()) 178 | EndIf 179 | Wend 180 | 181 | Result + Space(2 * Indent) + "" + #LF$ 182 | Result + Space(1 * Indent) + "" + #LF$ 183 | Result + Space(0 * Indent) + "" + #LF$ 184 | EndIf 185 | ProcedureReturn (Result) 186 | EndProcedure 187 | 188 | Procedure.i SavePodcast(*Pod.PODCAST, File.s) 189 | Protected Result.i = #False 190 | If (*Pod) 191 | Protected FN.i = CreateFile(#PB_Any, File) 192 | If (FN) 193 | WriteString(FN, ComposePodcast(*Pod)) 194 | CloseFile(FN) 195 | Result = #True 196 | EndIf 197 | EndIf 198 | ProcedureReturn (Result) 199 | EndProcedure 200 | 201 | Procedure.i CreatePodcast(Title.s) 202 | Protected *Pod.PODCAST = AllocateStructure(PODCAST) 203 | If (*Pod) 204 | *Pod\Title = Title 205 | EndIf 206 | ProcedureReturn (*Pod) 207 | EndProcedure 208 | 209 | Procedure.i FreePodcast(*Pod.PODCAST) 210 | If (*Pod) 211 | FreeStructure(*Pod) 212 | EndIf 213 | ProcedureReturn (#Null) 214 | EndProcedure 215 | 216 | Procedure SetPodcastDescription(*Pod.PODCAST, Text.s) 217 | If (*Pod) 218 | *Pod\Description = Text 219 | EndIf 220 | EndProcedure 221 | 222 | Procedure SetPodcastWebsite(*Pod.PODCAST, URL.s) 223 | If (*Pod) 224 | If (URL And (Not FindString(URL, "://"))) 225 | URL = "http://" + URL 226 | EndIf 227 | *Pod\Website = URL 228 | EndIf 229 | EndProcedure 230 | 231 | Procedure SetPodcastCopyright(*Pod.PODCAST, Text.s) 232 | If (*Pod) 233 | *Pod\Copyright = Text 234 | EndIf 235 | EndProcedure 236 | 237 | Procedure SetPodcastEmail(*Pod.PODCAST, Email.s) 238 | If (*Pod) 239 | *Pod\Email = Email 240 | EndIf 241 | EndProcedure 242 | 243 | Procedure SetPodcastFeedURL(*Pod.PODCAST, URL.s) 244 | If (*Pod) 245 | If (URL And (Not FindString(URL, "://"))) 246 | URL = "http://" + URL 247 | EndIf 248 | *Pod\FeedURL = URL 249 | EndIf 250 | EndProcedure 251 | 252 | Procedure SetPodcastAuthor(*Pod.PODCAST, Author.s) 253 | If (*Pod) 254 | *Pod\Author = Author 255 | EndIf 256 | EndProcedure 257 | 258 | Procedure SetPodcastImage(*Pod.PODCAST, Image.s) 259 | If (*Pod) 260 | *Pod\Image = Image 261 | EndIf 262 | EndProcedure 263 | 264 | Procedure AddPodcastItem(*Pod.PODCAST, GUID.s, Title.s = "", UTCDate.i = 0, Desc.s = "", Seconds.i = 0, Image.s = "", Link.s = "", Bytes.i = 0) 265 | If (*Pod) 266 | AddElement(*Pod\Item()) 267 | *Pod\Item()\GUID = GUID 268 | *Pod\Item()\Title = Title 269 | *Pod\Item()\UTCDate = UTCDate 270 | *Pod\Item()\Desc = Desc 271 | *Pod\Item()\Seconds = Seconds 272 | *Pod\Item()\Image = Image 273 | *Pod\Item()\Link = Link 274 | *Pod\Item()\Bytes = Bytes 275 | EndIf 276 | EndProcedure 277 | 278 | Procedure SortPodcastByDates(*Pod.PODCAST, OldestFirst.i = #False) 279 | If (*Pod) 280 | If (OldestFirst) 281 | SortStructuredList(*Pod\Item(), #PB_Sort_Ascending, OffsetOf(PODCASTITEM\UTCDate), #PB_Integer) 282 | Else 283 | SortStructuredList(*Pod\Item(), #PB_Sort_Descending, OffsetOf(PODCASTITEM\UTCDate), #PB_Integer) 284 | EndIf 285 | EndIf 286 | EndProcedure 287 | 288 | Procedure ReversePodcastOrder(*Pod.PODCAST, Reverse.i = #True) 289 | If (*Pod) 290 | *Pod\Reverse = Bool(Reverse) 291 | EndIf 292 | EndProcedure 293 | 294 | 295 | 296 | ;- 297 | ;- Demo Program 298 | CompilerIf (#PB_Compiler_IsMainFile) 299 | DisableExplicit 300 | 301 | *Pod = CreatePodcast("Purecast") 302 | If (*Pod) 303 | SetPodcastDescription(*Pod, "Create podcast feeds in PureBasic") 304 | SetPodcastWebsite(*Pod, "http://www.purebasic.com") 305 | SetPodcastCopyright(*Pod, "Copyright " + Str(Year(Date()))) 306 | SetPodcastEmail(*Pod, "feed@purebasic.com") 307 | SetPodcastFeedURL(*Pod, "http://purebasic.com/feed.xml") 308 | SetPodcastAuthor(*Pod, "PB Author") 309 | SetPodcastImage(*Pod, "http://purebasic.com/images/logopb.gif") 310 | 311 | AddPodcastItem(*Pod, "http://purebasic.com/ep01.mp3", "My MP3") 312 | 313 | Debug ComposePodcast(*Pod) 314 | 315 | FreePodcast(*Pod) 316 | EndIf 317 | 318 | CompilerEndIf 319 | CompilerEndIf 320 | ;- 321 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # PureBasic Includes 2 | A variety of useful Include Files for PureBasic projects 3 | 4 | Most of these come from my own projects, others were written for the PB forums, and some were never used at all. Feel free to borrow, modify, and share. No credit required. 5 | 6 | *All files are "EnableExplicit safe" and "Multiple-include safe"* 7 | 8 | ## [7Zip.pbi](7Zip.pbi) 9 | This provides an interface to the basic archive functions of 7-Zip - creation, examination, and extraction - with password support. 10 | + Windows only 11 | + ASCII/Unicode safe 12 | + Demo included 13 | + **[7-Zip commandline version](http://www.7-zip.org/download.html) (7za.exe) is required** 14 | 15 | ## [Base64Lib.pbi](Base64Lib.pbi) 16 | A set of encoder/decoder/helper functions to improve upon (or replace) PB's Base64 functions. Various conversions to/from strings, files, and memory buffers. 17 | + Windows/Linux/Mac 18 | + ASCII/Unicode safe 19 | + Demo included 20 | 21 | ## [CanvasDrag.pbi](CanvasDrag.pbi) 22 | Helper functions to handle CanvasGadget events and simplify mouse dragging, selection, panning, etc. 23 | + [WindowFromGadget.pbi](WindowFromGadget.pbi) is also required 24 | 25 | ## [CocoaHelper.pbi](CocoaHelper.pbi) 26 | A few helper functions for dealing with Cocoa objects. 27 | + Mac only (compiles but has no effect on other OS) 28 | + ASCII/Unicode safe 29 | 30 | ## [ColorRequesterEx.pbi](ColorRequesterEx.pbi) 31 | Basic improvements to the ColorRequester. On all OS, this saves your last picked color between calls, and even between program runs if the `UseFile` flag is specified. On Windows, it also lets you open a "full" size color chooser, and lets you specify and save the 16 "custom color" boxes. 32 | + Windows/Linux/Mac 33 | + ASCII/Unicode safe 34 | + Demo included 35 | 36 | ## [common.pbi](common.pbi) 37 | Lots of handy constants, macros, and procedures for common tasks related to: data types, time and date, dialogs, gadgets, file I/O, file paths, drawing, images, strings, etc. 38 | + Windows/Linux/Mac 39 | + ASCII/Unicode safe 40 | + **[os.pbi](os.pbi) is also required** 41 | 42 | ## [Complex.pbi](Complex.pbi) 43 | Functions and macros to handle complex numbers (32-bit float precision per each component) and the usual, basic operations on them. Long-name procedures are provided (such as `Complex_Imaginary()`), as well as short-name macros (such as `cImag()`). 44 | + Windows/Linux/Mac 45 | + ASCII/Unicode safe 46 | + Demo included 47 | 48 | ## [CompressHelper.pbi](CompressHelper.pbi) 49 | Helper functions which greatly simplify the (eight) combinations of compressing/decompressing to/from memory/files. You can use the ZIP, LZMA, and BriefLZ packer plugins (default is ZIP). 50 | + Windows/Linux/Mac 51 | + ASCII/Unicode safe 52 | + Demo included 53 | + **PB 5.10+** is required 54 | 55 | ## [DesktopHelper.pbi](DesktopHelper.pbi) 56 | Helper functions for dealing with multiple screens, parent and child windows, window states. 57 | + Windows/Linux/Mac 58 | + ASCII/Unicode safe 59 | + Demo included 60 | 61 | ## [DropdownButtonGadget.pbi](DropdownButtonGadget.pbi) 62 | Custom canvas-based button which provides one clickable main action, plus a popup menu for secondary actions. Simulates a widget seen in some Microsoft programs. 63 | + Windows/Linux/Mac 64 | + ASCII/Unicode safe 65 | + Demo included 66 | 67 | ## [EnvironmentPaths.pbi](EnvironmentPaths.pbi) 68 | This lets you Examine() and step through a list of environment paths. On Windows, this refers to the `PATH` environment variable. On other OS, nothing is implemented yet. 69 | + Windows only (compiles but has no effect on other OS) 70 | + ASCII/Unicode safe 71 | + Demo included 72 | 73 | ## [FormatDatePHP.pbi](FormatDatePHP.pbi) 74 | Provides timestamp-to-string formatting with the same options and syntax as PHP's `date()` function. 75 | + Windows/Linux/Mac 76 | + ASCII/Unicode safe 77 | + Demo included 78 | 79 | ## [FTPHelper.pbi](FTPHelper.pbi) 80 | A few functions to assist you in uploading/downloading/changing the directory in an FTP connection, by full path, instead of manually "walking" the server's directory structure. 81 | + Windows/Linux/Mac 82 | + ASCII/Unicode safe 83 | + Demo included 84 | 85 | ## [GadgetCommon.pbi](GadgetCommon.pbi) 86 | Helper functions for handling the selected items, checked items, and item data of ListIconGadgets, ListViewGadgets, and TreeGadgets. 87 | + Windows/Linux/Mac 88 | + ASCII/Unicode safe 89 | + Demo included 90 | 91 | ## [GetExifData.pbi](GetExifData.pbi) 92 | Reads EXIF metadata from image files (typically JPEG). Currently, it only reads the EXIF rotation (how the image should be rotated when displayed to the user). 93 | + Windows/Linux/Mac 94 | + ASCII/Unicode safe 95 | + Demo included 96 | + **[RotateImage.pbi](RotateImage.pbi) is also required** if you use `LoadImageEXIFRotated()` 97 | 98 | ## [Hg.mod.pbi](Hg.mod.pbi) 99 | This is a Module for interacting with Mercurial (`Hg`) SCM. Functionality includes creating and committing repos, examining changed files, generating a diff, examining the commit log. 100 | + Windows only (not tested on Linux/Mac) 101 | + ASCII/Unicode safe 102 | + Demo included 103 | + **Mercurial (Hg) must be installed** on you/the user's system 104 | + **PB 5.20+** is required 105 | 106 | ## [ImproveGadgets.pbi](ImproveGadgets.pbi) 107 | Various small improvements to native PB gadgets 108 | + Windows only (compiles but has no effect on other OS) 109 | + ASCII/Unicode safe 110 | + Demo included 111 | + **StringGadget**, **ComboBoxGadget**: adds Ctrl+Backspace word deletion 112 | + **ContainerGadget**: reduces resize flickering by disabling some redraw events 113 | + **WebGadget**: Disables annoying "Script Error" popups 114 | 115 | ## [ini.pbi](ini.pbi) 116 | Functions for reading/writing INI files. A replacement for PB's Preferences library, with added functionality, formatting options for the file and values, and helper functions. The similarities and differences are summarized in the comments near the top of the file. 117 | + Windows/Linux/Mac 118 | + ASCII/Unicode safe 119 | + Demo included 120 | 121 | ## [IntStack.pbi](IntStack.pbi) 122 | Implements a simple Stack (`Push` + `Pop`, with `Peek`) of a fixed type (PB integer). 123 | + Windows/Linux/Mac 124 | + ASCII/Unicode safe 125 | + Demo included 126 | 127 | ## [JSON.pbi](JSON.pbi) 128 | Basic JSON support (read/write/parse/modify) before PureBasic added its own JSON library in 5.30 129 | + Windows/Linux/Mac 130 | + ASCII/Unicode safe 131 | + Demo included 132 | + **PB 5.30+**: Use [OJSON.pbi](OJSON.pbi) instead 133 | + **PB 5.20+**: Compiles as a Module (`UseModule JSON`) 134 | + **Before 5.20**: Compiles as included procedures 135 | 136 | ## [JSON_Helper.pbi](JSON_Helper.pbi) 137 | Handy procedures, macros, and constants for simplifying JSON code, using PB's JSON library added in 5.30. 138 | + Windows/Linux/Mac 139 | + ASCII/Unicode safe 140 | + Demo included 141 | 142 | ## [ListRequester.pbi](ListRequester.pbi) 143 | Provides a `Requester`-like dialog window, which presents the user with a list of options as a ListView, ListIcon, or Tree gadget. Customizations include multiple-select, icons, and button placement. This is an older include; it should be rewritten with newer PB features and without the need for a user-managed List! 144 | + Windows/Linux/Mac 145 | + ASCII/Unicode safe 146 | + Demo included 147 | 148 | ## [MemGadget.pbi](MemGadget.pbi) 149 | Custom canvas-based gadget for displaying and editing memory blocks as hex bytes or ASCII characters. 150 | + Windows/Linux/Mac 151 | + ASCII/Unicode safe 152 | + Demo included 153 | 154 | ## [OJSON.pbi](OJSON.pbi) 155 | A variation of JSON.pbi, renamed to OJSON ("Ordered JSON") to avoid conflicts with PB 5.30+. Preserves the order of a JSON Object's members, unlike PB's JSON library. Not a Module. 156 | + Windows/Linux/Mac 157 | + ASCII/Unicode safe 158 | + Demo included 159 | 160 | ## [os.pbi](os.pbi) 161 | Low-overhead code (constants and macros, no procedures) to simplify cross-platform programming 162 | 163 | Convenient for handling different OS, filesystems, subsystems, ASCII vs. Unicode, x86 vs. x64 164 | + Windows/Linux/Mac 165 | + ASCII/Unicode safe 166 | 167 | ## [OSTheme.pbi](OSTheme.pbi) 168 | Helper functions to determine system colors for drawing. Also detect and react to OS theme changes (light or dark mode, accent colors, etc.) by callback, event, or polling. 169 | 170 | + Windows/Mac (Linux not yet implemented) 171 | + ASCII/Unicode safe 172 | + Demo included 173 | 174 | ## [OS_Names.pbi](OS_Names.pbi) 175 | Two functions, to retreive the (string) name of the user's OS and OS version. (Example: "Windows" and "Windows 7") 176 | + Windows/Linux/Mac 177 | + ASCII/Unicode safe 178 | 179 | ## [PBP_Projects.pbi](PBP_Projects.pbi) 180 | Functions for parsing PureBasic's own `.pbp` format project files. You can iterate through a project's targets, read basic information about them, and generate a string of appropriate `pbcompiler` parameters. 181 | + Windows/Linux/Mac 182 | + ASCII/Unicode safe 183 | + Demo included 184 | 185 | ## [PBShortcuts.pbi](PBShortcuts.pbi) 186 | A very simple file which tells you a `#PB_Shortcut_*` constant's name string from its numeric value, or vice versa. You can also Debug all shortcut values with one Procedure call, or use the demo program to quickly map keypresses to `#PB_Shortcut_*` constants. 187 | + Windows/Linux/Mac 188 | + ASCII/Unicode safe 189 | + Demo included 190 | 191 | ## [Podcast.pbi](Podcast.pbi) 192 | Procedures for generating podcast feeds (RSS/XML files) from channel and episode data. 193 | + Windows/Linux/Mac 194 | + ASCII/Unicode safe 195 | + Demo included 196 | 197 | ## [PropertyGadget.pbi](PropertyGadget.pbi) 198 | An implementation of a PropertyGadget, a custom scrollable gadget containing many types of child gadgets, which can be read/written by numeric index or string ID. Named headers divide them into groups, which can be collapsed or expanded. 199 | + Windows only (not tested on Linux/Mac) 200 | + ASCII/Unicode safe 201 | + Demo included 202 | 203 | ## [PSDL.pbi](PSDL.pbi) 204 | Constants and function bindings for an incomplete (but growing) subset of the SDL2 API. Subsystems include Window, Texture, Renderer, Keyboard, Mouse, Joystick, GameController, Haptic. The library can be statically or dynamically linked by setting a compile switch constant. 205 | + Windows only (not tested on Linux/Mac) 206 | + ASCII/Unicode safe 207 | 208 | ## [RatingGadget.pbi](RatingGadget.pbi) 209 | Custom canvas-based gadget which allows the user to select a rating on a horizontal image bar. The default range is 5 stars (images included in DataSection). The images and range are changeable. 210 | + Windows/Linux/Mac 211 | + ASCII/Unicode safe 212 | + Demo included 213 | 214 | ## [RegEx_Helper.pbi](RegEx_Helper.pbi) 215 | Simple helper functions for replacing, removing, matching, and extracting strings via RegEx patterns. 216 | + Windows/Linux/Mac 217 | + ASCII/Unicode safe 218 | + Demo included 219 | 220 | ## [RequesterEx.pbi](RequesterEx.pbi) 221 | Many improvements to the Open/Save/Path Requesters. All parameters are made optional, file extensions are automatically recognized and appended, multiple-file selection is greatly simplified, missing default folders are detected, Mac quirks are corrected. 222 | + Windows/Linux/Mac 223 | + ASCII/Unicode safe 224 | + Demo included 225 | 226 | ## [RotateImage.pbi](RotateImage.pbi) 227 | Rotate images 90/180/270 degrees, pixel-perfect, using API when possible. One versatile procedure lets you rotate an image in-place, rotate to another image ID, or rotate to a new `#PB_Any` image. 228 | + Windows/Linux/Mac 229 | + ASCII/Unicode safe 230 | + Demo included 231 | 232 | ## [ScaleImage.pbi](ScaleImage.pbi) 233 | This simplifies resizing images and image files to a single function call. Options include: stretch, fit, fill, tile, center, border color, alignment, raw/smooth interpolation. 234 | + Windows/Linux/Mac 235 | + ASCII/Unicode safe 236 | + Demo included 237 | 238 | ## [ScanFolder.pbi](ScanFolder.pbi) 239 | This simplifies scanning folder contents to a single function call. Options include: recursive search, include folders, exclude hidden items, filter by extension, RegEx matching, absolute or relative results. 240 | + Windows/Linux/Mac 241 | + ASCII/Unicode safe 242 | + Demo included 243 | 244 | ## [ScintillaBoost.pbi](ScintillaBoost.pbi) 245 | This include is very convenient when working with the `ScintillaGadget`: 246 | *Automatically handles string conversion to and from UTF-8* 247 | *Provides hundreds of named macros, so you don't need to pass `#SCI_` constants and remember parameter order* 248 | *Has extra procedures (names end in `_`) for additional functionality* 249 | + Windows/Linux/Mac 250 | + ASCII/Unicode safe 251 | 252 | ## [SendKeys_Win.pbi](SendKeys_Win.pbi) 253 | A small Windows include which provides `PressKey(VK)`, `ReleaseKey(VK)`, and `TapKey(VK, msDelay)` functions for simulating keypresses to the active window. You can select between 3 types of keypress methods at compile time. 254 | + Windows only 255 | + ASCII/Unicode safe 256 | + Demo included 257 | 258 | ## [StringHelper.pbi](StringHelper.pbi) 259 | A variety of useful procedures, macros, and constants for dealing with different string encodings, ASCII-to-Unicode updates, writing and parsing in memory, text file I/O. 260 | Support for ASCII, Unicode (UTF-16), UTF-8, UTF-32 261 | + Windows/Linux/Mac 262 | + ASCII/Unicode safe 263 | + Demo included 264 | 265 | ## [Winamp.pbi](Winamp.pbi) 266 | Gives you basic access and control of Winamp's playback status 267 | 268 | **Note**: This is for controlling Winamp from an external program, not for writing Winamp plugin DLLs 269 | + Windows only 270 | + ASCII/Unicode safe 271 | 272 | ## [WindowFromGadget.pbi](WindowFromGadget.pbi) 273 | Provides helpful functions for custom gadget modules: `GetWindowFromID()`, `GetWindowFromGadget()`, `GetBuildWindow()` 274 | + Fully implemented on Windows, partially on other OS 275 | + Demo included 276 | 277 | ## [XML_Helper.pbi](XML_Helper.pbi) 278 | Handy procedures, macros, and constants for simplifying XML code, using PB's XML library. 279 | + Windows/Linux/Mac 280 | + ASCII/Unicode safe 281 | -------------------------------------------------------------------------------- /RegEx_Helper.pbi: -------------------------------------------------------------------------------- 1 | ; +--------------+ 2 | ; | RegEx_Helper | 3 | ; +--------------+ 4 | ; | 2018-06-22 : Creation 5 | ; | 2018-09-05 : Match() now forces "^" and "$", Contains() does not 6 | ; | 2018-09-20 : Added ReExtract() to get first match 7 | ; | 2020-11-24 : Added AppendList option to Extract/List 8 | 9 | ; \s = whitespace characters (\S = NOT whitespace characters) 10 | ; \w = word characters (\W = NOT word characters) 11 | ; \d = digits (\D = NOT digits) 12 | ; 13 | ; . = any character (newlines optional) 14 | ; 15 | ; * = 0 or more (greedy, as much as possible) 16 | ; + = 1 or more (greedy, as much as possible) 17 | ; *? = 0 or more (lazy, as little as possible) 18 | ; +? = 1 or more (lazy, as little as possible) 19 | ; 20 | ; ^ = start of string/line 21 | ; $ = end of string/line 22 | ; 23 | ; (?=SUFFIX) = lookahead 24 | ; (?<=PREFIX) = lookbehind 25 | 26 | ;- 27 | CompilerIf (Not Defined(_RegEx_Helper_Included, #PB_Constant)) 28 | #_RegEx_Helper_Included = #True 29 | 30 | CompilerIf (#PB_Compiler_IsMainFile) 31 | EnableExplicit 32 | CompilerEndIf 33 | 34 | ;- Procedures 35 | 36 | Procedure.s ReReplace(String.s, Pattern.s, Replacement.s, Flags.i = #Null) 37 | Protected Result.s 38 | Protected *RE = CreateRegularExpression(#PB_Any, Pattern, Flags) 39 | If (*RE) 40 | Result = ReplaceRegularExpression(*RE, String, Replacement) 41 | FreeRegularExpression(*RE) 42 | EndIf 43 | ProcedureReturn (Result) 44 | EndProcedure 45 | 46 | Procedure.s ReRemove(String.s, Pattern.s, Flags.i = #Null) 47 | ProcedureReturn (ReReplace(String, Pattern, "", Flags)) 48 | EndProcedure 49 | 50 | Procedure.i ReContains(String.s, Pattern.s, Flags.i = #Null) 51 | Protected Result.i = #False 52 | Protected *RE = CreateRegularExpression(#PB_Any, Pattern, Flags) 53 | If (*RE) 54 | Result = Bool(MatchRegularExpression(*RE, String)) 55 | FreeRegularExpression(*RE) 56 | EndIf 57 | ProcedureReturn (Result) 58 | EndProcedure 59 | 60 | Procedure.i ReMatch(String.s, Pattern.s, Flags.i = #Null) 61 | Protected Result.i = #False 62 | If (Left(Pattern, 1) <> "^") 63 | Pattern = "^" + Pattern 64 | EndIf 65 | If (Right(Pattern, 1) <> "$") 66 | Pattern = Pattern + "$" 67 | EndIf 68 | Protected *RE = CreateRegularExpression(#PB_Any, Pattern, Flags) 69 | If (*RE) 70 | Result = Bool(MatchRegularExpression(*RE, String)) 71 | FreeRegularExpression(*RE) 72 | EndIf 73 | ProcedureReturn (Result) 74 | EndProcedure 75 | 76 | Procedure.i ReExtractArray(String.s, Pattern.s, Array Match.s(1), Flags.i = #Null) 77 | Protected Result.i = 0 78 | Dim Match.s(0) 79 | Protected *RE = CreateRegularExpression(#PB_Any, Pattern, Flags) 80 | If (*RE) 81 | Result = ExtractRegularExpression(*RE, String, Match()) 82 | FreeRegularExpression(*RE) 83 | EndIf 84 | ProcedureReturn (Result) 85 | EndProcedure 86 | 87 | Procedure.s ReExtract(String.s, Pattern.s, Flags.i = #Null) 88 | Protected Result.s 89 | Dim AMatch.s(0) 90 | If (ReExtractArray(String, Pattern, AMatch(), Flags) > 0) 91 | Result = AMatch(0) 92 | EndIf 93 | ProcedureReturn (Result) 94 | EndProcedure 95 | 96 | Procedure.i ReExtractList(String.s, Pattern.s, List Match.s(), Flags.i = #Null, AppendList.i = #False) 97 | Protected Result.i 98 | Dim AMatch.s(0) 99 | Result = ReExtractArray(String, Pattern, AMatch(), Flags) 100 | If (AppendList) 101 | LastElement(Match()) 102 | Else 103 | ClearList(Match()) 104 | EndIf 105 | If (Result > 0) 106 | Protected i.i 107 | For i = 0 To Result-1 108 | AddElement(Match()) 109 | Match() = AMatch(i) 110 | Next i 111 | EndIf 112 | ProcedureReturn (Result) 113 | EndProcedure 114 | 115 | ;- ReQuickResult 116 | Threaded NewList ReQuickResult.s() 117 | 118 | Procedure.i ReQuickExtract(String.s, Pattern.s, Flags.i = #Null, AppendList.i = #False) 119 | ProcedureReturn (ReExtractList(String, Pattern, ReQuickResult(), Flags, AppendList)) 120 | EndProcedure 121 | 122 | 123 | 124 | 125 | ;- 126 | ;- Demo 127 | 128 | CompilerIf (#PB_Compiler_IsMainFile) 129 | DisableExplicit 130 | 131 | Debug ReReplace("Hello World!", "\s+", "___") 132 | 133 | Debug ReRemove("Hello World!", "l") 134 | 135 | Debug "" 136 | Debug ReContains("Hello World!", "World") 137 | Debug ReMatch("Hello World!", "World") 138 | 139 | Debug "" 140 | Debug ReQuickExtract("Hello World!", "[a-z]+") 141 | ForEach ReQuickResult() 142 | Debug ReQuickResult() 143 | Next 144 | 145 | CompilerEndIf 146 | CompilerEndIf 147 | ;- -------------------------------------------------------------------------------- /RequesterEx.pbi: -------------------------------------------------------------------------------- 1 | ; +-------------+ 2 | ; | RequesterEx | 3 | ; +-------------+ 4 | ; | 2015.05.09 . Creation (PureBasic 5.31) 5 | ; | .06.02 . Fixed false extensions on Mac (SelectedFilePattern()=0 on Mac) 6 | ; | .08.18 . Reworked pattern/extension handling (Win and Mac safe) 7 | ; | .19 . Handled files like '.log' correctly, 8 | ; | '*.*' is now guessed for unrecognized default files, 9 | ; | reworked pattern guessing (no more negative parameters), 10 | ; | missing folders now map to top existing parent 11 | ; | .12.16 . Implemented SelectedFileList(), MultiFileRequesterEx() 12 | ; | 2017.05.10 . Made PathReq params optional, cleaned up demo, 13 | ; | saved last folder between Open/Save RequesterEx calls, 14 | ; | fixed duplicate extension bug such as (*.txt)(*.txt), 15 | ; | replaced "Guess" params with a Pattern of -1 16 | ; | 2017.08.11 . Trim trailing periods on Windows save filenames 17 | ; | 2019.11.11 . Added PrepareFileRequesterEx() and related 18 | ; | 2019.11.19 . Improved Prepare by moving temp Requester to main thread 19 | ; | 2020-02-22 . Replaced dummy-requester Prepare method with path modification 20 | ; | 2021-03-19 . Added NextSelectedFileNameEx(), RequesterExAddedExtension() 21 | ; | 2021-08-20 . Ensure trailing PS$ if default path is a folder 22 | ; | 2021-09-05 . Set ActivationPolicy for MacOS console mode requesters 23 | 24 | ;- 25 | CompilerIf (Not Defined(__RequesterEx_Included, #PB_Constant)) 26 | #__RequesterEx_Included = #True 27 | 28 | CompilerIf (#PB_Compiler_IsMainFile) 29 | EnableExplicit 30 | CompilerEndIf 31 | 32 | 33 | 34 | 35 | ;- Macros (Private) 36 | 37 | Macro __RequesterEx_CountPatterns(PatternString) 38 | (((CountString((PatternString), "|")) + 1) / 2) 39 | EndMacro 40 | 41 | Macro __RequesterEx_PatternName(PatternString, Index) 42 | ; 0-based index 43 | Trim(StringField((PatternString), 1 + 2*(Index), "|")) 44 | EndMacro 45 | 46 | Macro __RequesterEx_PatternFilter(PatternString, Index) 47 | ; 0-based index 48 | RemoveString(StringField((PatternString), 2 + 2*(Index), "|"), " ") 49 | EndMacro 50 | 51 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 52 | Macro __RequesterEx_PS() 53 | "\" 54 | EndMacro 55 | CompilerElse 56 | Macro __RequesterEx_PS() 57 | "/" 58 | EndMacro 59 | CompilerEndIf 60 | 61 | CompilerIf ((#PB_Compiler_OS = #PB_OS_Windows) And (#True)) 62 | Global __RequesterEx_Prepared.i = #False 63 | Macro __RequesterEx_PreparePathVar(PathVar) 64 | If (Not __RequesterEx_Prepared) 65 | __RequesterEx_Prepared = #True 66 | PathVar = GetPathPart(PathVar) + Str(Date()) + "\..\" + GetFilePart(PathVar) 67 | EndIf 68 | EndMacro 69 | CompilerElse 70 | Macro __RequesterEx_PreparePathVar(PathVar) 71 | ; 72 | EndMacro 73 | CompilerEndIf 74 | 75 | CompilerIf ((#PB_Compiler_OS = #PB_OS_MacOS) And (#True)) 76 | Procedure __RequesterEx_SetActivationPolicy() 77 | CocoaMessage(0, CocoaMessage(0, 0, "NSApplication sharedApplication"), "setActivationPolicy:", 0) ; #NSApplicationActivationPolicyRegular 78 | EndProcedure 79 | CompilerElse 80 | Macro __RequesterEx_SetActivationPolicy() 81 | ; 82 | EndMacro 83 | CompilerEndIf 84 | 85 | 86 | 87 | 88 | ;- 89 | ;- Variables (Private) 90 | 91 | Threaded __RequesterEx_SelectedPattern.i = 0 92 | Threaded __RequesterEx_FirstFile.s = "" 93 | Threaded __RequesterEx_LastFolder.s = "" 94 | Threaded __RequesterEx_AddedExtension.i = #False 95 | 96 | 97 | 98 | ;- 99 | ;- Procedures (Private) 100 | 101 | Procedure.s __RequesterEx_FormatPattern(PatternString.s) 102 | Protected Result.s = "" 103 | If (PatternString) 104 | Protected n.i = __RequesterEx_CountPatterns(PatternString) 105 | Protected Name.s 106 | Protected i.i 107 | For i = 0 To n - 1 108 | Name = __RequesterEx_PatternName(PatternString, i) 109 | Result + Name 110 | If (Not FindString(Name, "(")) 111 | Result + " (" + __RequesterEx_PatternFilter(PatternString, i) + ")" 112 | EndIf 113 | Result + "|" + __RequesterEx_PatternFilter(PatternString, i) 114 | If (i < n - 1) 115 | Result + "|" 116 | EndIf 117 | Next i 118 | Else 119 | Result = "All Files (*.*)|*.*" 120 | EndIf 121 | ProcedureReturn (Result) 122 | EndProcedure 123 | 124 | Procedure.i __RequesterEx_GuessPattern(PatternList.s, File.s, DefaultPattern.i) 125 | Protected Result.i = DefaultPattern 126 | If (Result < 0) 127 | Result = 0 128 | EndIf 129 | Protected Ext.s 130 | If (FindString(File, ".")) 131 | Ext = GetExtensionPart(File) 132 | If (Ext = "") 133 | Ext = Trim(File, ".") 134 | EndIf 135 | Else 136 | Ext = Trim(File) 137 | EndIf 138 | If (Ext) 139 | PatternList = LCase(PatternList) 140 | Protected n.i = __RequesterEx_CountPatterns(PatternList) 141 | If (n > 0) 142 | Ext = LCase(Ext) 143 | Protected Found.i = #False 144 | Protected AllPattern.i = -1 145 | Protected i.i 146 | For i = 0 To n - 1 147 | If (FindString(__RequesterEx_PatternFilter(PatternList, i) + ";", "*." + Ext + ";")) 148 | Found = #True 149 | Result = i 150 | Break 151 | ElseIf (FindString(__RequesterEx_PatternFilter(PatternList, i) + ";", "*.*;")) 152 | AllPattern = i 153 | EndIf 154 | Next i 155 | If ((Not Found) And (AllPattern >= 0)) 156 | Result = AllPattern 157 | EndIf 158 | EndIf 159 | EndIf 160 | ProcedureReturn (Result) 161 | EndProcedure 162 | 163 | Procedure.s __RequesterEx_TopExisting(Path.s) 164 | If (Path) 165 | Path = RTrim(Path, __RequesterEx_PS()) + __RequesterEx_PS() 166 | While (Path And (FileSize(Path) <> -2)) 167 | Path = GetPathPart(RTrim(Path, __RequesterEx_PS())) 168 | Wend 169 | EndIf 170 | ProcedureReturn (Path) 171 | EndProcedure 172 | 173 | 174 | 175 | 176 | 177 | 178 | ;- 179 | ;- Macros (Public) 180 | 181 | Macro MultiFileRequesterEx(Title = "Open", DefaultFile = "", Pattern = "", PatternPosition = 0) 182 | OpenFileRequesterEx(Title, DefaultFile, Pattern, (PatternPosition), #True) 183 | EndMacro 184 | 185 | Macro NextSelectedFileNameEx() 186 | NextSelectedFileName() 187 | EndMacro 188 | 189 | Macro RequesterExAddedExtension() 190 | (__RequesterEx_AddedExtension) 191 | EndMacro 192 | 193 | 194 | ;- 195 | ;- Procedures (Public) 196 | 197 | Procedure.s PathRequesterEx(Title.s = "", InitialPath.s = "") 198 | __RequesterEx_SetActivationPolicy() 199 | 200 | If (Title = "") 201 | Title = "Path" 202 | EndIf 203 | If (InitialPath = "") 204 | InitialPath = GetHomeDirectory() 205 | EndIf 206 | CompilerIf (#PB_Compiler_OS = #PB_OS_MacOS) 207 | If (InitialPath = "/") 208 | InitialPath = "///" 209 | Else 210 | CompilerIf (#PB_Compiler_Version <= 531) 211 | InitialPath + __RequesterEx_PS() 212 | CompilerEndIf 213 | EndIf 214 | CompilerEndIf 215 | ProcedureReturn (PathRequester(Title, InitialPath)) 216 | EndProcedure 217 | 218 | Procedure.i SelectedRequesterExPattern() 219 | ProcedureReturn (__RequesterEx_SelectedPattern) 220 | EndProcedure 221 | 222 | Procedure.s SaveFileRequesterEx(Title.s = "Save", DefaultFile.s = "", Pattern.s = "", PatternPosition.i = #PB_Default) 223 | Protected Result.s = "" 224 | 225 | __RequesterEx_SetActivationPolicy() 226 | 227 | If (DefaultFile = "") 228 | If (__RequesterEx_LastFolder = "") 229 | __RequesterEx_LastFolder = GetCurrentDirectory() 230 | EndIf 231 | DefaultFile = __RequesterEx_LastFolder 232 | EndIf 233 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 234 | ReplaceString(DefaultFile, "/", "\", #PB_String_InPlace) 235 | CompilerEndIf 236 | If (FileSize(DefaultFile) = -2) 237 | If (Right(DefaultFile, 1) <> __RequesterEx_PS()) 238 | DefaultFile + __RequesterEx_PS() 239 | EndIf 240 | EndIf 241 | Protected DefPath.s = GetPathPart(DefaultFile) 242 | Protected DefFile.s = GetFilePart(DefaultFile) 243 | DefaultFile = __RequesterEx_TopExisting(DefPath) + DefFile 244 | 245 | Protected Guess.i = #False 246 | If (PatternPosition < 0) 247 | PatternPosition = 0 248 | Guess = #True 249 | EndIf 250 | 251 | Protected PatternEx.s = __RequesterEx_FormatPattern(Pattern) 252 | If (DefFile And Guess) 253 | PatternPosition = __RequesterEx_GuessPattern(PatternEx, DefFile, PatternPosition) 254 | EndIf 255 | 256 | __RequesterEx_PreparePathVar(DefaultFile) 257 | 258 | __RequesterEx_AddedExtension = #False 259 | Result = SaveFileRequester(Title, DefaultFile, PatternEx, PatternPosition) 260 | If (Result) 261 | __RequesterEx_LastFolder = GetPathPart(Result) 262 | CompilerIf (#PB_Compiler_OS = #PB_OS_MacOS) 263 | __RequesterEx_SelectedPattern = PatternPosition 264 | CompilerElse 265 | __RequesterEx_SelectedPattern = SelectedFilePattern() 266 | CompilerEndIf 267 | 268 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 269 | Result = RTrim(Result, ".") 270 | CompilerEndIf 271 | 272 | Protected Extension.s = LCase(GetExtensionPart(Result)) 273 | If ((Extension = "") And (Not FindString(GetFilePart(Result), "."))) 274 | Protected SelectedFilter.s = __RequesterEx_PatternFilter(Pattern, __RequesterEx_SelectedPattern) 275 | If ((SelectedFilter = "") Or (SelectedFilter = "*") Or (SelectedFilter = "*.*")) 276 | ; Append nothing 277 | Else 278 | Extension = StringField(SelectedFilter, 1, ";") 279 | Extension = StringField(Extension, 2, "*.") 280 | Result + "." + Extension 281 | __RequesterEx_AddedExtension = #True 282 | EndIf 283 | EndIf 284 | 285 | EndIf 286 | ProcedureReturn (Result) 287 | EndProcedure 288 | 289 | Procedure.s OpenFileRequesterEx(Title.s = "Open", DefaultFile.s = "", Pattern.s = "", PatternPosition.i = #PB_Default, MultiSelect.i = #False) 290 | Protected Result.s = "" 291 | 292 | __RequesterEx_SetActivationPolicy() 293 | 294 | If (DefaultFile = "") 295 | If (__RequesterEx_LastFolder = "") 296 | __RequesterEx_LastFolder = GetCurrentDirectory() 297 | EndIf 298 | DefaultFile = __RequesterEx_LastFolder 299 | EndIf 300 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 301 | ReplaceString(DefaultFile, "/", "\", #PB_String_InPlace) 302 | CompilerEndIf 303 | If (FileSize(DefaultFile) = -2) 304 | If (Right(DefaultFile, 1) <> __RequesterEx_PS()) 305 | DefaultFile + __RequesterEx_PS() 306 | EndIf 307 | EndIf 308 | Protected DefPath.s = GetPathPart(DefaultFile) 309 | Protected DefFile.s = GetFilePart(DefaultFile) 310 | DefaultFile = __RequesterEx_TopExisting(DefPath) + DefFile 311 | 312 | Protected Guess.i = #False 313 | If (PatternPosition < 0) 314 | PatternPosition = 0 315 | Guess = #True 316 | EndIf 317 | 318 | Protected PatternEx.s = __RequesterEx_FormatPattern(Pattern) 319 | If (DefFile And Guess) 320 | PatternPosition = __RequesterEx_GuessPattern(PatternEx, DefFile, PatternPosition) 321 | EndIf 322 | 323 | __RequesterEx_PreparePathVar(DefaultFile) 324 | 325 | __RequesterEx_AddedExtension = #False 326 | Result = OpenFileRequester(Title, DefaultFile, PatternEx, PatternPosition, Bool(MultiSelect) * #PB_Requester_MultiSelection) 327 | __RequesterEx_FirstFile = Result 328 | If (Result) 329 | __RequesterEx_LastFolder = GetPathPart(Result) 330 | CompilerIf (#PB_Compiler_OS = #PB_OS_MacOS) 331 | __RequesterEx_SelectedPattern = PatternPosition 332 | CompilerElse 333 | __RequesterEx_SelectedPattern = SelectedFilePattern() 334 | CompilerEndIf 335 | EndIf 336 | ProcedureReturn (Result) 337 | EndProcedure 338 | 339 | Procedure.s SelectedFileList(Delimiter.s = #LF$) 340 | Protected Result.s 341 | If (__RequesterEx_FirstFile) 342 | Result = __RequesterEx_FirstFile 343 | Protected File.s = NextSelectedFileName() 344 | While (File) 345 | Result + Delimiter + File 346 | File = NextSelectedFileName() 347 | Wend 348 | EndIf 349 | ProcedureReturn (Result) 350 | EndProcedure 351 | 352 | 353 | 354 | 355 | 356 | ;- 357 | ;- Demo Program 358 | 359 | CompilerIf (#PB_Compiler_IsMainFile) 360 | DisableExplicit 361 | 362 | ; All parameters optional 363 | Debug OpenFileRequesterEx() 364 | 365 | ; Last selected path is remembered 366 | Debug OpenFileRequesterEx("Last Folder") 367 | 368 | ; Missing folders are corrected to their parent folder 369 | Debug OpenFileRequesterEx("Missing Folder", GetTemporaryDirectory() + "Missing_Folder/Not_Found/") 370 | 371 | ; Extensions are automatically appended to pattern names 372 | Debug OpenFileRequesterEx("Pattern Extensions", "", "Text Files|*.txt;*.doc|All Files|*.*") 373 | 374 | ; MultiSelect simply a #True/#False (or this macro), results returned in one delimited string 375 | MultiFileRequesterEx("MultiSelect") 376 | Debug SelectedFileList() 377 | 378 | ; Pattern guessed by default file extension 379 | Debug OpenFileRequesterEx("Guessed Pattern", GetHomeDirectory() + "test.png", "BMP|*.bmp|PNG|*.png|JPEG|*.jpg;*.jpeg") 380 | 381 | 382 | 383 | 384 | 385 | ; Save parameters optional too 386 | Debug SaveFileRequesterEx() 387 | 388 | ; Extension automatically appended 389 | Debug SaveFileRequesterEx("Auto Extension", GetTemporaryDirectory() + "tempFile", "JPEG|*.jpg;*.jpeg") 390 | 391 | ; Pattern also guessed by default file extension 392 | Debug SaveFileRequesterEx("Guessed Pattern", GetHomeDirectory() + "test.png", "BMP|*.bmp|PNG|*.png|JPEG|*.jpg;*.jpeg") 393 | 394 | 395 | 396 | 397 | ; PathRequesterEx params also optional, Mac bugs are corrected 398 | Debug PathRequesterEx() 399 | 400 | CompilerEndIf 401 | CompilerEndIf 402 | ;- 403 | -------------------------------------------------------------------------------- /RotateImage.pbi: -------------------------------------------------------------------------------- 1 | ; +-------------+ 2 | ; | RotateImage | 3 | ; +-------------+ 4 | ; | 2020-06-13 : Creation (PureBasic 5.72) 5 | 6 | ; RotateImage(SourceImage.i, QuarterTurnsCW.i, DestImage.i = #PB_Ignore) 7 | ; 8 | ; - Rotates an image by 90, 180, 270 (or 0) degrees 9 | ; - Specify rotation as 1, 2, 3 (or 0) quarter turns clockwise 10 | ; - Wraps negative or high-value turns to the 0-3 range 11 | ; - Uses API functions when possible, otherwise falls back to native code 12 | ; 13 | ; Options for DestImage: 14 | ; #PB_Ignore (default) or SourceImage number - rotate image and keep same number 15 | ; #PB_Any - rotated result is stored in a new returned image number 16 | ; - result is stored in the specified image number 17 | ; 18 | ; Special case / warning: 19 | ; You cannot pass in a dynamic #PB_Any-generated image number for DestImage 20 | ; UNLESS it matches SourceImage AND the original/rotated dimensions match. 21 | ; 22 | ; Disable API: 23 | ; Define #RotateImage_DisableAPI = #True before IncludeFile 24 | ; to disable the use of any API functions. 25 | 26 | 27 | ;- 28 | CompilerIf (Not Defined(_RotateImage_Included, #PB_Constant)) 29 | #_RotateImage_Included = #True 30 | 31 | CompilerIf (#PB_Compiler_IsMainFile) 32 | EnableExplicit 33 | CompilerEndIf 34 | 35 | CompilerIf (#PB_Ignore = #PB_Any) 36 | CompilerError #PB_Compiler_Filename + " assumes #PB_Ignore <> #PB_Any" 37 | CompilerEndIf 38 | 39 | 40 | 41 | 42 | ;- Constants (Public) 43 | 44 | CompilerIf (Not Defined(RotateImage_DisableAPI, #PB_Constant)) 45 | #RotateImage_DisableAPI = #False 46 | CompilerEndIf 47 | 48 | 49 | 50 | ;- 51 | ;- Constants (Private) 52 | 53 | #_RotateImage_PreventHighValueIDs = #True 54 | #_RotateImage_HighValueIDStart = 100000 55 | 56 | 57 | ;- 58 | ;- Procedures (Public) 59 | 60 | Procedure.i RotateImage(SourceImage.i, QuarterTurnsCW.i, DestImage.i = #PB_Ignore) 61 | Protected Result.i = #Null 62 | 63 | ; Normalize quarter turns (0-3) 64 | If (QuarterTurnsCW < 0) 65 | QuarterTurnsCW + ((3 - QuarterTurnsCW)/4) * 4 66 | Else 67 | QuarterTurnsCW = QuarterTurnsCW % 4 68 | EndIf 69 | 70 | ; Prepare for rotation 71 | Protected Width.i = ImageWidth(SourceImage) 72 | Protected Height.i = ImageHeight(SourceImage) 73 | Protected SameSize.i = Bool((Width = Height) Or (QuarterTurnsCW % 2 = 0)) 74 | Protected CopyBack.i = Bool((DestImage = #PB_Ignore) Or (DestImage = SourceImage)) 75 | If (CopyBack) 76 | DestImage = SourceImage 77 | EndIf 78 | 79 | CompilerIf (#_RotateImage_PreventHighValueIDs) 80 | If ((DestImage >= #_RotateImage_HighValueIDStart) And (DestImage <> #PB_Any)) 81 | If (CopyBack) 82 | If (Not SameSize) 83 | If (SourceImage >= #_RotateImage_HighValueIDStart) 84 | CompilerIf (#PB_Compiler_Debugger) 85 | DebuggerWarning(#PB_Compiler_Filename + ": You cannot rotate a non-square #PB_Any image in-place.") 86 | CompilerEndIf 87 | ProcedureReturn (#Null) 88 | EndIf 89 | EndIf 90 | Else 91 | CompilerIf (#PB_Compiler_Debugger) 92 | DebuggerWarning(#PB_Compiler_Filename + ": DestImage should be #PB_Any, #PB_Ignore, or a number below " + Str(#_RotateImage_HighValueIDStart) + ".") 93 | CompilerEndIf 94 | ProcedureReturn (#Null) 95 | EndIf 96 | EndIf 97 | CompilerEndIf 98 | 99 | If (QuarterTurnsCW = 0) 100 | ; No rotation 101 | If (CopyBack) 102 | Result = ImageID(SourceImage) 103 | Else 104 | Result = CopyImage(SourceImage, DestImage) 105 | EndIf 106 | Else 107 | Protected NewW.i, NewH.i 108 | If (QuarterTurnsCW % 2 = 1) 109 | NewW = Height 110 | NewH = Width 111 | Else 112 | NewW = Width 113 | NewH = Height 114 | EndIf 115 | Protected DrawImage.i 116 | Protected Valid.i = #False 117 | 118 | ;- - Windows API rotation 119 | CompilerIf ((#PB_Compiler_OS = #PB_OS_Windows) And (Not #RotateImage_DisableAPI)) 120 | Protected MaxSize.i = Width 121 | If (Height > Width) 122 | MaxSize = Height 123 | EndIf 124 | If (CopyBack And SameSize) 125 | DrawImage = SourceImage 126 | Valid = #True 127 | Else 128 | DrawImage = CreateImage(#PB_Any, MaxSize, MaxSize, ImageDepth(SourceImage)) 129 | If (DrawImage) 130 | Valid = #True 131 | EndIf 132 | EndIf 133 | 134 | If (Valid) 135 | Protected *DC = StartDrawing(ImageOutput(DrawImage)) 136 | If (*DC) 137 | Dim Pt.POINT(2) 138 | If (DrawImage <> SourceImage) 139 | DrawingMode(#PB_2DDrawing_AllChannels) 140 | DrawImage(ImageID(SourceImage), 0, 0) 141 | EndIf 142 | If (QuarterTurnsCW = 1) 143 | Pt(0)\x = Height 144 | Pt(1)\x = Height 145 | Pt(1)\y = Width 146 | PlgBlt_(*DC, @Pt(0), *DC, 0, 0, Width, Height, #Null, 0, 0) 147 | ElseIf (QuarterTurnsCW = 2) 148 | CompilerIf (#True) 149 | StretchBlt_(*DC, Width-1, Height-1, -Width, -Height, *DC, 0, 0, Width, Height, #SRCCOPY) 150 | CompilerElse 151 | Pt(0)\x = Width 152 | Pt(0)\y = Height 153 | Pt(1)\y = Height 154 | Pt(2)\x = Width 155 | ; PlgBlt_() at exactly 180 degrees does not give a pixel-perfect output 156 | PlgBlt_(*DC, @Pt(0), *DC, 0, 0, Width, Height, #Null, 0, 0) 157 | CompilerEndIf 158 | ElseIf (QuarterTurnsCW = 3) 159 | Pt(0)\y = Width 160 | Pt(2)\x = Height 161 | Pt(2)\y = Width 162 | PlgBlt_(*DC, @Pt(0), *DC, 0, 0, Width, Height, #Null, 0, 0) 163 | EndIf 164 | StopDrawing() 165 | 166 | If (CopyBack And SameSize) 167 | Result = ImageID(SourceImage) 168 | Else 169 | Result = GrabImage(DrawImage, DestImage, 0, 0, NewW, NewH) 170 | EndIf 171 | Dim Pt.POINT(0) 172 | EndIf 173 | 174 | If (Not (CopyBack And SameSize)) 175 | FreeImage(DrawImage) 176 | EndIf 177 | Valid = #False 178 | EndIf 179 | CompilerEndIf 180 | 181 | ;- - Software rotation 182 | If (Not Result) 183 | Dim Pixel.i(Width - 1, Height - 1) 184 | If (StartDrawing(ImageOutput(SourceImage))) 185 | DrawingMode(#PB_2DDrawing_AllChannels) 186 | Protected x.i, y.i 187 | For y = 0 To Height - 1 188 | For x = 0 To Width - 1 189 | Pixel(x, y) = Point(x, y) 190 | Next x 191 | Next y 192 | StopDrawing() 193 | 194 | If (CopyBack And SameSize) 195 | DrawImage = SourceImage 196 | Valid = #True 197 | ElseIf (CopyBack) 198 | DrawImage = CreateImage(#PB_Any, NewW, NewH, ImageDepth(SourceImage)) 199 | If (DrawImage) 200 | Valid = #True 201 | EndIf 202 | Else 203 | DrawImage = CreateImage(DestImage, NewW, NewH, ImageDepth(SourceImage)) 204 | If (DrawImage) 205 | If (DestImage <> #PB_Any) 206 | DrawImage = DestImage 207 | EndIf 208 | Valid = #True 209 | EndIf 210 | EndIf 211 | 212 | If (Valid) 213 | If (StartDrawing(ImageOutput(DrawImage))) 214 | DrawingMode(#PB_2DDrawing_AllChannels) 215 | If (QuarterTurnsCW = 1) 216 | For y = 0 To Height - 1 217 | For x = 0 To Width - 1 218 | Plot(Height - 1 - y, x, Pixel(x, y)) 219 | Next x 220 | Next y 221 | ElseIf (QuarterTurnsCW = 2) 222 | For y = 0 To Height - 1 223 | For x = 0 To Width - 1 224 | Plot(Width - 1 - x, Height - 1 - y, Pixel(x, y)) 225 | Next x 226 | Next y 227 | ElseIf (QuarterTurnsCW = 3) 228 | For y = 0 To Height - 1 229 | For x = 0 To Width - 1 230 | Plot(y, Width - 1 - x, Pixel(x, y)) 231 | Next x 232 | Next y 233 | EndIf 234 | StopDrawing() 235 | 236 | If (CopyBack And SameSize) 237 | Result = ImageID(SourceImage) 238 | ElseIf (CopyBack) 239 | Result = CopyImage(DrawImage, SourceImage) 240 | FreeImage(DrawImage) 241 | Else 242 | If (DestImage = #PB_Any) 243 | Result = DrawImage 244 | Else 245 | Result = ImageID(DestImage) 246 | EndIf 247 | EndIf 248 | EndIf 249 | EndIf 250 | EndIf 251 | Dim Pixel.i(0, 0) 252 | EndIf 253 | 254 | EndIf 255 | 256 | ProcedureReturn (Result) 257 | EndProcedure 258 | 259 | 260 | 261 | 262 | 263 | 264 | 265 | 266 | 267 | 268 | 269 | 270 | 271 | 272 | ;- 273 | ;- 274 | ;- Demo Program 275 | 276 | CompilerIf (#PB_Compiler_IsMainFile) 277 | DisableExplicit 278 | 279 | 280 | UsePNGImageDecoder() 281 | UseJPEGImageDecoder() 282 | 283 | UseMD5Fingerprint() 284 | 285 | 286 | 287 | Procedure.s ImageHash(Image.i) 288 | Protected Result.s 289 | If (StartDrawing(ImageOutput(Image))) 290 | Protected FP.i = StartFingerprint(#PB_Any, #PB_Cipher_MD5) 291 | If (FP) 292 | Protected x.i, y.i, Pixel.l 293 | For y = 0 To OutputHeight() - 1 294 | For x = 0 To OutputWidth() - 1 295 | Pixel = Point(x, y) 296 | AddFingerprintBuffer(FP, @Pixel, SizeOf(LONG)) 297 | Next x 298 | Next y 299 | Result = FinishFingerprint(FP) 300 | ;Debug Result 301 | EndIf 302 | StopDrawing() 303 | EndIf 304 | ProcedureReturn (Result) 305 | EndProcedure 306 | 307 | Dim KnownHash.s(3) 308 | 309 | For TestImage = 1 To 2 310 | 311 | Select (TestImage) 312 | Case 1 313 | InFile.s = #PB_Compiler_Home + "Examples/Sources/Data/PureBasicLogo.bmp" 314 | KnownHash(0) = "e642f9addc21d9000c63e87e0319e7a3" 315 | KnownHash(1) = "e61e52c03e4283576e12cc7970f5df1a" 316 | KnownHash(2) = "63fb1f9f7063239a1da16c7b9427ba80" 317 | KnownHash(3) = "33cf161ea39d206327cfc9e23398ebe2" 318 | Case 2 319 | InFile.s = #PB_Compiler_Home + "Examples/Sources/Data/world.png" 320 | KnownHash(0) = "5df93dac50c28a0cbcf39df780180883" 321 | KnownHash(1) = "be4c701e4e01973e653822de12aedc60" 322 | KnownHash(2) = "c3e282d2983703e2b114d2f97ad65bca" 323 | KnownHash(3) = "43695f6be1e4b417d829cb1402f9460c" 324 | EndSelect 325 | 326 | Debug "Test Image #" + Str(TestImage) + " (" + GetFilePart(InFile) + ")" 327 | 328 | If (Not LoadImage(0, InFile)) 329 | Debug "Could not load test image: " + InFile 330 | End 331 | EndIf 332 | Debug Str(ImageWidth(0)) + " x " + Str(ImageHeight(0)) 333 | Debug "" 334 | 335 | 336 | 337 | 338 | 339 | 340 | ; Test 1 - Rotate Image 0 to another Image number 341 | For i = 0 To 3 342 | If (RotateImage(0, i, 1)) 343 | ;SaveImage(1, GetTemporaryDirectory() + Str(i) + ".bmp") 344 | If (ImageHash(1) = KnownHash(i)) 345 | Debug "OK" 346 | Else 347 | Debug "Hash check failed!" 348 | EndIf 349 | Else 350 | Debug "Failed to rotate!" 351 | EndIf 352 | Next i 353 | Debug "" 354 | 355 | 356 | ; Test 2 - Rotate Image 0 to a dynamic #PB_Any 357 | For i = 0 To 3 358 | NewImg.i = RotateImage(0, i, #PB_Any) 359 | If (NewImg) 360 | If (ImageHash(NewImg) = KnownHash(i)) 361 | Debug "OK" 362 | Else 363 | Debug "Hash check failed!" 364 | EndIf 365 | FreeImage(NewImg) 366 | Else 367 | Debug "Failed to rotate!" 368 | EndIf 369 | Next i 370 | Debug "" 371 | 372 | 373 | ; Test 3 - Rotate Image 0 in place, 90 degrees at a time 374 | For i = 0 To 3 375 | If (RotateImage(0, 1)) 376 | If (ImageHash(0) = KnownHash((i+1) % 4)) 377 | Debug "OK" 378 | Else 379 | Debug "Hash check failed!" 380 | EndIf 381 | Else 382 | Debug "Failed to rotate!" 383 | EndIf 384 | Next i 385 | Debug "" 386 | 387 | Next TestImage 388 | 389 | 390 | CompilerEndIf 391 | CompilerEndIf 392 | ;- 393 | -------------------------------------------------------------------------------- /ScanFolder.pbi: -------------------------------------------------------------------------------- 1 | ; +----------------+ 2 | ; | ScanFolder.pbi | 3 | ; +----------------+ 4 | ; | 2015.06.18 . Creation (PureBasic 5.31) 5 | ; | .19 . Added extension filter, FinishScan, #PB_Defaults, sort 6 | ; | .07.10 . Added optional RecurseDepth limit, 7 | ; | changed Relative flag to Absolute (Relative default), 8 | ; | added relative path Regex-matching (must be enabled) 9 | ; | .08.27 . Use FileSize instead of DirectoryEntryType (for symlinks) 10 | ; | .30 . Added ResetScanEntry, fixed ".." folder ignore 11 | ; | 2017.05.20 . Cleanup, added warning if RegexSupport is missing 12 | ; | 2020-06-19 . Don't warn about RegEx being disabled if not trying to use it! 13 | ; | 2021-11-04 . Added ScanFolderToList() 14 | 15 | 16 | CompilerIf (Not Defined(__ScanFolder_Included, #PB_Constant)) 17 | #__ScanFolder_Included = #True 18 | 19 | CompilerIf (#PB_Compiler_IsMainFile) 20 | EnableExplicit 21 | CompilerEndIf 22 | 23 | #ScanFolder_IncludeVersion = 20200619 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | ;- 32 | ;- Compile Switches (Public) 33 | 34 | 35 | CompilerIf (Not Defined(ScanFolder_RegexSupport, #PB_Constant)) 36 | #ScanFolder_RegexSupport = #PB_Compiler_IsMainFile 37 | CompilerEndIf 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | ;- 46 | ;- Constants (Public) 47 | 48 | Enumeration ; ScanFolder Flags 49 | #ScanFolder_Recursive = $0001 ; Scan sub-folders too 50 | #ScanFolder_Absolute = $0002 ; Return absolute paths, not relative 51 | #ScanFolder_Folders = $0004 ; Include folders in results 52 | #ScanFolder_NoFiles = $0008 ; Exclude files from results 53 | #ScanFolder_NoHidden = $0010 ; Exclude hidden files/folders 54 | ; 55 | #ScanFolder_DefaultFlags = $0000 56 | EndEnumeration 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | ;- 65 | ;- Constants (Private) 66 | 67 | Enumeration ; ScanFolder Flags 68 | #_ScanFolder_Filter = $00010000 69 | EndEnumeration 70 | 71 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 72 | #_ScanFolder_PS$ = "\" 73 | #_ScanFolder_NPS$ = "/" 74 | CompilerElse 75 | #_ScanFolder_PS$ = "/" 76 | #_ScanFolder_NPS$ = "\" 77 | CompilerEndIf 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | ;- 89 | ;- Structures (Private) 90 | 91 | Structure _SCANFOLDER 92 | Flags.i 93 | Extensions.s 94 | Count.i 95 | Depth.i 96 | Regex.i 97 | List Result.s() 98 | EndStructure 99 | 100 | 101 | 102 | 103 | 104 | ;- 105 | ;- Variables (Private) 106 | 107 | Global _ScanFolder_LastSF.i = #Null 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | ;- 119 | ;- Macros (Private) 120 | 121 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 122 | 123 | Macro _ScanFolder_IsHidden(Root, Relative, Name) 124 | Bool(GetFileAttributes(Root + Relative + Name) & #PB_FileSystem_Hidden) 125 | EndMacro 126 | 127 | CompilerElse 128 | 129 | Macro _ScanFolder_IsHidden(Root, Relative, Name) 130 | Bool(Left(Name, 1) = ".") 131 | EndMacro 132 | 133 | CompilerEndIf 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | ;- 145 | ;- Procedures (Private) 146 | 147 | Procedure.i _ScanFolder_Examine(*SF._SCANFOLDER, Root.s, Relative.s, SubLevel.i) 148 | Protected Result.i = #False 149 | Protected Name.s 150 | If (*SF) 151 | Protected Dir.i = ExamineDirectory(#PB_Any, Root + Relative, "") 152 | If (Dir) 153 | Protected NewList Folder.s() 154 | Protected NewList File.s() 155 | While (NextDirectoryEntry(Dir)) 156 | Name = DirectoryEntryName(Dir) 157 | If ((Not (*SF\Flags & #ScanFolder_NoHidden)) Or (Not _ScanFolder_IsHidden(Root, Relative, Name))) 158 | If ((Name = ".") Or (Name = "..")) 159 | ; do nothing 160 | ElseIf (FileSize(Root + Relative + Name) = -2) 161 | AddElement(Folder()) 162 | Folder() = Name 163 | Else 164 | AddElement(File()) 165 | File() = Name 166 | EndIf 167 | EndIf 168 | Wend 169 | FinishDirectory(Dir) 170 | If (*SF\Flags & #ScanFolder_Recursive) 171 | If (#True) 172 | SortList(Folder(), #PB_Sort_Ascending | #PB_Sort_NoCase) 173 | EndIf 174 | ForEach (Folder()) 175 | If (*SF\Flags & #ScanFolder_Folders) 176 | AddElement(*SF\Result()) 177 | *SF\Result() = Relative + Folder() + #_ScanFolder_PS$ 178 | EndIf 179 | If ((*SF\Depth = 0) Or (SubLevel < *SF\Depth)) 180 | _ScanFolder_Examine(*SF, Root, Relative + Folder() + #_ScanFolder_PS$, SubLevel + 1) 181 | EndIf 182 | Next 183 | ElseIf (*SF\Flags & #ScanFolder_Folders) 184 | If (#True) 185 | SortList(Folder(), #PB_Sort_Ascending | #PB_Sort_NoCase) 186 | EndIf 187 | ForEach (Folder()) 188 | AddElement(*SF\Result()) 189 | *SF\Result() = Relative + Folder() + #_ScanFolder_PS$ 190 | Next 191 | EndIf 192 | If (Not (*SF\Flags & #ScanFolder_NoFiles)) 193 | If (#True) 194 | SortList(File(), #PB_Sort_Ascending | #PB_Sort_NoCase) 195 | EndIf 196 | Protected Add.i 197 | Protected Ext.s 198 | ForEach (File()) 199 | Add = #True 200 | If (*SF\Flags & #_ScanFolder_Filter) 201 | Ext = GetExtensionPart(File()) 202 | If (Ext) 203 | If (Not FindString(*SF\Extensions, ";" + LCase(Ext) + ";")) 204 | Add = #False 205 | EndIf 206 | Else 207 | Add = #False 208 | EndIf 209 | EndIf 210 | CompilerIf (#ScanFolder_RegexSupport) 211 | If (Add And *SF\Regex) 212 | If (Not MatchRegularExpression(*SF\Regex, ReplaceString(Relative, "\", "/") + File())) 213 | Add = #False 214 | EndIf 215 | EndIf 216 | CompilerEndIf 217 | If (Add) 218 | AddElement(*SF\Result()) 219 | *SF\Result() = Relative + File() 220 | EndIf 221 | Next 222 | EndIf 223 | Result = #True 224 | EndIf 225 | EndIf 226 | ProcedureReturn (Result) 227 | EndProcedure 228 | 229 | Procedure.s _ScanFolder_FormatExtensions(Extensions.s) 230 | Protected Result.s 231 | 232 | Protected *C.CHARACTER = @Extensions 233 | While (*C\c) 234 | Select (*C\c) 235 | Case ';', '|', ',', '*', '.' 236 | *C\c = ' ' 237 | Default 238 | ; 239 | EndSelect 240 | *C + SizeOf(CHARACTER) 241 | Wend 242 | Extensions = Trim(Extensions) 243 | 244 | If (Extensions) 245 | Extensions = LCase(Extensions) 246 | Protected n.i = CountString(Extensions, " ") + 1 247 | Protected i.i 248 | Protected Term.s 249 | For i = 1 To n 250 | Term = StringField(Extensions, i, " ") 251 | If (Term) 252 | Result + ";" + Term 253 | EndIf 254 | Next i 255 | If (Result) 256 | Result + ";" 257 | EndIf 258 | EndIf 259 | 260 | ProcedureReturn (Result) 261 | EndProcedure 262 | 263 | 264 | 265 | 266 | 267 | 268 | 269 | 270 | 271 | 272 | 273 | 274 | 275 | 276 | 277 | 278 | 279 | 280 | 281 | ;- 282 | ;- Procedures (Public) 283 | 284 | Procedure.i FinishScan(*ScanFolder._SCANFOLDER = #PB_Default) 285 | If (*ScanFolder = #PB_Default) 286 | *ScanFolder = _ScanFolder_LastSF 287 | EndIf 288 | If (*ScanFolder) 289 | CompilerIf (#ScanFolder_RegexSupport) 290 | If (*ScanFolder\Regex) 291 | FreeRegularExpression(*ScanFolder\Regex) 292 | EndIf 293 | CompilerEndIf 294 | ClearList(*ScanFolder\Result()) 295 | ClearStructure(*ScanFolder, _SCANFOLDER) 296 | FreeMemory(*ScanFolder) 297 | If (_ScanFolder_LastSF = *ScanFolder) 298 | _ScanFolder_LastSF = #Null 299 | EndIf 300 | EndIf 301 | ProcedureReturn (#Null) 302 | EndProcedure 303 | 304 | Procedure.i ScanFolder(Folder.s, Flags.i = #Null, Extensions.s = "", RecurseDepth.i = 0, RegexPattern.s = "") 305 | Protected *SF._SCANFOLDER = #Null 306 | If (Folder) 307 | Protected Regex.i = #Null 308 | CompilerIf (#ScanFolder_RegexSupport) 309 | If (RegexPattern) 310 | RegexPattern = ReplaceString(RegexPattern, "\\", "/") 311 | CompilerIf (#True) 312 | If (Left(RegexPattern, 1) <> "^") 313 | RegexPattern = "^" + RegexPattern 314 | EndIf 315 | If (Right(RegexPattern, 1) <> "$") 316 | RegexPattern = RegexPattern + "$" 317 | EndIf 318 | CompilerEndIf 319 | Regex = CreateRegularExpression(#PB_Any, RegexPattern, #PB_RegularExpression_NoCase) 320 | EndIf 321 | CompilerElseIf (#PB_Compiler_Debugger) 322 | If (RegexPattern) 323 | Debug #PB_Compiler_Filename + " : Please define #ScanFolder_RegexSupport as #True before IncludeFile" 324 | EndIf 325 | CompilerEndIf 326 | If (Regex Or (RegexPattern = "")) 327 | *SF = AllocateMemory(SizeOf(_SCANFOLDER)) 328 | If (*SF) 329 | InitializeStructure(*SF, _SCANFOLDER) 330 | ReplaceString(Folder, #_ScanFolder_NPS$, #_ScanFolder_PS$, #PB_String_InPlace) 331 | Folder = RTrim(Folder, #_ScanFolder_PS$) + #_ScanFolder_PS$ 332 | If (Flags = #PB_Default) 333 | Flags = #ScanFolder_DefaultFlags 334 | EndIf 335 | If (Flags & #ScanFolder_NoFiles) 336 | Flags | #ScanFolder_Folders 337 | EndIf 338 | If (RecurseDepth > 0) 339 | Flags | #ScanFolder_Recursive 340 | ElseIf (RecurseDepth < 0) 341 | Flags | #ScanFolder_Recursive 342 | RecurseDepth = 0 343 | EndIf 344 | *SF\Extensions = _ScanFolder_FormatExtensions(Extensions) 345 | If (*SF\Extensions) 346 | Flags | #_ScanFolder_Filter 347 | EndIf 348 | *SF\Flags = Flags 349 | *SF\Depth = RecurseDepth 350 | *SF\Regex = Regex 351 | If (_ScanFolder_Examine(*SF, Folder, "", 0)) 352 | If (Flags & #ScanFolder_Absolute) 353 | ForEach (*SF\Result()) 354 | *SF\Result() = Folder + *SF\Result() 355 | Next 356 | EndIf 357 | ResetList(*SF\Result()) 358 | _ScanFolder_LastSF = *SF 359 | Else 360 | *SF = FinishScan(*SF) 361 | EndIf 362 | Else 363 | CompilerIf (#ScanFolder_RegexSupport) 364 | If (Regex) 365 | FreeRegularExpression(Regex) 366 | EndIf 367 | CompilerEndIf 368 | EndIf 369 | EndIf 370 | EndIf 371 | ProcedureReturn (*SF) 372 | EndProcedure 373 | 374 | Procedure.i ScanEntryCount(*ScanFolder._SCANFOLDER = #PB_Default) 375 | Protected Result.i = -1 376 | If (*ScanFolder = #PB_Default) 377 | *ScanFolder = _ScanFolder_LastSF 378 | EndIf 379 | If (*ScanFolder) 380 | Result = ListSize(*ScanFolder\Result()) 381 | EndIf 382 | ProcedureReturn (Result) 383 | EndProcedure 384 | 385 | Procedure.i ResetScanEntry(*ScanFolder._SCANFOLDER = #PB_Default) 386 | Protected Result.i = #False 387 | If (*ScanFolder = #PB_Default) 388 | *ScanFolder = _ScanFolder_LastSF 389 | EndIf 390 | If (*ScanFolder) 391 | ResetList(*ScanFolder\Result()) 392 | Result = #True 393 | EndIf 394 | ProcedureReturn (Result) 395 | EndProcedure 396 | 397 | Procedure.i NextScanEntry(*ScanFolder._SCANFOLDER = #PB_Default) 398 | Protected Result.i = #False 399 | If (*ScanFolder = #PB_Default) 400 | *ScanFolder = _ScanFolder_LastSF 401 | EndIf 402 | If (*ScanFolder) 403 | Result = Bool(NextElement(*ScanFolder\Result())) 404 | EndIf 405 | ProcedureReturn (Result) 406 | EndProcedure 407 | 408 | Procedure.s ScanEntryPath(*ScanFolder._SCANFOLDER = #PB_Default) 409 | Protected Result.s = "" 410 | If (*ScanFolder = #PB_Default) 411 | *ScanFolder = _ScanFolder_LastSF 412 | EndIf 413 | If (*ScanFolder) 414 | If (ListIndex(*ScanFolder\Result()) >= 0) 415 | Result = *ScanFolder\Result() 416 | EndIf 417 | EndIf 418 | ProcedureReturn (Result) 419 | EndProcedure 420 | 421 | Procedure.i ScanFolderToList(Folder.s, List StringList.s(), Flags.i = #Null, Extensions.s = "", RecurseDepth.i = 0, RegexPattern.s = "") 422 | Protected Result.i = ScanFolder(Folder, Flags, Extensions, RecurseDepth, RegexPattern) 423 | ClearList(StringList()) 424 | If (Result) 425 | While (NextScanEntry(Result)) 426 | AddElement(StringList()) 427 | StringList() = ScanEntryPath(Result) 428 | Wend 429 | FinishScan(Result) 430 | EndIf 431 | ProcedureReturn (Result) 432 | EndProcedure 433 | 434 | 435 | 436 | 437 | 438 | 439 | 440 | 441 | 442 | 443 | 444 | 445 | 446 | 447 | 448 | 449 | 450 | ;- 451 | ;- Demo Program 452 | 453 | CompilerIf (#PB_Compiler_IsMainFile) 454 | DisableExplicit 455 | 456 | ; Simple example: list files in temp directory 457 | If ScanFolder(GetTemporaryDirectory()) 458 | Debug "Files in Temporary directory:" 459 | Debug "-----------------------------" 460 | While NextScanEntry() 461 | Debug ScanEntryPath() 462 | Wend 463 | Debug "" 464 | FinishScan() 465 | EndIf 466 | 467 | ; List folders in home directory (two levels deep) 468 | If ScanFolder(GetHomeDirectory(), #ScanFolder_NoFiles, "", 1) 469 | Debug "Folders (two levels) in Home directory:" 470 | Debug "-----------------------------" 471 | While NextScanEntry() 472 | Debug ScanEntryPath() 473 | Wend 474 | Debug "" 475 | FinishScan() 476 | EndIf 477 | 478 | ; Text files, excluding hidden, absolute paths 479 | If ScanFolder(GetHomeDirectory(), #ScanFolder_Absolute | #ScanFolder_NoHidden | #ScanFolder_Recursive, "*.txt") 480 | ;If ScanFolder(GetHomeDirectory(), #ScanFolder_Absolute | #ScanFolder_NoHidden | #ScanFolder_Recursive, "", 0, ".*\.txt") 481 | Debug "Text files in Home directory:" 482 | Debug "-----------------------------" 483 | While NextScanEntry() 484 | Debug ScanEntryPath() 485 | Wend 486 | FinishScan() 487 | EndIf 488 | 489 | CompilerEndIf 490 | CompilerEndIf 491 | ;- 492 | -------------------------------------------------------------------------------- /SendKeys_Win.pbi: -------------------------------------------------------------------------------- 1 | ; +------------------+ 2 | ; | SendKeys_Win.pbi | 3 | ; +------------------+ 4 | ; | 2016.09.13 . Creation 5 | ; | 2017.05.05 . Multiple-include safe, demo cleanup 6 | 7 | ;- 8 | CompilerIf (Not Defined(__SendKeys_Win_Included, #PB_Constant)) 9 | #__SendKeys_Win_Included = #True 10 | 11 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 12 | 13 | ; You can define #SendKeys_Method to change the key press/release method 14 | ;#SendKeys_Method = 1 15 | CompilerIf (Not Defined(SendKeys_Method, #PB_Constant)) 16 | ; 0 = use SendInput 17 | ; 1 = use kbdevent 18 | ; 2 = use WM_KEYDOWN 19 | #SendKeys_Method = 0 20 | CompilerEndIf 21 | 22 | 23 | 24 | 25 | 26 | ;- Functions (Private) 27 | 28 | Procedure _PressKey_SendInput(VK.i) 29 | Protected SI.INPUT 30 | SI\type = #INPUT_KEYBOARD 31 | With SI\ki 32 | \wVk = VK 33 | \wScan = #Null 34 | \dwFlags = #Null 35 | \time = 0 36 | \dwExtraInfo = #Null 37 | EndWith 38 | SendInput_(1, @SI, SizeOf(INPUT)) 39 | EndProcedure 40 | Procedure _ReleaseKey_SendInput(VK.i) 41 | Protected SI.INPUT 42 | SI\type = #INPUT_KEYBOARD 43 | With SI\ki 44 | \wVk = VK 45 | \wScan = #Null 46 | \dwFlags = #KEYEVENTF_KEYUP 47 | \time = 0 48 | \dwExtraInfo = #Null 49 | EndWith 50 | SendInput_(1, @SI, SizeOf(INPUT)) 51 | EndProcedure 52 | 53 | Procedure _PressKey_keybdevent(VK.i) 54 | keybd_event_(VK, #Null, #Null, #Null) 55 | EndProcedure 56 | Procedure _ReleaseKey_keybdevent(VK.i) 57 | keybd_event_(VK, #Null, #KEYEVENTF_KEYUP, #Null) 58 | EndProcedure 59 | 60 | ; WM_KEY method does not seem to work outside of owner process! 61 | 62 | Procedure _PressKey_WMKEY(VK.i) 63 | PostMessage_(GetFocus_(), #WM_KEYDOWN, VK, $00000000) 64 | EndProcedure 65 | Procedure _ReleaseKey_WMKEY(VK.i) 66 | PostMessage_(GetFocus_(), #WM_KEYUP, VK, $C0000001) 67 | EndProcedure 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | ;- 76 | ;- Functions (Public) 77 | 78 | CompilerSelect (#SendKeys_Method) 79 | CompilerCase (1) 80 | Macro PressKey(VK) 81 | _PressKey_keybdevent(VK) 82 | EndMacro 83 | Macro ReleaseKey(VK) 84 | _ReleaseKey_keybdevent(VK) 85 | EndMacro 86 | CompilerCase (2) 87 | Macro PressKey(VK) 88 | _PressKey_WMKEY(VK) 89 | EndMacro 90 | Macro ReleaseKey(VK) 91 | _ReleaseKey_WMKEY(VK) 92 | EndMacro 93 | CompilerDefault 94 | Macro PressKey(VK) 95 | _PressKey_SendInput(VK) 96 | EndMacro 97 | Macro ReleaseKey(VK) 98 | _ReleaseKey_SendInput(VK) 99 | EndMacro 100 | CompilerEndSelect 101 | 102 | Procedure TapKey(VK.i, msDelay.i = 25) 103 | PressKey(VK) 104 | Delay(msDelay) 105 | ReleaseKey(VK) 106 | Delay(msDelay) 107 | EndProcedure 108 | 109 | CompilerEndIf 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | ;- 119 | ;- Demo Program 120 | 121 | CompilerIf (#PB_Compiler_IsMainFile) 122 | 123 | OpenWindow(0, 0, 0, 640, 30, "SendKeys_Win", #PB_Window_ScreenCentered | #PB_Window_SystemMenu) 124 | EditorGadget(0, 0, 0, 640, 30) 125 | AddWindowTimer(0, 0, 500) 126 | SetActiveGadget(0) 127 | ;Debug "Method " + Str(#SendKeys_Method) 128 | 129 | Repeat 130 | Event = WaitWindowEvent(500) 131 | If (Event = #PB_Event_Timer) 132 | TapKey(Random('Z', 'A')) 133 | EndIf 134 | Until (Event = #PB_Event_CloseWindow) 135 | 136 | CompilerEndIf 137 | CompilerEndIf 138 | ;- -------------------------------------------------------------------------------- /Winamp.pbi: -------------------------------------------------------------------------------- 1 | ; +------------+ 2 | ; | Winamp.pbi | 3 | ; +------------+ 4 | ; | 2015.04.14 . Creation (PureBasic 5.31) 5 | ; | 2017.02.01 . Made multiple-include safe 6 | 7 | CompilerIf (Not Defined(__Winamp_Included, #PB_Constant)) 8 | #__Winamp_Included = #True 9 | 10 | CompilerIf (#PB_Compiler_IsMainFile) 11 | EnableExplicit 12 | CompilerEndIf 13 | 14 | ;- 15 | ;- Constants 16 | 17 | #Winamp_Status_Stopped = 0 18 | #Winamp_Status_Playing = 1 19 | #Winamp_Status_Paused = 2 20 | 21 | Enumeration ; WM_COMMAND 22 | #Winamp_Command_PreviousTrack = 40044 23 | #Winamp_Command_NextTrack = 40048 24 | #Winamp_Command_Play = 40045 25 | #Winamp_Command_PauseResume = 40046 26 | #Winamp_Command_Stop = 40047 27 | #Winamp_Command_StopFadeout = 40147 28 | #Winamp_Command_StopAfterCurrent = 40157 29 | #Winamp_Command_Forward5Seconds = 40148 30 | #Winamp_Command_Rewind5Seconds = 40144 31 | #Winamp_Command_StartOfPlaylist = 40154 32 | ; ... 33 | #Winamp_Command_ToggleRepeat = 40022 34 | #Winamp_Command_ToggleShuffle = 40023 35 | ; ... 36 | EndEnumeration 37 | 38 | Enumeration ; WM_USER 39 | ; ... 40 | #Winamp_User_PlayTrack = 100 41 | #Winamp_User_ClearPlaylist = 101 42 | #Winamp_User_BeginTrack = 102 43 | ; ... 44 | #Winamp_User_GetStatus = 104 45 | ; ... 46 | #Winamp_User_GetShuffle = 250 47 | #Winamp_User_GetRepeat = 251 48 | #Winamp_User_SetShuffle = 252 49 | #Winamp_User_SetRepeat = 253 50 | EndEnumeration 51 | 52 | 53 | 54 | ;- 55 | ;- Variables 56 | 57 | Global _hwndWinamp.i = #Null 58 | 59 | 60 | 61 | 62 | ;- 63 | ;- Macros (Private) 64 | 65 | Macro _Winamp_Command(Command) 66 | SendMessage_(_hwndWinamp, #WM_COMMAND, (Command), #Null) 67 | EndMacro 68 | 69 | Macro _Winamp_User(ID, UserData = #Null) 70 | SendMessage_(_hwndWinamp, #WM_USER, (UserData), (ID)) 71 | EndMacro 72 | 73 | 74 | 75 | 76 | 77 | 78 | ;- 79 | ;- Macros (Public) 80 | 81 | Macro Winamp_Play() 82 | _Winamp_Command(#Winamp_Command_Play) 83 | EndMacro 84 | 85 | Macro Winamp_Stop() 86 | _Winamp_Command(#Winamp_Command_Stop) 87 | EndMacro 88 | 89 | Macro Winamp_PlayTrack() 90 | _Winamp_User(#Winamp_User_PlayTrack) 91 | EndMacro 92 | 93 | Macro Winamp_BeginTrack() 94 | _Winamp_User(#Winamp_User_BeginTrack) 95 | EndMacro 96 | 97 | Macro Winamp_GetStatus() 98 | _Winamp_User(#Winamp_User_GetStatus) 99 | EndMacro 100 | 101 | Macro Winamp_GetShuffle() 102 | _Winamp_User(#Winamp_User_GetShuffle) 103 | EndMacro 104 | 105 | Macro Winamp_GetRepeat() 106 | _Winamp_User(#Winamp_User_GetRepeat) 107 | EndMacro 108 | 109 | Macro Winamp_ToggleRepeat() 110 | _Winamp_Command(#Winamp_Command_ToggleRepeat) 111 | EndMacro 112 | 113 | Macro Winamp_SetShuffle(State) 114 | _Winamp_User(#Winamp_User_SetShuffle, Bool(State)) 115 | EndMacro 116 | 117 | Macro Winamp_SetRepeat(State) 118 | _Winamp_User(#Winamp_User_SetRepeat, Bool(State)) 119 | EndMacro 120 | 121 | Macro Winamp_ToggleShuffle() 122 | _Winamp_Command(#Winamp_Command_ToggleShuffle) 123 | EndMacro 124 | 125 | Macro Winamp_IsPlaying() 126 | Bool(Winamp_GetStatus() = #Winamp_Status_Playing) 127 | EndMacro 128 | 129 | Macro Winamp_IsPaused() 130 | Bool(Winamp_GetStatus() = #Winamp_Status_Paused) 131 | EndMacro 132 | 133 | Macro Winamp_IsStopped() 134 | Bool(Winamp_GetStatus() = #Winamp_Status_Stopped) 135 | EndMacro 136 | 137 | 138 | 139 | 140 | 141 | ;- 142 | ;- Procedures 143 | 144 | Procedure.i Winamp_Init() 145 | _hwndWinamp = FindWindow_("Winamp v1.x", #Null) 146 | ProcedureReturn (_hwndWinamp) 147 | EndProcedure 148 | 149 | Procedure.i Winamp_IsClosed() 150 | If (_hwndWinamp) 151 | If (IsWindow_(_hwndWinamp)) 152 | ProcedureReturn (#False) 153 | Else 154 | _hwndWinamp = #Null 155 | ProcedureReturn (#True) 156 | EndIf 157 | Else 158 | ProcedureReturn (#True) 159 | EndIf 160 | EndProcedure 161 | 162 | 163 | CompilerEndIf 164 | ;- -------------------------------------------------------------------------------- /WindowFromGadget.pbi: -------------------------------------------------------------------------------- 1 | ; +------------------+ 2 | ; | WindowFromGadget | 3 | ; +------------------+ 4 | ; | 2019-11-05 : Creation (PureBasic 5.70) 5 | 6 | ; TODO 7 | ; implement GetWindowFromGadget on non-Windows 8 | 9 | ;- 10 | CompilerIf (Not Defined(_WindowFromGadget_Included, #PB_Constant)) 11 | #_WindowFromGadget_Included = #True 12 | 13 | CompilerIf (#PB_Compiler_IsMainFile) 14 | EnableExplicit 15 | CompilerEndIf 16 | 17 | ;- Imports 18 | 19 | CompilerIf (Not Defined(PB_Object_EnumerateStart, #PB_Procedure)) 20 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 21 | Import "" 22 | PB_Object_EnumerateStart(Object.i) 23 | PB_Object_EnumerateNext(Object.i, *ID.Integer) 24 | PB_Object_EnumerateAbort(Object.i) 25 | PB_Object_Count(Objects.i) 26 | PB_Window_Objects.i 27 | EndImport 28 | CompilerElse 29 | ImportC "" 30 | PB_Object_EnumerateStart(Object.i) 31 | PB_Object_EnumerateNext(Object.i, *ID.Integer) 32 | PB_Object_EnumerateAbort(Object.i) 33 | PB_Object_Count(Objects.i) 34 | PB_Window_Objects.i 35 | EndImport 36 | CompilerEndIf 37 | CompilerEndIf 38 | 39 | 40 | ;- 41 | ;- Procedures 42 | 43 | Procedure.i GetWindowFromID(WindowID.i) 44 | Protected Result.i = -1 45 | If (WindowID) 46 | PB_Object_EnumerateStart(PB_Window_Objects) 47 | If (PB_Window_Objects) 48 | Protected Window.i 49 | While (PB_Object_EnumerateNext(PB_Window_Objects, @Window)) 50 | If (WindowID(Window) = WindowID) 51 | Result = Window 52 | Break 53 | EndIf 54 | Wend 55 | PB_Object_EnumerateAbort(PB_Window_Objects) 56 | EndIf 57 | EndIf 58 | ProcedureReturn (Result) 59 | EndProcedure 60 | 61 | Procedure.i GetWindowFromGadget(Gadget.i) 62 | Protected Result.i = -1 63 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 64 | Result = GetWindowFromID(GetAncestor_(GadgetID(Gadget), #GA_ROOT)) 65 | CompilerElse 66 | ;? implement! 67 | CompilerEndIf 68 | ProcedureReturn (Result) 69 | EndProcedure 70 | 71 | Procedure.i GetBuildWindow() 72 | ProcedureReturn (GetWindowFromID(UseGadgetList(0))) 73 | EndProcedure 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | ;- 83 | ;- 84 | ;- Demo Program 85 | CompilerIf (#PB_Compiler_IsMainFile) 86 | DisableExplicit 87 | 88 | OpenWindow(5, 0, 0, 320, 240, "", #PB_Window_Invisible) 89 | Debug GetBuildWindow() 90 | Debug GetWindowFromID(WindowID(5)) 91 | 92 | ContainerGadget(1, 0, 0, 320, 240) 93 | TextGadget(2, 0, 0, 320, 240, "") 94 | CloseGadgetList() 95 | Debug GetWindowFromGadget(2) 96 | 97 | CompilerEndIf 98 | CompilerEndIf 99 | ;- -------------------------------------------------------------------------------- /XML_Helper.pbi: -------------------------------------------------------------------------------- 1 | ; +----------------+ 2 | ; | XML_Helper.pbi | 3 | ; +----------------+ 4 | ; | 2016.05.26 . Creation (PureBasic 5.42) 5 | ; | .06.01 . Added DeleteXMLChildren() 6 | ; | 2017.04.24 . Cleanup 7 | 8 | CompilerIf (Not Defined(__XML_Helper_Included, #PB_Constant)) 9 | #__XML_Helper_Included = #True 10 | 11 | CompilerIf (#PB_Compiler_IsMainFile) 12 | EnableExplicit 13 | CompilerEndIf 14 | 15 | 16 | ;- 17 | ;- Macros 18 | 19 | Macro MainXMLNodeName(_XML) 20 | GetXMLNodeNameSafe(MainXMLNode(_XML)) 21 | EndMacro 22 | 23 | 24 | 25 | 26 | ;- 27 | ;- Constants 28 | 29 | #XML_Normal = #PB_XML_Normal 30 | #XML_Comment = #PB_XML_Comment 31 | #XML_Root = #PB_XML_Root 32 | #XML_Default = #PB_Default 33 | 34 | 35 | 36 | 37 | 38 | ;- 39 | ;- Macros 40 | 41 | Macro IsNormalXMLNode(_Node) 42 | Bool(XMLNodeType(_Node) = #XML_Normal) 43 | EndMacro 44 | 45 | Macro RemoveXMLComments(_Node, _Recursive = #True) 46 | DeleteXMLChildren((_Node), "", #XML_Comment, (_Recursive)) 47 | EndMacro 48 | 49 | Macro RemoveXMLMetadata(_Node, _Recursive = #True) 50 | DeleteXMLChildren((_Node), "", #PB_XML_CData, (_Recursive)) 51 | DeleteXMLChildren((_Node), "", #PB_XML_DTD, (_Recursive)) 52 | DeleteXMLChildren((_Node), "", #PB_XML_Instruction, (_Recursive)) 53 | EndMacro 54 | 55 | 56 | 57 | 58 | 59 | 60 | ;- 61 | ;- Procedures 62 | 63 | Procedure.s GetXMLNodeNameSafe(*Node) 64 | If (*Node And IsNormalXMLNode(*Node)) 65 | ProcedureReturn (GetXMLNodeName(*Node)) 66 | EndIf 67 | ProcedureReturn ("") 68 | EndProcedure 69 | 70 | Procedure.i HasXMLAttribute(*Node, Attribute.s) 71 | Protected Result.i = #False 72 | If (*Node And IsNormalXMLNode(*Node) And Attribute) 73 | If (ExamineXMLAttributes(*Node)) 74 | While (NextXMLAttribute(*Node)) 75 | If (XMLAttributeName(*Node) = Attribute) 76 | Result = #True 77 | Break 78 | EndIf 79 | Wend 80 | EndIf 81 | EndIf 82 | ProcedureReturn (Result) 83 | EndProcedure 84 | 85 | Procedure.i ChildXMLNodeEx(*Node, n.i = 0, Name.s = "", Type.i = #XML_Default) 86 | Protected *Result = #Null 87 | If (*Node And IsNormalXMLNode(*Node) And (n >= 0)) 88 | If (Name And (Type = #XML_Default)) 89 | Type = #XML_Normal 90 | EndIf 91 | Protected i.i = 0 92 | Protected ChildType.i 93 | Protected *Child = ChildXMLNode(*Node) 94 | While (*Child) 95 | ChildType = XMLNodeType(*Child) 96 | If ((Type = #XML_Default) Or (Type = ChildType)) 97 | If ((ChildType <> #XML_Normal) Or (Name = "") Or (GetXMLNodeName(*Child) = Name)) 98 | i + 1 99 | If (i > n) 100 | *Result = *Child 101 | Break 102 | EndIf 103 | EndIf 104 | EndIf 105 | *Child = NextXMLNode(*Child) 106 | Wend 107 | EndIf 108 | ProcedureReturn (*Result) 109 | EndProcedure 110 | 111 | Procedure.i NextXMLNodeEx(*Node, Name.s = "", Type.i = #XML_Default) 112 | Protected *Result = #Null 113 | If (*Node) 114 | If (Name And (Type = #XML_Default)) 115 | Type = #XML_Normal 116 | EndIf 117 | Protected NodeType.i 118 | *Node = NextXMLNode(*Node) 119 | While (*Node) 120 | NodeType = XMLNodeType(*Node) 121 | If ((Type = #XML_Default) Or (Type = NodeType)) 122 | If ((NodeType <> #XML_Normal) Or (Name = "") Or (GetXMLNodeName(*Node) = Name)) 123 | *Result = *Node 124 | Break 125 | EndIf 126 | EndIf 127 | *Node = NextXMLNode(*Node) 128 | Wend 129 | EndIf 130 | ProcedureReturn (*Result) 131 | EndProcedure 132 | 133 | Procedure.i XMLChildCountEx(*Node, Name.s = "", Type.i = #XML_Default, Recursive.i = #False) 134 | Protected Result.i = 0 135 | If (*Node And IsNormalXMLNode(*Node)) 136 | If (Name And (Type = #XML_Default)) 137 | Type = #XML_Normal 138 | EndIf 139 | Protected NodeType.i 140 | Protected *Child = ChildXMLNode(*Node) 141 | While (*Child) 142 | NodeType = XMLNodeType(*Child) 143 | If ((Type = #XML_Default) Or (Type = NodeType)) 144 | If ((NodeType <> #XML_Normal) Or (Name = "") Or (GetXMLNodeName(*Child) = Name)) 145 | Result + 1 146 | EndIf 147 | EndIf 148 | If (Recursive And (NodeType = #XML_Normal)) 149 | Result + XMLChildCountEx(*Child, Name, Type, #True) 150 | EndIf 151 | *Child = NextXMLNode(*Child) 152 | Wend 153 | EndIf 154 | ProcedureReturn (Result) 155 | EndProcedure 156 | 157 | Procedure.i DeleteXMLChildren(*Node, Name.s = "", Type.i = #XML_Default, Recursive.i = #False) 158 | Protected Result.i = 0 159 | If (*Node And IsNormalXMLNode(*Node)) 160 | If (Name And (Type = #XML_Default)) 161 | Type = #XML_Normal 162 | EndIf 163 | Protected NodeType.i 164 | Protected *Next 165 | Protected *Child = ChildXMLNode(*Node) 166 | While (*Child) 167 | NodeType = XMLNodeType(*Child) 168 | If (Recursive And (NodeType = #XML_Normal)) 169 | Result + DeleteXMLChildren(*Child, Name, Type, #True) 170 | EndIf 171 | *Next = NextXMLNode(*Child) 172 | If ((Type = #XML_Default) Or (Type = NodeType)) 173 | If ((NodeType <> #XML_Normal) Or (Name = "") Or (GetXMLNodeName(*Child) = Name)) 174 | DeleteXMLNode(*Child) 175 | Result + 1 176 | EndIf 177 | EndIf 178 | *Child = *Next 179 | Wend 180 | EndIf 181 | ProcedureReturn (Result) 182 | EndProcedure 183 | 184 | 185 | CompilerEndIf 186 | ;- -------------------------------------------------------------------------------- /os.pbi: -------------------------------------------------------------------------------- 1 | ; +--------+ 2 | ; | os.pbi | 3 | ; +--------+ 4 | ; | 2014.01.01 . Added character constants/macros 5 | ; | .09 . Added SameFile and NotS 6 | ; | .17 . Added requester constants (such as #OS_YesNoCancel) 7 | ; | .24 . Removed NotS macro (moved to common.pbi) 8 | ; | .07.03 . Cleaned up OS macros, Win/Mac Elses, character constants 9 | ; | 2016.04.08 . Added OnWindows/OnLinux/OnMac single-statement macros 10 | ; | 2017.02.02 . Made multiple-include safe 11 | ; | 2024.09.20 . Added Backend info for PB 6.00+ (C vs ASM) 12 | 13 | 14 | CompilerIf (Not Defined(__OS_Included, #PB_Constant)) 15 | #__OS_Included = #True 16 | 17 | ;- 18 | ;- OS Macros 19 | 20 | CompilerSelect (#PB_Compiler_OS) 21 | 22 | CompilerCase (#PB_OS_Windows) 23 | Macro WLMO(Windows, Linux, Mac, Other) 24 | Windows 25 | EndMacro 26 | 27 | CompilerCase (#PB_OS_Linux) 28 | Macro WLMO(Windows, Linux, Mac, Other) 29 | Linux 30 | EndMacro 31 | 32 | CompilerCase (#PB_OS_MacOS) 33 | Macro WLMO(Windows, Linux, Mac, Other) 34 | Mac 35 | EndMacro 36 | 37 | CompilerDefault 38 | Macro WLMO(Windows, Linux, Mac, Other) 39 | Other 40 | EndMacro 41 | 42 | CompilerEndSelect 43 | 44 | 45 | CompilerIf (#PB_Compiler_OS = #PB_OS_Windows) 46 | Macro WindowsElse(This, That) 47 | This 48 | EndMacro 49 | Macro OnWindows(_Statement) 50 | _Statement 51 | EndMacro 52 | CompilerElse 53 | Macro WindowsElse(This, That) 54 | That 55 | EndMacro 56 | Macro OnWindows(_Statement) 57 | ; 58 | EndMacro 59 | CompilerEndIf 60 | 61 | 62 | CompilerIf (#PB_Compiler_OS = #PB_OS_Linux) 63 | Macro LinuxElse(This, That) 64 | This 65 | EndMacro 66 | Macro OnLinux(_Statement) 67 | _Statement 68 | EndMacro 69 | CompilerElse 70 | Macro LinuxElse(This, That) 71 | That 72 | EndMacro 73 | Macro OnLinux(_Statement) 74 | ; 75 | EndMacro 76 | CompilerEndIf 77 | 78 | 79 | CompilerIf (#PB_Compiler_OS = #PB_OS_MacOS) 80 | Macro MacElse(This, That) 81 | This 82 | EndMacro 83 | Macro OnMac(_Statement) 84 | _Statement 85 | EndMacro 86 | Macro LaunchFile(FileName) 87 | RunProgram("open", Quote(FileName), GetPathPart(FileName)) 88 | EndMacro 89 | Macro EditTextFile(FileName) 90 | RunProgram("open", "-e " + Quote(FileName), GetPathPart(FileName)) 91 | EndMacro 92 | CompilerElse 93 | Macro MacElse(This, That) 94 | That 95 | EndMacro 96 | Macro OnMac(_Statement) 97 | ; 98 | EndMacro 99 | Macro LaunchFile(FileName) 100 | RunProgram(FileName, "", GetPathPart(FileName)) 101 | EndMacro 102 | Macro EditTextFile(FileName) 103 | LaunchFile(FileName) 104 | EndMacro 105 | CompilerEndIf 106 | 107 | 108 | ;- 109 | ;- OS Constants 110 | 111 | #Windows = WindowsElse(#True, #False) 112 | #Linux = LinuxElse(#True, #False) 113 | #Mac = MacElse(#True, #False) 114 | ; 115 | #OpenGL = WLMO(Subsystem("opengl"), Subsystem("opengl"), #False, #False) 116 | #DirectX = WLMO((1 - #OpenGL), #False, #False, #False) 117 | #SDL = WLMO(#False, (1 - #OpenGL), #False, #False) 118 | #Carbon = WLMO(#False, #False, Subsystem("carbon"), #False) 119 | #Cocoa = WLMO(#False, #False, (1 - #Carbon), #False) 120 | ; 121 | #OS = WLMO(#PB_OS_Windows, #PB_OS_Linux, #PB_OS_MacOS, #Null) 122 | #OS$ = WLMO("Windows", "Linux", "Mac", "") 123 | #PS$ = WindowsElse("\", "/") 124 | #NPS$ = WindowsElse("/", "\") 125 | #EOL$ = WindowsElse(#CRLF$, #LF$) 126 | #CTRL$ = MacElse("Cmd", "Ctrl") 127 | #CTRLp$ = #CTRL$ + "+" 128 | #tCTRLp$ = #TAB$ + #CTRLp$ 129 | ; 130 | #NUL = $00 131 | #SP = ' ' 132 | #SP$ = " " 133 | #SQ = $27 134 | #SQ$ = "'" 135 | #DQ = $22 136 | #DQ$ = #DQUOTE$ 137 | #LFLF$ = #LF$ + #LF$ 138 | ; 139 | CompilerIf (#PB_Compiler_Unicode) 140 | #EL = $2026 141 | CompilerElseIf (#Mac) 142 | #EL = $C9 143 | CompilerElse 144 | #EL = $85 145 | CompilerEndIf 146 | CompilerIf (#Mac And (Not #PB_Compiler_Unicode)) 147 | #EL$ = "..." 148 | CompilerElse 149 | #EL$ = Chr(#EL) 150 | CompilerEndIf 151 | ; 152 | #Debugger = #PB_Compiler_Debugger 153 | ; 154 | CompilerIf (#PB_Compiler_Version >= 550) 155 | #OS_Icon_Information = #PB_MessageRequester_Info 156 | #OS_Icon_Warning = #PB_MessageRequester_Warning 157 | #OS_Icon_Error = #PB_MessageRequester_Error 158 | #OS_Icon_Question = WindowsElse(#MB_ICONQUESTION, #Null) 159 | CompilerElse 160 | #OS_Icon_Information = WindowsElse(#MB_ICONINFORMATION, #Null) 161 | #OS_Icon_Warning = WindowsElse(#MB_ICONWARNING, #Null) 162 | #OS_Icon_Error = WindowsElse(#MB_ICONERROR, #Null) 163 | #OS_Icon_Question = WindowsElse(#MB_ICONQUESTION, #Null) 164 | CompilerEndIf 165 | ; 166 | #OS_Yes = #PB_MessageRequester_Yes 167 | #OS_No = #PB_MessageRequester_No 168 | #OS_Cancel = #PB_MessageRequester_Cancel 169 | #OS_YesNo = #PB_MessageRequester_YesNo 170 | #OS_YesNoCancel = #PB_MessageRequester_YesNoCancel 171 | ; 172 | CompilerIf (#Windows) 173 | #OS_Shortcut_TabNext = 64001 174 | #OS_Shortcut_TabPrevious = 64002 175 | CompilerElse 176 | ; 177 | CompilerEndIf 178 | ; 179 | #YES = #True 180 | #NO = #False 181 | 182 | ;- 183 | ;- Color Constants 184 | 185 | #Black = $000000 186 | #White = $FFFFFF 187 | #Red = $0000FF 188 | #Green = $00FF00 189 | #Blue = $FF0000 190 | #Cyan = $FFFF00 191 | #Magenta = $FF00FF 192 | #Yellow = $00FFFF 193 | 194 | #OpaqueBlack = #Black | $FF000000 195 | #OpaqueWhite = #White | $FF000000 196 | #OpaqueRed = #Red | $FF000000 197 | #OpaqueGreen = #Green | $FF000000 198 | #OpaqueBlue = #Blue | $FF000000 199 | #OpaqueCyan = #Cyan | $FF000000 200 | #OpaqueMagenta = #Magenta | $FF000000 201 | #OpaqueYellow = #Yellow | $FF000000 202 | 203 | CompilerIf (#Windows) 204 | Enumeration 205 | #Console_Black 206 | #Console_DarkBlue 207 | #Console_DarkGreen 208 | #Console_DarkCyan 209 | #Console_DarkRed 210 | #Console_DarkMagenta 211 | #Console_DarkYellow 212 | #Console_Gray 213 | #Console_DarkGray 214 | #Console_Blue 215 | #Console_Green 216 | #Console_Cyan 217 | #Console_Red 218 | #Console_Magenta 219 | #Console_Yellow 220 | #Console_White 221 | EndEnumeration 222 | #Console_DefaultForeground = #Console_Gray 223 | #Console_DefaultBackground = #Console_Black 224 | CompilerEndIf 225 | 226 | ;- 227 | ;- Character Constants 228 | 229 | CompilerIf (#PB_Compiler_Unicode) 230 | #Unicode = #True 231 | #Ascii = #False 232 | #CharSize = 2 233 | ; 234 | #PB_Compiler_ASCII = #False 235 | ; 236 | #StringMode = #PB_Unicode 237 | #StringModeName = "Unicode" 238 | #StringFileMode = #PB_UTF8 239 | ; 240 | Macro ToChars(Bytes) 241 | ((Bytes)/2) 242 | EndMacro 243 | Macro ToBytes(Chars) 244 | ((Chars)*2) 245 | EndMacro 246 | CompilerElse 247 | #Ascii = #True 248 | #Unicode = #False 249 | #CharSize = 1 250 | ; 251 | #PB_Compiler_ASCII = #True 252 | ; 253 | #StringMode = #PB_Ascii 254 | #StringModeName = "ASCII" 255 | #StringFileMode = #PB_Ascii 256 | ; 257 | Macro ToChars(Bytes) 258 | (Bytes) 259 | EndMacro 260 | Macro ToBytes(Chars) 261 | (Chars) 262 | EndMacro 263 | CompilerEndIf 264 | 265 | ;- 266 | ;- Backend Macros 267 | 268 | CompilerIf (#PB_Compiler_Version < 600) 269 | #PB_Backend_Asm = 0 270 | #PB_Backend_C = 1 271 | #PB_Compiler_Backend = #PB_Backend_Asm 272 | CompilerEndIf 273 | CompilerIf (#PB_Compiler_Backend = #PB_Backend_C) 274 | #IsCBackend = #True 275 | #IsAsmBackend = #False 276 | Macro OnCBackend(_Statement) 277 | _Statement 278 | EndMacro 279 | Macro OnAsmBackend(_Statement) 280 | ; 281 | EndMacro 282 | CompilerElse 283 | #IsCBackend = #False 284 | #IsAsmBackend = #True 285 | Macro OnCBackend(_Statement) 286 | ; 287 | EndMacro 288 | Macro OnAsmBackend(_Statement) 289 | _Statement 290 | EndMacro 291 | CompilerEndIf 292 | 293 | ;- 294 | ;- CPU Macros 295 | 296 | CompilerIf (SizeOf(INTEGER) = 8) 297 | #IntSize = 8 298 | #Is64Bit = #True 299 | #Is32Bit = #False 300 | CompilerElse 301 | #IntSize = 4 302 | #Is64Bit = #False 303 | #Is32Bit = #True 304 | CompilerEndIf 305 | 306 | ;- 307 | ;- File Macros 308 | 309 | CompilerIf (#Windows) 310 | Macro SameFile(File1, File2) 311 | Bool(LCase(File1) = LCase(File2)) 312 | EndMacro 313 | CompilerElse 314 | Macro SameFile(File1, File2) 315 | Bool(File1 = File2) 316 | EndMacro 317 | CompilerEndIf 318 | 319 | CompilerEndIf 320 | 321 | ;- 322 | 323 | --------------------------------------------------------------------------------