├── .gitattributes ├── .github └── ISSUE_TEMPLATE │ ├── bug_report.md │ └── feature_request.md ├── .gitignore ├── Artwork ├── Box.jpg ├── Box.pdn ├── Box.png ├── Broadcast.jpg ├── Broadcast.pdn ├── Broadcast.png ├── Cool Note.png ├── Logo.png ├── SongArt.jpg ├── SongArt.pdn ├── SongArt.png ├── Speaker.jpg ├── Speaker.pdn └── Speaker.png ├── BroadcastAPI.pas ├── CONTRIBUTING.md ├── DLL Libraries ├── x64 │ ├── bass.dll │ ├── libeay32.dll │ └── ssleay32.dll └── x86 │ ├── bass.dll │ ├── libeay32.dll │ └── ssleay32.dll ├── Dependencies ├── .include-windows-runtime-dependencies ├── Cod.ArrayHelpers.pas ├── Cod.Audio.pas ├── Cod.ColorUtils.pas ├── Cod.Debugging.pas ├── Cod.Dialogs.pas ├── Cod.Files.pas ├── Cod.GDI.pas ├── Cod.Graphics.pas ├── Cod.Instances.pas ├── Cod.Internet.pas ├── Cod.Math.pas ├── Cod.MesssageConst.pas ├── Cod.Registry.pas ├── Cod.StringUtils.pas ├── Cod.SysExtras.pas ├── Cod.SysUtils.pas ├── Cod.TimeUtils.pas ├── Cod.Types.pas ├── Cod.VarHelpers.pas ├── Cod.Version.pas ├── Cod.Windows.ThemeApi.pas └── Cod.Windows.pas ├── Forms ├── CodeSources.dfm ├── CodeSources.pas ├── CreatePlaylistForm.dfm ├── CreatePlaylistForm.pas ├── DebugForm.dfm ├── DebugForm.pas ├── HelpForm.dfm ├── HelpForm.pas ├── InfoForm.dfm ├── InfoForm.pas ├── LoggingForm.dfm ├── LoggingForm.pas ├── MiniPlay.dfm ├── MiniPlay.pas ├── NewVersionForm.dfm ├── NewVersionForm.pas ├── Offline.dfm ├── Offline.pas ├── Performance.dfm ├── Performance.pas ├── PickerDialogForm.dfm ├── PickerDialogForm.pas ├── RatingPopup.dfm ├── RatingPopup.pas ├── VolumePopup.dfm └── VolumePopup.pas ├── LICENSE ├── MainUI.dfm ├── MainUI.pas ├── PULL_REQUEST_TEMPLATE.md ├── README.md ├── Utils ├── SpectrumVis3D.pas └── iBroadcastUtils.pas ├── iBroadcast.dpr ├── iBroadcast.dproj ├── iBroadcast.dproj.local ├── iBroadcast.dres ├── iBroadcast.identcache ├── iBroadcast.res ├── iBroadcastResource.rc └── iBroadcast_Icon.ico /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help us improve 4 | title: '' 5 | labels: '' 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Describe the bug** 11 | A clear and concise description of what the bug is. 12 | 13 | **To Reproduce** 14 | Steps to reproduce the behavior: 15 | 1. Go to '...' 16 | 2. Click on '....' 17 | 3. Scroll down to '....' 18 | 4. See error 19 | 20 | **Expected behavior** 21 | A clear and concise description of what you expected to happen. 22 | 23 | **Screenshots** 24 | If applicable, add screenshots to help explain your problem. 25 | 26 | **Desktop (please complete the following information):** 27 | - OS: [e.g. iOS] 28 | - Version [e.g. 22] 29 | 30 | **Additional context** 31 | Add any other context about the problem here. 32 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature_request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Feature request 3 | about: Suggest an idea for this project 4 | title: '' 5 | labels: '' 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Is your feature request related to a problem? Please describe.** 11 | A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] 12 | 13 | **Describe the solution you'd like** 14 | A clear and concise description of what you want to happen. 15 | 16 | **Describe alternatives you've considered** 17 | A clear and concise description of any alternative solutions or features you've considered. 18 | 19 | **Additional context** 20 | Add any other context or screenshots about the feature request here. 21 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | __history/ 2 | __recovery/ 3 | DCU/ 4 | Win32/ 5 | Win64/ 6 | /iBroadcast.identcache 7 | /iBroadcast.dproj.local 8 | -------------------------------------------------------------------------------- /Artwork/Box.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Box.jpg -------------------------------------------------------------------------------- /Artwork/Box.pdn: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Box.pdn -------------------------------------------------------------------------------- /Artwork/Box.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Box.png -------------------------------------------------------------------------------- /Artwork/Broadcast.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Broadcast.jpg -------------------------------------------------------------------------------- /Artwork/Broadcast.pdn: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Broadcast.pdn -------------------------------------------------------------------------------- /Artwork/Broadcast.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Broadcast.png -------------------------------------------------------------------------------- /Artwork/Cool Note.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Cool Note.png -------------------------------------------------------------------------------- /Artwork/Logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Logo.png -------------------------------------------------------------------------------- /Artwork/SongArt.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/SongArt.jpg -------------------------------------------------------------------------------- /Artwork/SongArt.pdn: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/SongArt.pdn -------------------------------------------------------------------------------- /Artwork/SongArt.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/SongArt.png -------------------------------------------------------------------------------- /Artwork/Speaker.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Speaker.jpg -------------------------------------------------------------------------------- /Artwork/Speaker.pdn: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Speaker.pdn -------------------------------------------------------------------------------- /Artwork/Speaker.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Artwork/Speaker.png -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | ## Project Goal 2 | - To make a Windows version for iBroadcast, since there is no official one. 3 | 4 | ## Rules 5 | - Please don't make any malicious changes 6 | - Make a pull request to commit in the main branch 7 | -------------------------------------------------------------------------------- /DLL Libraries/x64/bass.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/DLL Libraries/x64/bass.dll -------------------------------------------------------------------------------- /DLL Libraries/x64/libeay32.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/DLL Libraries/x64/libeay32.dll -------------------------------------------------------------------------------- /DLL Libraries/x64/ssleay32.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/DLL Libraries/x64/ssleay32.dll -------------------------------------------------------------------------------- /DLL Libraries/x86/bass.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/DLL Libraries/x86/bass.dll -------------------------------------------------------------------------------- /DLL Libraries/x86/libeay32.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/DLL Libraries/x86/libeay32.dll -------------------------------------------------------------------------------- /DLL Libraries/x86/ssleay32.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/DLL Libraries/x86/ssleay32.dll -------------------------------------------------------------------------------- /Dependencies/.include-windows-runtime-dependencies: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/Dependencies/.include-windows-runtime-dependencies -------------------------------------------------------------------------------- /Dependencies/Cod.ColorUtils.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codruts Color Utilities } 3 | { } 4 | { version 0.2 } 5 | { ALPHA } 6 | { } 7 | { } 8 | { } 9 | { } 10 | { } 11 | { -- WORK IN PROGRESS -- } 12 | {***********************************************************} 13 | 14 | unit Cod.ColorUtils; 15 | {$SCOPEDENUMS ON} 16 | 17 | interface 18 | uses 19 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 20 | System.Classes, Vcl.Graphics, Vcl.Dialogs, Math, Winapi.GDIPOBJ, 21 | Winapi.GDIPAPI; 22 | 23 | type 24 | CRGBA = record 25 | public 26 | R, G, B, A: byte; 27 | 28 | function Create(Red, Green, Blue: Byte; Alpha: Byte = 255): CRGBA; 29 | 30 | function MakeGDIBrush: TGPSolidBrush; 31 | function MakeGDIColor: TGPColor; 32 | function MakeGDIPen(Width: Single = 1): TGPPen; 33 | 34 | function ToColor(Alpha: Byte = 255): TColor; 35 | procedure FromColor(Color: TColor; Alpha: Byte = 255); 36 | end; 37 | 38 | CRGB = CRGBA; 39 | 40 | // Color Conversion 41 | function GetRGB(Color: TColor; Alpha: Byte = 255): CRGBA; overload; 42 | function GetRGB(R, G, B: Byte; Alpha: Byte = 255): CRGBA; overload; 43 | function GetColor(Color: CRGBA): TColor; 44 | 45 | // HEX 46 | function ColorToHEX(Color: TColor): string; 47 | function HEXToColor(HEX: string): TColor; 48 | 49 | // HBS 50 | function HSBtoColor(hue, sat, bri: Double): TColor; 51 | 52 | // Extra Utilities 53 | function GetHBSCircleColor(Degree: integer): TColor; 54 | 55 | // Fix OutOfRange colors 56 | (* Singe Delphi 11.4, the RangeCheckError flag is enabled on new projects, 57 | this affects color functions that reqire a DWORD and the default system 58 | TColors from the Windows units, are invalid. To fix them, use ColorToRGB *) 59 | 60 | // Color alteration 61 | function ChangeColorSat(BaseColor: TColor; ByValue: integer): TColor; 62 | function ColorToGrayScale(BaseColor: TColor; ToneDown: integer = 3): TColor; 63 | function ColorBlend(Color1, Color2: TColor; A: Byte): TColor; 64 | function RandomLightColor(minimumlightness: byte): TColor; 65 | function RandomDarkColor(maximumlightness: byte): TColor; 66 | function RandomColor(min, max: byte): TColor; 67 | function InvertColor(Color: TColor): TColor; 68 | 69 | // Calculations 70 | function GetColorSat(BaseColor: CRGBA; ColorSize: integer = 255): integer; overload; 71 | function GetColorSat(BaseColor: TColor; ColorSize: integer = 255): integer; overload; 72 | 73 | // Extras 74 | function FontColorForBackground(bgcolor: TColor): TColor; 75 | 76 | type 77 | CColors = record 78 | const 79 | Aliceblue = TColor($FFF8F0); 80 | Antiquewhite = TColor($D7EBFA); 81 | Aqua = TColor($FFFF00); 82 | Aquamarine = TColor($D4FF7F); 83 | Azure = TColor($FFFFF0); 84 | Beige = TColor($DCF5F5); 85 | Bisque = TColor($C4E4FF); 86 | Black = TColor($000000); 87 | Blanchedalmond = TColor($CDEBFF); 88 | Blue = TColor($FF0000); 89 | Blueviolet = TColor($E22B8A); 90 | Brown = TColor($2A2AA5); 91 | Burlywood = TColor($87B8DE); 92 | Cadetblue = TColor($A09E5F); 93 | Chartreuse = TColor($00FF7F); 94 | Chocolate = TColor($1E69D2); 95 | Coral = TColor($507FFF); 96 | Cornflowerblue = TColor($ED9564); 97 | Cornsilk = TColor($DCF8FF); 98 | Crimson = TColor($3C14DC); 99 | Cyan = TColor($FFFF00); 100 | Darkblue = TColor($8B0000); 101 | Darkcyan = TColor($8B8B00); 102 | Darkgoldenrod = TColor($0B86B8); 103 | Darkgray = TColor($A9A9A9); 104 | Darkgreen = TColor($006400); 105 | Darkgrey = TColor($A9A9A9); 106 | Darkkhaki = TColor($6BB7BD); 107 | Darkmagenta = TColor($8B008B); 108 | Darkolivegreen = TColor($2F6B55); 109 | Darkorange = TColor($008CFF); 110 | Darkorchid = TColor($CC3299); 111 | Darkred = TColor($00008B); 112 | Darksalmon = TColor($7A96E9); 113 | Darkseagreen = TColor($8FBC8F); 114 | Darkslateblue = TColor($8B3D48); 115 | Darkslategray = TColor($4F4F2F); 116 | Darkslategrey = TColor($4F4F2F); 117 | Darkturquoise = TColor($D1CE00); 118 | Darkviolet = TColor($D30094); 119 | Deeppink = TColor($9314FF); 120 | Deepskyblue = TColor($FFBF00); 121 | Dimgray = TColor($696969); 122 | Dimgrey = TColor($696969); 123 | Dodgerblue = TColor($FF901E); 124 | Firebrick = TColor($2222B2); 125 | Floralwhite = TColor($F0FAFF); 126 | Forestgreen = TColor($228B22); 127 | Fuchsia = TColor($FF00FF); 128 | Gainsboro = TColor($DCDCDC); 129 | Ghostwhite = TColor($FFF8F8); 130 | Gold = TColor($00D7FF); 131 | Goldenrod = TColor($20A5DA); 132 | Gray = TColor($808080); 133 | Green = TColor($008000); 134 | Greenyellow = TColor($2FFFAD); 135 | Grey = TColor($808080); 136 | Honeydew = TColor($F0FFF0); 137 | Hotpink = TColor($B469FF); 138 | Indianred = TColor($5C5CCD); 139 | Indigo = TColor($82004B); 140 | Ivory = TColor($F0FFFF); 141 | Khaki = TColor($8CE6F0); 142 | Lavender = TColor($FAE6E6); 143 | Lavenderblush = TColor($F5F0FF); 144 | Lawngreen = TColor($00FC7C); 145 | Lemonchiffon = TColor($CDFAFF); 146 | Lightblue = TColor($E6D8AD); 147 | Lightcoral = TColor($8080F0); 148 | Lightcyan = TColor($FFFFE0); 149 | Lightgoldenrodyellow = TColor($D2FAFA); 150 | Lightgray = TColor($D3D3D3); 151 | Lightgreen = TColor($90EE90); 152 | Lightgrey = TColor($D3D3D3); 153 | Lightpink = TColor($C1B6FF); 154 | Lightsalmon = TColor($7AA0FF); 155 | Lightseagreen = TColor($AAB220); 156 | Lightskyblue = TColor($FACE87); 157 | Lightslategray = TColor($998877); 158 | Lightslategrey = TColor($998877); 159 | Lightsteelblue = TColor($DEC4B0); 160 | Lightyellow = TColor($E0FFFF); 161 | LtGray = TColor($C0C0C0); 162 | MedGray = TColor($A4A0A0); 163 | DkGray = TColor($808080); 164 | MoneyGreen = TColor($C0DCC0); 165 | LegacySkyBlue = TColor($F0CAA6); 166 | Cream = TColor($F0FBFF); 167 | Lime = TColor($00FF00); 168 | Limegreen = TColor($32CD32); 169 | Linen = TColor($E6F0FA); 170 | Magenta = TColor($FF00FF); 171 | Maroon = TColor($000080); 172 | Mediumaquamarine = TColor($AACD66); 173 | Mediumblue = TColor($CD0000); 174 | Mediumorchid = TColor($D355BA); 175 | Mediumpurple = TColor($DB7093); 176 | Mediumseagreen = TColor($71B33C); 177 | Mediumslateblue = TColor($EE687B); 178 | Mediumspringgreen = TColor($9AFA00); 179 | Mediumturquoise = TColor($CCD148); 180 | Mediumvioletred = TColor($8515C7); 181 | Midnightblue = TColor($701919); 182 | Mintcream = TColor($FAFFF5); 183 | Mistyrose = TColor($E1E4FF); 184 | Moccasin = TColor($B5E4FF); 185 | Navajowhite = TColor($ADDEFF); 186 | Navy = TColor($800000); 187 | Oldlace = TColor($E6F5FD); 188 | Olive = TColor($008080); 189 | Olivedrab = TColor($238E6B); 190 | Orange = TColor($00A5FF); 191 | Orangered = TColor($0045FF); 192 | Orchid = TColor($D670DA); 193 | Palegoldenrod = TColor($AAE8EE); 194 | Palegreen = TColor($98FB98); 195 | Paleturquoise = TColor($EEEEAF); 196 | Palevioletred = TColor($9370DB); 197 | Papayawhip = TColor($D5EFFF); 198 | Peachpuff = TColor($B9DAFF); 199 | Peru = TColor($3F85CD); 200 | Pink = TColor($CBC0FF); 201 | Plum = TColor($DDA0DD); 202 | Powderblue = TColor($E6E0B0); 203 | Purple = TColor($800080); 204 | Red = TColor($0000FF); 205 | Rosybrown = TColor($8F8FBC); 206 | Royalblue = TColor($E16941); 207 | Saddlebrown = TColor($13458B); 208 | Salmon = TColor($7280FA); 209 | Sandybrown = TColor($60A4F4); 210 | Seagreen = TColor($578B2E); 211 | Seashell = TColor($EEF5FF); 212 | Sienna = TColor($2D52A0); 213 | Silver = TColor($C0C0C0); 214 | Skyblue = TColor($EBCE87); 215 | Slateblue = TColor($CD5A6A); 216 | Slategray = TColor($908070); 217 | Slategrey = TColor($908070); 218 | Snow = TColor($FAFAFF); 219 | Springgreen = TColor($7FFF00); 220 | Steelblue = TColor($B48246); 221 | Tan = TColor($8CB4D2); 222 | Teal = TColor($808000); 223 | Thistle = TColor($D8BFD8); 224 | Tomato = TColor($4763FF); 225 | Turquoise = TColor($D0E040); 226 | Violet = TColor($EE82EE); 227 | Wheat = TColor($B3DEF5); 228 | White = TColor($FFFFFF); 229 | Whitesmoke = TColor($F5F5F5); 230 | Yellow = TColor($00FFFF); 231 | Yellowgreen = TColor($32CD9A); 232 | Null = TColor($00000000); 233 | end; 234 | 235 | implementation 236 | 237 | { ColorTools } 238 | 239 | function GetColorSat(BaseColor: CRGBA; ColorSize: integer): integer; 240 | var 241 | l1, l2, l3: real; 242 | begin 243 | l1 := BaseColor.R / 255 * ColorSize; 244 | l2 := BaseColor.G / 255 * ColorSize; 245 | l3 := BaseColor.B / 255 * ColorSize; 246 | 247 | Result := trunc((l1 + l2 + l3)/3); 248 | end; 249 | 250 | function GetColorSat(BaseColor: TColor; ColorSize: integer): integer; 251 | begin 252 | Result := GetColorSat(GetRGB(BaseColor), ColorSize); 253 | end; 254 | 255 | function ChangeColorSat(BaseColor: TColor; ByValue: integer): TColor; 256 | var 257 | RBGval: longint; 258 | R, G, B: integer; 259 | begin 260 | RBGval := ColorToRGB(BaseColor); 261 | R := GetRValue(RBGval); 262 | G := GetGValue(RBGval); 263 | B := GetBValue(RBGval); 264 | 265 | R := R + ByValue; 266 | G := G + ByValue; 267 | B := B + ByValue; 268 | 269 | if R < 0 then R := 0; 270 | if G < 0 then G := 0; 271 | if B < 0 then B := 0; 272 | 273 | if R > 255 then R := 255; 274 | if G > 255 then G := 255; 275 | if B > 255 then B := 255; 276 | 277 | Result := RGB(r,g,b); 278 | end; 279 | 280 | function ColorBlend(Color1, Color2: TColor; A: Byte): TColor; 281 | var 282 | RGB1, RGB2: CRGB; 283 | R, G, B: Byte; 284 | begin 285 | RGB1.FromColor(Color1); 286 | RGB2.FromColor(Color2); 287 | 288 | R := RGB1.R + (RGB2.R - RGB1.R) * A div 255; 289 | G := RGB1.G + (RGB2.G - RGB1.G) * A div 255; 290 | B := RGB1.B + (RGB2.B - RGB1.B) * A div 255; 291 | 292 | Result := RGB(R, G, B); 293 | end; 294 | 295 | function RandomLightColor(minimumlightness: byte): TColor; 296 | begin 297 | Result := rgb(minimumlightness+round(random*(255 - minimumlightness)), 298 | minimumlightness+round(random*(255 - minimumlightness)), 299 | minimumlightness+round(random*(255 - minimumlightness))) 300 | end; 301 | 302 | function RandomDarkColor(maximumlightness: byte): TColor; 303 | begin 304 | Result := rgb(round(random*(maximumlightness)), 305 | round(random*(maximumlightness)), 306 | round(random*(maximumlightness))) 307 | end; 308 | 309 | function RandomColor(min, max: byte): TColor; 310 | begin 311 | Result := rgb(randomrange(min, max), 312 | randomrange(min, max), 313 | randomrange(min, max)) 314 | end; 315 | 316 | function InvertColor(Color: TColor): TColor; 317 | var 318 | R, G, B: integer; 319 | begin 320 | R := 255 - GetRValue(Color); 321 | G := 255 - GetGValue(Color); 322 | B := 255 - GetBValue(Color); 323 | Result := RGB(R, G, B); 324 | end; 325 | function FontColorForBackground(bgcolor: TColor): TColor; 326 | begin 327 | if GetColorSat(bgcolor, 100) < 65 then 328 | Result := clWhite 329 | else 330 | Result := clBlack; 331 | end; 332 | 333 | function ColorToGrayScale(BaseColor: TColor; ToneDown: integer): TColor; 334 | var 335 | RBGval: longint; 336 | R, G, B: integer; 337 | begin 338 | RBGval := ColorToRGB(BaseColor); 339 | R := GetRValue(RBGval); 340 | G := GetGValue(RBGval); 341 | B := GetBValue(RBGval); 342 | 343 | R:= (R+G+B) div ToneDown; 344 | G:= R; B:=R; 345 | 346 | Result := RGB(r,g,b); 347 | end; 348 | 349 | function ColorToHEX(Color: TColor): string; 350 | begin 351 | Result := '#' + 352 | IntToHex( GetRValue( Color ), 2 ) + 353 | IntToHex( GetGValue( Color ), 2 ) + 354 | IntToHex( GetBValue( Color ), 2 ); 355 | end; 356 | 357 | function GetColor(Color: CRGBA): TColor; 358 | begin 359 | Result := RGB(Color.R, Color.G, Color.B); 360 | end; 361 | 362 | function GetRGB(Color: TColor; Alpha: Byte): CRGBA; 363 | begin 364 | Result.FromColor(Color, Alpha); 365 | end; 366 | 367 | function GetRGB(R, G, B: Byte; Alpha: Byte): CRGBA; 368 | begin 369 | Result.Create(R, G, B, Alpha); 370 | end; 371 | 372 | function HEXToColor(HEX: string): TColor; 373 | begin 374 | HEX := HEX.Replace('#', ''); 375 | try 376 | Result := 377 | RGB( 378 | StrToInt( '$'+Copy( HEX, 1, 2 ) ), 379 | StrToInt( '$'+Copy( HEX, 3, 2 ) ), 380 | StrToInt( '$'+Copy( HEX, 5, 2 ) ) 381 | ); 382 | except 383 | Result := 0; 384 | end; 385 | end; 386 | 387 | 388 | function HSBtoColor(hue, sat, bri: Double): TColor; 389 | var 390 | f, h: Double; 391 | u, p, q, t: Byte; 392 | begin 393 | u := Trunc(bri * 255 + 0.5); 394 | if sat = 0 then 395 | Exit(rgb(u, u, u)); 396 | 397 | h := (hue - Floor(hue)) * 6; 398 | f := h - Floor(h); 399 | p := Trunc(bri * (1 - sat) * 255 + 0.5); 400 | q := Trunc(bri * (1 - sat * f) * 255 + 0.5); 401 | t := Trunc(bri * (1 - sat * (1 - f)) * 255 + 0.5); 402 | 403 | case Trunc(h) of 404 | 0: 405 | result := rgb(u, t, p); 406 | 1: 407 | result := rgb(q, u, p); 408 | 2: 409 | result := rgb(p, u, t); 410 | 3: 411 | result := rgb(p, q, u); 412 | 4: 413 | result := rgb(t, p, u); 414 | 5: 415 | result := rgb(u, p, q); 416 | else 417 | result := clwhite; 418 | end; 419 | end; 420 | 421 | function GetHBSCircleColor(Degree: integer): TColor; 422 | begin 423 | Result := HSBtoColor( Degree / 360 * 1, 1, 1 ); 424 | end; 425 | 426 | { CRGB } 427 | 428 | function CRGBA.Create(Red, Green, Blue, Alpha: Byte): CRGBA; 429 | begin 430 | R := Red; 431 | G := Green; 432 | B := Blue; 433 | 434 | A := Alpha; 435 | 436 | Result := Self; 437 | end; 438 | 439 | procedure CRGBA.FromColor(Color: TColor; Alpha: Byte); 440 | var 441 | RBGval: longint; 442 | begin 443 | RBGval := ColorToRGB(Color); 444 | 445 | try 446 | R := GetRValue(RBGval); 447 | G := GetGValue(RBGval); 448 | B := GetBValue(RBGval); 449 | 450 | A := Alpha; 451 | finally 452 | 453 | end; 454 | end; 455 | 456 | function CRGBA.MakeGDIBrush: TGPSolidBrush; 457 | begin 458 | Result := TGPSolidBrush.Create( MakeGDIColor ); 459 | end; 460 | 461 | function CRGBA.MakeGDIColor: TGPColor; 462 | begin 463 | Result := MakeColor(A, R, G, B); 464 | end; 465 | 466 | function CRGBA.MakeGDIPen(Width: Single): TGPPen; 467 | begin 468 | Result := TGPPen.Create( MakeGDIColor, Width ); 469 | end; 470 | 471 | function CRGBA.ToColor(Alpha: Byte): TColor; 472 | begin 473 | Result := RGB(R, G, B); 474 | 475 | A := Alpha; 476 | end; 477 | 478 | end. -------------------------------------------------------------------------------- /Dependencies/Cod.Debugging.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codruts Debugging Utilities } 3 | { } 4 | { version 0.2 } 5 | { ALPHA } 6 | { } 7 | { } 8 | { } 9 | { } 10 | { } 11 | { -- WORK IN PROGRESS -- } 12 | {***********************************************************} 13 | 14 | unit Cod.Debugging; 15 | 16 | interface 17 | uses 18 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, IOUTils, 19 | Cod.Types, Cod.StringUtils, Cod.Files; 20 | 21 | procedure Debug(Value: string); 22 | procedure CounterOutput(Message: string); 23 | 24 | 25 | implementation 26 | 27 | var 28 | Count: integer = 0; 29 | OutputName: string; 30 | 31 | procedure Debug(Value: string); 32 | begin 33 | OutPutDebugString( PChar(Value) ); 34 | end; 35 | 36 | procedure CounterOutput(Message: string); 37 | var 38 | FLog: string; 39 | F: TextFile; 40 | begin 41 | FLog := Count.ToString + ' - ' + Message; 42 | 43 | AssignFile(F, OutputName); 44 | if Count = 0 then 45 | Rewrite(F) 46 | else 47 | Append(F); 48 | 49 | Inc(Count); 50 | 51 | WriteLn(F, FLog); 52 | 53 | CloseFile(F); 54 | 55 | OutputDebugString( PChar(FLog) ); 56 | end; 57 | 58 | initialization 59 | OutputName := ReplaceWinPath('%tmp%\debug_log.txt') 60 | 61 | end. -------------------------------------------------------------------------------- /Dependencies/Cod.Instances.pas: -------------------------------------------------------------------------------- 1 | unit Cod.Instances; 2 | 3 | /// EASY MODE: 4 | /// Initialize the instance with InitializeInstance() as you desire 5 | /// If the instance exists and HasAppInfo() is true, you can use 6 | /// GetAppInfo() to get info about the app like the HWND and PID. 7 | /// 8 | /// Nothing needs to be closed as It's done automatically when the app closes. 9 | /// 10 | 11 | interface 12 | 13 | uses 14 | Winapi.Windows, Winapi.Messages, Vcl.Forms, SysUtils; 15 | 16 | type 17 | TAutoInstanceMode = (TerminateIfOtherExist, TerminateAndFocusOther); 18 | 19 | TAppSharedInfo = packed record 20 | Valid: boolean; 21 | PID: DWORD; 22 | HWND: HWND; 23 | end; 24 | PAppSharedInfo = ^TAppSharedInfo; 25 | 26 | // Utils 27 | procedure IPCSendMessage(target: HWND; const message: string); 28 | 29 | (* Easy mode *) 30 | procedure InitializeInstance(EnableSharedMemorySpace: boolean; WriteProcessInfo: boolean=true); 31 | 32 | // Info 33 | function HasOtherInstance: boolean; 34 | 35 | // Name 36 | function GetSemaphore: string; 37 | procedure SetSemaphore(Value: string); 38 | 39 | (* Advanced users *) 40 | // Lock 41 | function LockSemaphore: boolean; 42 | function UnlockSemaphore: boolean; 43 | 44 | // Info 45 | function HasAppInfo: boolean; 46 | function OpenAppInfo(WriteAccess: boolean=true): boolean; 47 | procedure CloseAppInfo; 48 | 49 | procedure PutAppInfo; overload; 50 | procedure PutAppInfo(hwnd: HWND); overload; 51 | function GetAppInfo: TAppSharedInfo; 52 | 53 | (* Automatic tasks *) 54 | procedure InstanceAuto(Mode: TAutoInstanceMode; AExitCode: integer = integer.MinValue); 55 | 56 | procedure BringOtherWindowToTopAuto; 57 | procedure SendOtherWindowMessageAuto(Msg: UINT; wParam: WPARAM; lParam: LPARAM); 58 | 59 | var 60 | HaltResultCode: integer = 0; 61 | 62 | implementation 63 | 64 | var 65 | // Semafore name 66 | APP_SEMAFOR: string = ''; 67 | 68 | // Handle 69 | Semafor: THandle; 70 | SemaforCreated: boolean; 71 | SemaforRefused: boolean; 72 | 73 | // Map 74 | SharedAppInfoMap: THandle; 75 | SharedAppInfo: PAppSharedInfo; 76 | 77 | procedure IPCSendMessage(target: HWND; const message: string); 78 | var 79 | cds: TCopyDataStruct; 80 | begin 81 | cds.dwData := 0; 82 | cds.cbData := Length(message) * SizeOf(Char); 83 | cds.lpData := Pointer(@message[1]); 84 | 85 | SendMessage(target, WM_COPYDATA, 0, LPARAM(@cds)); 86 | end; 87 | 88 | procedure InitializeInstance(EnableSharedMemorySpace, WriteProcessInfo: boolean); 89 | begin 90 | // Semaphore 91 | LockSemaphore; 92 | 93 | // Shared mem? 94 | if EnableSharedMemorySpace then 95 | if OpenAppInfo( not SemaforRefused ) then 96 | // Write info 97 | if WriteProcessInfo and not SemaforRefused then 98 | PutAppInfo; 99 | end; 100 | 101 | function HasOtherInstance: boolean; 102 | begin 103 | if not SemaforCreated then 104 | raise Exception.Create('Semaphore is not created.'); 105 | 106 | Result := SemaforRefused; 107 | end; 108 | 109 | function GetSemaphore: string; 110 | begin 111 | if APP_SEMAFOR = '' then 112 | begin 113 | APP_SEMAFOR := StringReplace( Application.ExeName, '.', '_', [rfReplaceAll]); 114 | APP_SEMAFOR := StringReplace( APP_SEMAFOR, '\', '_', [rfReplaceAll]); 115 | APP_SEMAFOR := StringReplace( APP_SEMAFOR, ':', '', [rfReplaceAll]); 116 | 117 | if Length( APP_SEMAFOR ) > 100 then 118 | APP_SEMAFOR := Copy( APP_SEMAFOR, Length(APP_SEMAFOR) - 100, 100 ); 119 | end; 120 | 121 | Result := APP_SEMAFOR; 122 | end; 123 | 124 | procedure SetSemaphore(Value: string); 125 | begin 126 | APP_SEMAFOR := Value; 127 | end; 128 | 129 | function LockSemaphore: boolean; 130 | begin 131 | Semafor := CreateSemaphore( nil, 0, 1, PChar(GetSemaphore) ); 132 | 133 | SemaforCreated := true; 134 | SemaforRefused := ((Semafor <> 0) and { application is already running } 135 | (GetLastError = ERROR_ALREADY_EXISTS)); 136 | 137 | // Successfully locked? 138 | Result := not SemaforRefused; 139 | end; 140 | 141 | function UnlockSemaphore: boolean; 142 | begin 143 | SemaforCreated := false; 144 | SemaforRefused := false; 145 | 146 | // Close handle 147 | Result := CloseHandle(Semafor); 148 | end; 149 | 150 | function SHARED_MEM_NAME: string; 151 | begin 152 | Result := 'mem_appinfo_' + APP_SEMAFOR; 153 | end; 154 | 155 | function HasAppInfo: boolean; 156 | begin 157 | Result := (SharedAppInfo <> nil) and (SharedAppInfoMap <> 0); 158 | end; 159 | 160 | function OpenAppInfo(WriteAccess: boolean=true): boolean; 161 | begin 162 | Result := false; 163 | 164 | // Create mapping 165 | if WriteAccess then 166 | SharedAppInfoMap := CreateFileMapping( INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, 167 | SizeOf(TAppSharedInfo), PChar(SHARED_MEM_NAME)) 168 | else 169 | SharedAppInfoMap := OpenFileMapping(FILE_MAP_READ, False, PChar(SHARED_MEM_NAME)); 170 | 171 | if SharedAppInfoMap = 0 then 172 | Exit; 173 | 174 | // Read info 175 | if WriteAccess then 176 | SharedAppInfo := MapViewOfFile(SharedAppInfoMap, FILE_MAP_WRITE, 0, 0, SizeOf(TAppSharedInfo)) 177 | else 178 | SharedAppInfo := MapViewOfFile(SharedAppInfoMap, FILE_MAP_READ, 0, 0, SizeOf(TAppSharedInfo)); 179 | if SharedAppInfo = nil then 180 | Exit; 181 | 182 | Result := true; 183 | end; 184 | 185 | procedure CloseAppInfo; 186 | begin 187 | if not HasAppInfo then 188 | Exit; 189 | 190 | // Close variabile 191 | UnmapViewOfFile(SharedAppInfo); 192 | SharedAppInfo := nil; 193 | 194 | // Close map 195 | CloseHandle(SharedAppInfoMap); 196 | SharedAppInfoMap := 0; 197 | end; 198 | 199 | procedure PutAppInfo; 200 | begin 201 | PutAppInfo( Application.MainForm.Handle ); 202 | end; 203 | 204 | procedure PutAppInfo(hwnd: HWND); overload; 205 | begin 206 | SharedAppInfo^.Valid := true; 207 | SharedAppInfo^.PID := GetCurrentProcessId; 208 | SharedAppInfo^.HWND := hwnd; 209 | end; 210 | 211 | function GetAppInfo: TAppSharedInfo; 212 | begin 213 | Result := SharedAppInfo^; 214 | end; 215 | 216 | procedure InstanceAuto(Mode: TAutoInstanceMode; AExitCode: integer); 217 | procedure DoHalt; 218 | begin 219 | if AExitCode = integer.MaxValue then 220 | Halt 221 | else 222 | Halt( AExitCode ); 223 | end; 224 | begin 225 | InitializeInstance(Mode <> TAutoInstanceMode.TerminateIfOtherExist); 226 | if not HasOtherInstance then 227 | Exit; 228 | 229 | // Handle case of otuer window 230 | case Mode of 231 | TerminateIfOtherExist: DoHalt; 232 | TerminateAndFocusOther: begin 233 | BringOtherWindowToTopAuto; 234 | DoHalt; 235 | end; 236 | end; 237 | end; 238 | 239 | procedure BringOtherWindowToTopAuto; 240 | var 241 | Info: TAppSharedInfo; 242 | begin 243 | if HasAppInfo then begin 244 | Info := GetAppInfo; 245 | 246 | SendMessage(Info.HWND, WM_SYSCOMMAND, SC_RESTORE, 0); // restore a minimize window 247 | SetForegroundWindow(Info.HWND); 248 | SetActiveWindow(Info.HWND); 249 | SetWindowPos(Info.HWND, HWND_TOP, 0, 0, 0, 0, SWP_SHOWWINDOW or SWP_NOMOVE or SWP_NOSIZE); 250 | //redraw to prevent the window blank. 251 | RedrawWindow(Info.HWND, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN ); 252 | end; 253 | end; 254 | 255 | procedure SendOtherWindowMessageAuto(Msg: UINT; wParam: WPARAM; lParam: LPARAM); 256 | var 257 | Info: TAppSharedInfo; 258 | begin 259 | if HasAppInfo then begin 260 | Info := GetAppInfo; 261 | SendMessage(Info.HWND, Msg, WPARAM, wParam); 262 | end; 263 | end; 264 | 265 | initialization 266 | 267 | finalization 268 | // Auto close semaphore 269 | if SemaforCreated then 270 | UnlockSemaphore; 271 | 272 | // Auto close mapping 273 | if HasAppInfo then 274 | CloseAppInfo; 275 | end. -------------------------------------------------------------------------------- /Dependencies/Cod.Internet.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codruts Internet Utilities } 3 | { } 4 | { version 0.2 } 5 | { ALPHA } 6 | { } 7 | { } 8 | { } 9 | { } 10 | { } 11 | { -- WORK IN PROGRESS -- } 12 | {***********************************************************} 13 | 14 | {$SCOPEDENUMS ON} 15 | 16 | unit Cod.Internet; 17 | 18 | interface 19 | uses 20 | System.SysUtils, System.Classes, IdHTTP, IdSSLOpenSSL, IdIcmpClient, Types, 21 | {$IFDEF MSWINDOWS} 22 | Windows, Vcl.Graphics, Vcl.Imaging.jpeg, Vcl.Imaging.GIFImg, Vcl.Imaging.pngimage, 23 | URLMon, ActiveX, Variants, Winapi.IpTypes, Winapi.IpHlpApi, Win.ComObj, 24 | {$ENDIF} 25 | IOUtils, Cod.Files, Cod.StringUtils, Cod.MesssageConst; 26 | 27 | type 28 | // Types 29 | TNetworkProtocol = (Unknown, TCP, UDP); 30 | TNetworkProtocolHelper = record helper for TNetworkProtocol 31 | public 32 | class function FromString(Value: string): TNetworkProtocol; static; 33 | 34 | function ToString: string; 35 | end; 36 | 37 | // Net utils 38 | {$IFDEF MSWINDOWS} 39 | function GetAdapterDescription: string; 40 | function GetGatewayIP: string; 41 | function GetLocalIP: string; 42 | {$ENDIF} 43 | 44 | // UPnP 45 | {$IFDEF MSWINDOWS} 46 | function RegisterUPnPPort(const Port: Word; const Protocol: TNetworkProtocol; const Description: string): boolean; 47 | function UnregisterUPnPPort(const Port: Word; const Protocol: TNetworkProtocol): boolean; 48 | {$ENDIF} 49 | 50 | // General 51 | function DownloadFile(Source, Destination: string): Boolean; 52 | function GetInternetStream(URL: string; downloadfallback: boolean = true): TStream; 53 | {$IFDEF MSWINDOWS} 54 | function GetInternetImage(ImageURL: string; downloadfallback: boolean = true): TGraphic; overload; 55 | procedure GetInternetImage(ImageURL: string; var Image: TGraphic; downloadfallback: boolean = true); overload; 56 | {$ENDIF} 57 | 58 | // Devices 59 | function PingDevice(Destination: string): boolean; 60 | 61 | // Util 62 | function DownloadFileHTTP(Source, Destination: string): Boolean; 63 | {$IFDEF MSWINDOWS} 64 | function DownloadFileMon(Source, Destination: string): Boolean; 65 | {$ENDIF} 66 | 67 | // String Data 68 | function MaskEmailAdress(Adress: string): string; 69 | 70 | // Utils 71 | function AnsiCharArrayToString(AnsiChars: array of AnsiChar): AnsiString; 72 | 73 | implementation 74 | 75 | function AnsiCharArrayToString(AnsiChars: array of AnsiChar): AnsiString; 76 | begin 77 | Result := Copy(AnsiChars, 0, Length(AnsiChars)); 78 | end; 79 | 80 | {$IFDEF MSWINDOWS} 81 | function GetAdapterDescription: string; 82 | var 83 | AdapterInfo: PIP_ADAPTER_INFO; 84 | BufLen: ULONG; 85 | Res: DWORD; 86 | P: PIP_ADAPTER_INFO; 87 | begin 88 | Result := '0.0.0.0'; 89 | BufLen := 0; 90 | GetAdaptersInfo(nil, BufLen); // First call to get required buffer size 91 | GetMem(AdapterInfo, BufLen); 92 | try 93 | Res := GetAdaptersInfo(AdapterInfo, BufLen); 94 | if Res = ERROR_SUCCESS then 95 | begin 96 | P := AdapterInfo; 97 | Result := string(AnsiCharArrayToString(P.Description)); 98 | end; 99 | finally 100 | FreeMem(AdapterInfo); 101 | end; 102 | end; 103 | 104 | function GetGatewayIP: string; 105 | var 106 | AdapterInfo: PIP_ADAPTER_INFO; 107 | BufLen: ULONG; 108 | Res: DWORD; 109 | P: PIP_ADAPTER_INFO; 110 | begin 111 | Result := '0.0.0.0'; 112 | BufLen := 0; 113 | GetAdaptersInfo(nil, BufLen); // First call to get required buffer size 114 | GetMem(AdapterInfo, BufLen); 115 | try 116 | Res := GetAdaptersInfo(AdapterInfo, BufLen); 117 | if Res = ERROR_SUCCESS then 118 | begin 119 | P := AdapterInfo; 120 | while P <> nil do begin 121 | if (P^.GatewayList.IpAddress.S[0] <> #0) and 122 | (AnsiCharArrayToString(P^.GatewayList.IpAddress.S) <> '0.0.0.0') then 123 | begin 124 | Result := string(AnsiCharArrayToString(P^.GatewayList.IpAddress.S)); 125 | Break; 126 | end; 127 | P := P^.Next; 128 | end; 129 | end; 130 | finally 131 | FreeMem(AdapterInfo); 132 | end; 133 | end; 134 | 135 | function GetLocalIP: string; 136 | var 137 | AdapterInfo: PIP_ADAPTER_INFO; 138 | BufLen: ULONG; 139 | Res: DWORD; 140 | P: PIPAdapterInfo; 141 | begin 142 | Result := '127.0.0.1'; 143 | BufLen := 0; 144 | GetAdaptersInfo(nil, BufLen); // First call to get required buffer size 145 | GetMem(AdapterInfo, BufLen); 146 | try 147 | Res := GetAdaptersInfo(AdapterInfo, BufLen); 148 | if Res = ERROR_SUCCESS then 149 | begin 150 | P := AdapterInfo; 151 | while P <> nil do begin 152 | if (P^.IpAddressList.IpAddress.S[0] <> #0) and 153 | (AnsiCharArrayToString(P^.IpAddressList.IpAddress.S) <> '0.0.0.0') then 154 | begin 155 | Result := string(AnsiCharArrayToString(P^.IpAddressList.IpAddress.S)); 156 | Break; 157 | end; 158 | P := P^.Next; 159 | end; 160 | end; 161 | finally 162 | FreeMem(AdapterInfo); 163 | end; 164 | end; 165 | {$ENDIF} 166 | 167 | {$IFDEF MSWINDOWS} 168 | function RegisterUPnPPort(const Port: Word; const Protocol: TNetworkProtocol; const Description: string): boolean; 169 | const 170 | CLSID_UPnPNAT = '{AE1E00AA-3FD5-403C-8A27-2BBDC30CD0E1}'; 171 | var 172 | UPnPNAT: OleVariant; 173 | Mappings: OleVariant; 174 | begin 175 | Result := false; 176 | if Protocol = TNetworkProtocol.Unknown then 177 | raise Exception.Create('Unknown network protocol.'); 178 | 179 | UPnPNAT := CreateOleObject('HNetCfg.NATUPnP'); 180 | Mappings := UPnPNAT.StaticPortMappingCollection; 181 | if not VarIsNull(Mappings) then 182 | try 183 | // Add the port mapping 184 | Mappings.Add(Port, Protocol.ToString, Port, GetLocalIP, True, Description); 185 | Result := true; 186 | except 187 | Result := false; 188 | end; 189 | end; 190 | 191 | function UnregisterUPnPPort(const Port: Word; const Protocol: TNetworkProtocol): boolean; 192 | const 193 | CLSID_UPnPNAT = '{AE1E00AA-3FD5-403C-8A27-2BBDC30CD0E1}'; 194 | var 195 | UPnPNAT: OleVariant; 196 | Mappings: OleVariant; 197 | begin 198 | Result := false; 199 | if Protocol = TNetworkProtocol.Unknown then 200 | raise Exception.Create('Unknown network protocol.'); 201 | 202 | UPnPNAT := CreateOleObject('HNetCfg.NATUPnP'); 203 | Mappings := UPnPNAT.StaticPortMappingCollection; 204 | if not VarIsNull(Mappings) then 205 | // Remove mapping 206 | try 207 | Result := Mappings.Remove(Port, Protocol.ToString) = S_OK; 208 | except 209 | Result := false; 210 | end; 211 | end; 212 | {$ENDIF} 213 | 214 | function DownloadFile(Source, Destination: string): Boolean; 215 | begin 216 | Result := false; 217 | 218 | // Attempt 1 - IDHTTP 219 | if DownloadFileHTTP( Source, Destination ) then 220 | Exit(true); 221 | 222 | {$IFDEF MSWINDOWS} 223 | // Attempt 2 - UrlMon 224 | if DownloadFileMon( Source, Destination) then 225 | Exit(true); 226 | {$ENDIF} 227 | end; 228 | 229 | function PingDevice(Destination: string): boolean; 230 | var 231 | Icmp: TIdIcmpClient; 232 | begin 233 | Icmp := TIdIcmpClient.Create(nil); 234 | try 235 | Icmp.Host := Destination; 236 | Icmp.ReceiveTimeout := 1000; // 1 second timeout 237 | Icmp.Ping; 238 | 239 | // Icmp.ReplyStatus.MsRoundTripTime.ToString is the response time in ms 240 | 241 | Result := Icmp.ReplyStatus.ReplyStatusType = rsEcho; 242 | finally 243 | Icmp.Free; 244 | end; 245 | end; 246 | 247 | function DownloadFileHTTP(Source, Destination: string): Boolean; 248 | var 249 | HTTP: TIdHTTP; 250 | SSLIOHandler: TIdSSLIOHandlerSocketOpenSSL; 251 | FileStream: TFileStream; 252 | begin 253 | try 254 | // Attempt 1 - IDHTTP 255 | HTTP := TIdHTTP.Create(nil); 256 | SSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP); 257 | SSLIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2]; 258 | HTTP.IOHandler := SSLIOHandler; 259 | 260 | FileStream := TFileStream.Create(Destination, fmCreate); 261 | try 262 | HTTP.Get(Source, FileStream); 263 | 264 | Result := TFile.Exists(Destination); 265 | finally 266 | HTTP.Free; 267 | FileStream.Free; 268 | end; 269 | except 270 | Result := false; 271 | end; 272 | end; 273 | 274 | {$IFDEF MSWINDOWS} 275 | function DownloadFileMon(Source, Destination: string): Boolean; 276 | begin 277 | try 278 | Result := UrlDownloadToFile( nil, PChar(source), PChar( Destination ) , 0, nil ) = 0; 279 | except 280 | Result := False; 281 | end; 282 | end; 283 | {$ENDIF} 284 | 285 | function GetInternetStream(URL: string; downloadfallback: boolean = true): TStream; 286 | var 287 | HTTP: TIdHTTP; 288 | SSLIOHandler: TIdSSLIOHandlerSocketOpenSSL; 289 | begin 290 | // Create stream 291 | Result := TMemoryStream.Create; 292 | 293 | // Create HTTP 294 | HTTP := TIdHTTP.Create; 295 | SSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP); 296 | SSLIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2]; 297 | HTTP.IOHandler := SSLIOHandler; 298 | try 299 | try 300 | // Get Image 301 | HTTP.Get(URL, Result); 302 | Result.Position := 0; 303 | except 304 | // Fallback 305 | if downloadfallback then begin 306 | const FilePath = 'C:\Windows\Temp\tempinternetstream' + GenerateString(10, [TStrGenFlag.LowercaseLetters, TStrGenFlag.Numbers]); 307 | if not DownloadFile(URL, FilePath) then 308 | Exit; 309 | 310 | // Load 311 | const FS = TFileStream.Create(FilePath, fmOpenRead); 312 | try 313 | Result.CopyFrom(FS, FS.Size); 314 | TFile.Delete(FilePath); 315 | finally 316 | FS.Free; 317 | end; 318 | end; 319 | end; 320 | finally 321 | // Free 322 | HTTP.Free; 323 | end; 324 | end; 325 | 326 | {$IFDEF MSWINDOWS} 327 | function GetInternetImage(ImageURL: string; downloadfallback: boolean = true): TGraphic; 328 | var 329 | ext: string; 330 | begin 331 | ext := Copy(ImageURL, ImageURL.LastIndexOf('.') + 2, ImageURL.Length); 332 | 333 | if ext = 'bmp' then 334 | Result := TBitMap.Create 335 | else 336 | if ext = 'png' then 337 | Result := TPngImage.Create 338 | else 339 | if (ext = 'jpg') or (ext = 'jpeg') then 340 | Result := TJpegImage.Create 341 | else 342 | if ext = 'gif' then 343 | Result := TGifImage.Create 344 | else 345 | {Graphic := TGraphic.Create;}Result := TPngImage.Create; // Default network image 346 | 347 | GetInternetImage(ImageURL, Result, downloadfallback); 348 | end; 349 | 350 | procedure GetInternetImage(ImageURL: string; var Image: TGraphic; downloadfallback: boolean = true); 351 | var 352 | MS : TMemoryStream; 353 | HTTP: TIdHTTP; 354 | SSLIOHandler: TIdSSLIOHandlerSocketOpenSSL; 355 | fname: string; 356 | begin 357 | // Create stream 358 | MS := TMemoryStream.Create; 359 | HTTP := TIdHTTP.Create; 360 | SSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP); 361 | SSLIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2]; 362 | HTTP.IOHandler := SSLIOHandler; 363 | 364 | try 365 | try 366 | // Get Image 367 | HTTP.Get(ImageURL, MS); 368 | Ms.Seek(0, soFromBeginning); 369 | Image.LoadFromStream(MS); 370 | except 371 | 372 | // Fallback 373 | if downloadfallback then 374 | begin 375 | fname := 'C:\Windows\Temp\tempinternetimg' + ValidateFileName(Copy(ImageURL, ImageURL.LastIndexOf('.') + 1, ImageURL.Length)); 376 | if DownloadFile(ImageURL, fname) then 377 | try 378 | Image.LoadFromFile(fname); 379 | except 380 | RaiseLastOSError; 381 | end; 382 | 383 | TFile.Delete(fname); 384 | end; 385 | end; 386 | finally 387 | // Free Memory 388 | FreeAndNil(MS); 389 | HTTP.Free; 390 | end; 391 | end; 392 | {$ENDIF} 393 | 394 | function MaskEmailAdress(Adress: string): string; 395 | var 396 | First, Second: string; 397 | I: Integer; 398 | begin 399 | First := Copy( Adress, 1, Pos('@', Adress) -1); 400 | Second := Copy( Adress, Pos('@', Adress), length(Adress)); 401 | 402 | for I := Low(First) + 1 to High(First) - 1 do 403 | First[I] := '*'; 404 | 405 | Result := First + Second; 406 | end; 407 | 408 | { TNetworkProtocolHelper } 409 | 410 | class function TNetworkProtocolHelper.FromString( 411 | Value: string): TNetworkProtocol; 412 | begin 413 | Result := TNetworkProtocol.Unknown; 414 | Value := Value.ToLower; 415 | 416 | for var X := Low(TNetworkProtocol) to High(TNetworkProtocol) do 417 | if X.ToString.ToLower = Value then 418 | Exit( X ); 419 | end; 420 | 421 | function TNetworkProtocolHelper.ToString: string; 422 | begin 423 | case Self of 424 | TNetworkProtocol.Unknown: Exit( UNKNOWN ); 425 | TNetworkProtocol.TCP: Exit('TCP'); 426 | TNetworkProtocol.UDP: Exit('UDP'); 427 | end; 428 | end; 429 | 430 | end. -------------------------------------------------------------------------------- /Dependencies/Cod.MesssageConst.pas: -------------------------------------------------------------------------------- 1 | unit Cod.MesssageConst; 2 | 3 | interface 4 | 5 | const // do not localise 6 | // Value 7 | NOT_NUMBER = 'NaN'; 8 | UNKNOWN = 'unknown'; 9 | 10 | resourcestring 11 | // Values 12 | STRING_YES = 'yes'; 13 | STRING_NO = 'no'; 14 | STRING_UNKNOWN = 'Unknown'; 15 | NOT_FOUND = 'Not Found'; 16 | NOT_DEFINED = 'Not Defined'; 17 | 18 | // General 19 | DEFAULT_COMPANY = 'Codrut Software'; // do not localise 20 | 21 | // Errors 22 | ERROR_MANIFEST_NOTFOUND = 'Manifest for "%S" not found.'; 23 | ERROR_SET_WALLPAPER = 'Failed to set wallpaper.'; 24 | ERROR_OUT_OF_RANGE = 'The index "%U" exceeds the bounds of the the array.'; 25 | 26 | implementation 27 | 28 | end. -------------------------------------------------------------------------------- /Dependencies/Cod.SysExtras.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codrut System Extras } 3 | { } 4 | { version 0.4 } 5 | { ALPHA } 6 | { } 7 | { } 8 | { } 9 | { } 10 | { } 11 | { -- WORK IN PROGRESS -- } 12 | {***********************************************************} 13 | 14 | unit Cod.SysExtras; 15 | 16 | interface 17 | uses 18 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, 19 | Vcl.Graphics, Variants, Vcl.Clipbrd, IOUtils, ShellAPI, Cod.Files, 20 | Vcl.Forms, IdHTTP, IdSSLOpenSSL, Cod.StringUtils, DateUtils, 21 | Cod.ByteUtils, Cod.Types, Imaging.pngimage, Imaging.jpeg, Imaging.GIFImg, 22 | MMSystem; 23 | 24 | type 25 | TBeepType = (bpInformation, bpError, bpConfirmation, bpWarning); 26 | 27 | // System 28 | procedure SystemBeep(BeepType: TBeepType); 29 | function GetWallpaperFileName(): string; 30 | procedure OperationCompletedSuccessfully(); 31 | 32 | // Audio 33 | procedure PlayResourceSound(ResourceName: string; Flags: cardinal); 34 | 35 | // Network 36 | function GetRandomIntegerAPI(Min: int64 = 0; Max: int64 = 100): int64; 37 | function GetRandomIntegersAPI(Min: int64 = 0; Max: int64 = 100; Count: integer = 1): TArray; 38 | 39 | // Programs 40 | procedure TerminateApplication(ExeName: string; Force: boolean = false; KillChildren: boolean = false); 41 | 42 | // Explorer 43 | procedure RevealFileExplorer(FilePath: string); 44 | 45 | // Image 46 | procedure LoadPictureFileSignature(FileName: string; var BitMap: TBitMap); 47 | procedure LoadGraphicAsBitmap(FileName: string; var BitMap: TBitMap); 48 | procedure MsPaintEditPicture(PicturePath: string); 49 | 50 | // DLL 51 | procedure OpenWindowsPhotoViewer(ToPath: string); 52 | 53 | var 54 | LastRandomRequest: TTime = 0; 55 | 56 | implementation 57 | 58 | procedure SystemBeep(BeepType: TBeepType); 59 | begin 60 | case BeepType of 61 | TBeepType.bpInformation: MessageBeep(0); 62 | TBeepType.bpError: MessageBeep(20); 63 | TBeepType.bpConfirmation: MessageBeep(70); 64 | TBeepType.bpWarning: MessageBeep(50); 65 | end; 66 | end; 67 | 68 | function GetWallpaperFileName(): string; 69 | var 70 | Wallpaper: array[0..MAX_PATH - 1] of Char; 71 | begin 72 | if SystemParametersInfo(SPI_GETDESKWALLPAPER, Length(Wallpaper), @Wallpaper[0], 1) then 73 | Result := Wallpaper 74 | else 75 | Result := ''; 76 | end; 77 | 78 | procedure OperationCompletedSuccessfully(); 79 | resourcestring 80 | ErrInf = '%S%S'; 81 | var 82 | Error: EOSError; 83 | begin 84 | Error := EOSError.CreateResFmt(@ErrInf, [SysErrorMessage(0), '']); 85 | 86 | raise Error at ReturnAddress; 87 | end; 88 | 89 | procedure PlayResourceSound(ResourceName: string; Flags: cardinal); 90 | var 91 | ResStream: TResourceStream; 92 | begin 93 | ResStream := TResourceStream.Create(HInstance, ResourceName, RT_RCDATA); 94 | 95 | try 96 | ResStream.Position := 0; 97 | SndPlaySound(ResStream.Memory, SND_MEMORY or Flags); 98 | finally 99 | ResStream.Free; 100 | end; 101 | end; 102 | 103 | function GetRandomIntegerAPI(Min: int64; Max: int64): int64; 104 | begin 105 | Result := GetRandomIntegersAPI(Min, Max, 1)[0]; 106 | end; 107 | 108 | function GetRandomIntegersAPI(Min: int64; Max: int64; Count: integer): TArray; 109 | (* Random.org provided random number *) 110 | var 111 | FHTTP: TIdHTTP; 112 | Request, 113 | HTTPResponse: string; 114 | ResItems: TArray; 115 | 116 | I, MsTime: integer; 117 | begin 118 | // Count 119 | SetLength(Result, Count); 120 | 121 | // Creade IdHTTP 122 | FHTTP := TIdHTTP.Create(nil); 123 | FHTTP.Request.AcceptLanguage := 'en'; 124 | FHTTP.Request.UserAgent := 'Mozilla/5.0'; 125 | FHTTP.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil); 126 | (TIdSSLIOHandlerSocketOpenSSL(FHTTP.IOHandler)).SSLOptions.SSLVersions := [sslvTLSv1_2]; 127 | 128 | try 129 | // Prepare 130 | Request := 'https://www.random.org/integers/?col=1&base=10&format=plain'; 131 | Request := Request + '&num=' + Count.ToString + '&min=' + min.ToString + '&max=' + Max.ToString; 132 | 133 | // Avoid Server Overload 134 | MsTime := MillisecondsBetween(LastRandomRequest, Now); 135 | if (MsTime < 1000) and (LastRandomRequest <> 0) then 136 | Sleep(1000 - MsTime); 137 | 138 | // Ping 139 | HTTPResponse := FHTTP.Get(Request); 140 | 141 | // Last Request 142 | LastRandomRequest := Now; 143 | 144 | // Parse 145 | ResItems := GetAllSeparatorItems(HTTPResponse, #$A); 146 | for I := 0 to High(Result) do 147 | Result[I] := ResItems[I].ToInt64; 148 | finally 149 | // Free 150 | FHTTP.Free; 151 | end; 152 | end; 153 | 154 | procedure TerminateApplication(ExeName: string; Force: boolean = false; KillChildren: boolean = false); 155 | var 156 | parameters: string; 157 | begin 158 | // Default 159 | parameters := '/im'; 160 | 161 | parameters := parameters + ' ' + ExeName; 162 | 163 | // Extra param 164 | if Force then 165 | parameters := parameters + ' /f'; 166 | 167 | if KillChildren then 168 | parameters := parameters + ' /t'; 169 | 170 | ShellExecute(0, 'open', 'taskkill', PChar(parameters), nil, 0); 171 | end; 172 | 173 | procedure RevealFileExplorer(FilePath: string); 174 | begin 175 | ShellExecute(0, 'open', 'explorer.exe', PChar(Format('/select, %S', [FilePath])), nil, 1); 176 | end; 177 | 178 | procedure LoadPictureFileSignature(FileName: string; var BitMap: TBitMap); 179 | var 180 | Sign: TFileType; 181 | G: TGraphic; 182 | begin 183 | Sign := ReadFileSignature(FileName); 184 | 185 | case Sign of 186 | TFileType.BMP: BitMap.LoadFromFile(FileName); 187 | TFileType.PNG: begin 188 | G := TPngImage.Create; 189 | try 190 | G.LoadFromFile(FileName); 191 | 192 | BitMap.Assign(G); 193 | finally 194 | G.Free; 195 | end; 196 | end; 197 | TFileType.JPEG: begin 198 | G := TJPEGImage.Create; 199 | try 200 | G.LoadFromFile(FileName); 201 | 202 | BitMap.Assign(G); 203 | finally 204 | G.Free; 205 | end; 206 | end; 207 | TFileType.GIF: begin 208 | G := TGifImage.Create; 209 | try 210 | G.LoadFromFile(FileName); 211 | 212 | BitMap.Assign(G); 213 | finally 214 | G.Free; 215 | end; 216 | end; 217 | //dftHEIC: ; 218 | //dftTIFF: ; 219 | end; 220 | end; 221 | 222 | procedure LoadGraphicAsBitmap(FileName: string; var BitMap: TBitMap); 223 | var 224 | P: TPicture; 225 | begin 226 | // Determine File Type 227 | P := TPicture.Create; 228 | BitMap := TBitMap.Create; 229 | BitMap.PixelFormat := pf32bit; 230 | Bitmap.TransparentMode := tmAuto; 231 | try 232 | BitMap.Canvas.Lock; 233 | try 234 | // Load 235 | P.LoadFromFile(FileName); 236 | 237 | // Assign 238 | BitMap.Assign(P.Graphic); 239 | finally 240 | BitMap.Canvas.Unlock; 241 | end; 242 | finally 243 | // Free Mem 244 | P.Free; 245 | end; 246 | end; 247 | 248 | procedure MsPaintEditPicture(PicturePath: string); 249 | var 250 | mspath: string; 251 | begin 252 | mspath := ReplaceWinPath('%localappdata%\Microsoft\WindowsApps\') + 'mspaint.exe'; 253 | 254 | ShellExecute(0, nil, PChar(mspath), 255 | PChar('"' + PicturePath + '"'), nil, 1); 256 | end; 257 | 258 | procedure OpenWindowsPhotoViewer(ToPath: string); 259 | begin 260 | ShellExecute(0, 'open', PWideChar(ReplaceWinPath('%systemroot%\System32\rundll32.exe')), PChar('"PhotoViewer.dll", ImageView_Fullscreen ' + ToPath), 'C:\Program Files\Windows Photo Viewer\', 1); 261 | end; 262 | 263 | 264 | 265 | end. -------------------------------------------------------------------------------- /Dependencies/Cod.TimeUtils.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codruts Time Utilities } 3 | { } 4 | { version 0.2 } 5 | { ALPHA } 6 | { } 7 | { } 8 | { } 9 | { } 10 | { } 11 | { -- WORK IN PROGRESS -- } 12 | {***********************************************************} 13 | 14 | unit Cod.TimeUtils; 15 | 16 | {$SCOPEDENUMS ON} 17 | 18 | interface 19 | uses 20 | {$IFDEF MSWINDOWS}Winapi.Windows, Winapi.Messages, Registry, {$ENDIF}System.SysUtils, System.Classes, IdSNTP, 21 | DateUtils, Cod.Types; 22 | 23 | const 24 | DEFAULT_SERVER = 'time.windows.com'; 25 | 26 | TIMESERVER_LOCATION = 'SOFTWARE\Microsoft\Windows\CurrentVersion\DateTime\Servers'; 27 | 28 | type 29 | TDateValueType = (Year, Month, Week, Day, Hour, Minute, Second, Millisecond); 30 | 31 | (* Time-Date Utilities *) 32 | procedure DateTimePassed(Time1, Time2: TDateTime; var Years, Months, Days, Hours, Minutes, Seconds, Milliseconds: cardinal); 33 | 34 | (* String *) 35 | function TimePassedToString(Seconds: cardinal): string; 36 | function DateTimePassedString(Time1, Time2: TDateTime; IncludeMilliseconds: boolean = false; Acronym: boolean = false): string; 37 | // Converts a value type to a formatted string. Such as 4 = "4 Minutes" 38 | function DateValueToString(Value: integer; AType: TDateValueType; Acronym: boolean = false): string; 39 | 40 | (* DateUtils supplement *) 41 | function RecodeWeek(const AValue: TDateTime; const AWeek: Word): TDateTime; 42 | 43 | (* Networking *) 44 | function SyncInternetTime(timeserver: string = DEFAULT_SERVER): boolean; 45 | function GetInternetTime(timeserver: string = DEFAULT_SERVER): TDateTime; 46 | 47 | function PingTimeServer(timeserver: string = DEFAULT_SERVER): boolean; 48 | 49 | {$IFDEF MSWINDOWS} 50 | function GetWindowsTimeServer(Secondary: boolean = false): string; 51 | {$ENDIF} 52 | 53 | var 54 | STR_YEAR: string = 'Year'; 55 | STR_YEAR_P: string = 'Years'; 56 | STR_YEAR_A: string = 'y'; 57 | 58 | STR_MONTH: string = 'Month'; 59 | STR_MONTH_P: string = 'Months'; 60 | STR_MONTH_A: string = 'm'; 61 | 62 | STR_WEEK: string = 'Week'; 63 | STR_WEEK_P: string = 'Weeks'; 64 | STR_WEEK_A: string = 'w'; 65 | 66 | STR_DAY: string = 'Day'; 67 | STR_DAY_P: string = 'Days'; 68 | STR_DAY_A: string = 'd'; 69 | 70 | STR_HOUR: string = 'Hour'; 71 | STR_HOUR_P: string = 'Hours'; 72 | STR_HOUR_A: string = 'h'; 73 | 74 | STR_MINUTE: string = 'Minute'; 75 | STR_MINUTE_P: string = 'Minutes'; 76 | STR_MINUTE_A: string = 'm'; 77 | 78 | STR_SECOND: string = 'Second'; 79 | STR_SECOND_P: string = 'Seconds'; 80 | STR_SECOND_A: string = 's'; 81 | 82 | STR_MILLISECOND: string = 'Millisecond'; 83 | STR_MILLISECOND_P: string = 'Milliseconds'; 84 | STR_MILLISECOND_A: string = 'ms'; 85 | 86 | implementation 87 | 88 | procedure DateTimePassed(Time1, Time2: TDateTime; var Years, Months, Days, Hours, Minutes, Seconds, Milliseconds: cardinal); 89 | var 90 | ATemp: TDateTime; 91 | begin 92 | // Reverse 93 | if Time1 > Time2 then 94 | begin 95 | ATemp := Time1; 96 | Time1 := Time2; 97 | Time2 := ATemp; 98 | end; 99 | 100 | // Get Data 101 | Years := YearsBetween(Time1, Time2); 102 | Time1 := IncYear(Time1, Years); 103 | 104 | Months := MonthsBetween(Time1, Time2); 105 | Time1 := IncMonth(Time1, Months); 106 | 107 | Days := DaysBetween(Time1, Time2); 108 | Time1 := IncDay(Time1, Days); 109 | 110 | Hours := HoursBetween(Time1, Time2); 111 | Time1 := IncHour(Time1, Hours); 112 | 113 | Minutes := MinutesBetween(Time1, Time2); 114 | Time1 := IncMinute(Time1, Minutes); 115 | 116 | Seconds := SecondsBetween(Time1, Time2); 117 | Time1 := IncSecond(Time1, Seconds); 118 | 119 | Milliseconds := MillisecondsBetween(Time1, Time2); 120 | end; 121 | 122 | function TimePassedToString(Seconds: cardinal): string; 123 | var 124 | Minutes, Hours: cardinal; 125 | begin 126 | Minutes := Seconds div 60; 127 | Seconds := Seconds - Minutes * 60; 128 | 129 | Hours := Minutes div 60; 130 | Minutes := Minutes - Hours * 60; 131 | 132 | Result := IntToStrIncludePrefixZeros(Minutes, 2) + ':' + IntToStrIncludePrefixZeros(Seconds, 2); 133 | 134 | if Hours > 0 then 135 | Result := IntToStrIncludePrefixZeros(Hours, 2) + ':' + Result; 136 | end; 137 | 138 | function DateTimePassedString(Time1, Time2: TDateTime; IncludeMilliseconds: boolean; Acronym: boolean): string; 139 | var 140 | Years, Months, Days, Hours, Minutes, Seconds, Milliseconds: cardinal; 141 | Began: boolean; 142 | function CheckBegan(Value: integer): boolean; 143 | begin 144 | if not Began then 145 | Began := Value > 0; 146 | 147 | Result := Began; 148 | end; 149 | begin 150 | DateTimePassed(Time1, Time2, Years, Months, Days, Hours, Minutes, Seconds, Milliseconds); 151 | 152 | Result := ''; 153 | Began := false; 154 | 155 | if CheckBegan(Years) then 156 | Result := Concat(Result, DateValueToString(Years, TDateValueType.Year, Acronym), ', '); 157 | 158 | if CheckBegan(Months) then 159 | Result := Concat(Result, DateValueToString(Months, TDateValueType.Month, Acronym), ', '); 160 | 161 | if CheckBegan(Days) then 162 | Result := Concat(Result, DateValueToString(Days, TDateValueType.Day, Acronym), ', '); 163 | 164 | if CheckBegan(Hours) then 165 | Result := Concat(Result, DateValueToString(Hours, TDateValueType.Hour, Acronym), ', '); 166 | 167 | if CheckBegan(Minutes) then 168 | Result := Concat(Result, DateValueToString(Minutes, TDateValueType.Minute, Acronym), ', '); 169 | 170 | // Seconds alwayss active 171 | Result := Concat(Result, DateValueToString(Seconds, TDateValueType.Second, Acronym)); 172 | if IncludeMilliseconds then 173 | begin 174 | Result := Concat(Result, ', ', DateValueToString(Milliseconds, TDateValueType.Millisecond, Acronym)); 175 | end; 176 | end; 177 | 178 | function DateValueToString(Value: integer; AType: TDateValueType; Acronym: boolean): string; 179 | var 180 | PostFix: string; 181 | IsOne: boolean; 182 | begin 183 | IsOne := Value = 1; 184 | 185 | case AType of 186 | TDateValueType.Year: if Acronym then 187 | PostFix := STR_YEAR_A 188 | else 189 | if IsOne then 190 | PostFix := STR_YEAR 191 | else 192 | PostFix := STR_YEAR_P; 193 | 194 | TDateValueType.Month: if Acronym then 195 | PostFix := STR_MONTH_A 196 | else 197 | if IsOne then 198 | PostFix := STR_MONTH 199 | else 200 | PostFix := STR_MONTH_P; 201 | 202 | TDateValueType.Week: if Acronym then 203 | PostFix := STR_WEEK_A 204 | else 205 | if IsOne then 206 | PostFix := STR_WEEK 207 | else 208 | PostFix := STR_WEEK_P; 209 | 210 | TDateValueType.Day: if Acronym then 211 | PostFix := STR_DAY_A 212 | else 213 | if IsOne then 214 | PostFix := STR_DAY 215 | else 216 | PostFix := STR_DAY_P; 217 | 218 | TDateValueType.Hour: if Acronym then 219 | PostFix := STR_HOUR_A 220 | else 221 | if IsOne then 222 | PostFix := STR_HOUR 223 | else 224 | PostFix := STR_HOUR_P; 225 | 226 | TDateValueType.Minute: if Acronym then 227 | PostFix := STR_MINUTE_A 228 | else 229 | if IsOne then 230 | PostFix := STR_MINUTE 231 | else 232 | PostFix := STR_MINUTE_P; 233 | 234 | TDateValueType.Second: if Acronym then 235 | PostFix := STR_SECOND_A 236 | else 237 | if IsOne then 238 | PostFix := STR_SECOND 239 | else 240 | PostFix := STR_SECOND_P; 241 | 242 | TDateValueType.Millisecond: if Acronym then 243 | PostFix := STR_MILLISECOND_A 244 | else 245 | if IsOne then 246 | PostFix := STR_MILLISECOND 247 | else 248 | PostFix := STR_MILLISECOND_P; 249 | end; 250 | 251 | if not Acronym then 252 | PostFix := ' ' + PostFix; 253 | 254 | Result := Format('%D%S', [Value, Postfix]); 255 | end; 256 | 257 | function RecodeWeek(const AValue: TDateTime; const AWeek: Word): TDateTime; 258 | begin 259 | Result := IncWeek(AValue, 260 | AWeek-WeekOf(AValue) 261 | ); 262 | end; 263 | 264 | function SyncInternetTime(timeserver: string = DEFAULT_SERVER): boolean; 265 | var 266 | SNTPClient: TIdSNTP; 267 | begin 268 | SNTPClient := TIdSNTP.Create(nil); 269 | try 270 | SNTPClient.Host := timeserver; 271 | Result := SNTPClient.SyncTime; 272 | finally 273 | SNTPClient.Free; 274 | end; 275 | end; 276 | 277 | function GetInternetTime(timeserver: string = 'time.windows.com'): TDateTime; 278 | var 279 | SNTPClient: TIdSNTP; 280 | begin 281 | SNTPClient := TIdSNTP.Create(nil); 282 | try 283 | SNTPClient.Host := 'time.windows.com'; 284 | Result := SNTPClient.DateTime; 285 | finally 286 | SNTPClient.Free; 287 | end; 288 | end; 289 | 290 | function PingTimeServer(timeserver: string = 'time.windows.com'): boolean; 291 | var 292 | SNTPClient: TIdSNTP; 293 | begin 294 | SNTPClient := TIdSNTP.Create(nil); 295 | try 296 | SNTPClient.Host := timeserver; 297 | try 298 | SNTPClient.Connect; 299 | Result := SNTPClient.Connected; 300 | 301 | SNTPClient.Disconnect; 302 | except 303 | Result := false; 304 | end; 305 | finally 306 | SNTPClient.Free; 307 | end; 308 | end; 309 | 310 | {$IFDEF MSWINDOWS} 311 | function GetWindowsTimeServer(Secondary: boolean): string; 312 | var 313 | R: TRegistry; 314 | Value: string; 315 | begin 316 | Result := DEFAULT_SERVER; 317 | R := TRegistry.Create(KEY_READ); 318 | try 319 | R.RootKey := HKEY_LOCAL_MACHINE; 320 | R.OpenKeyReadOnly(TIMESERVER_LOCATION); 321 | 322 | if Secondary then 323 | Value := '2' 324 | else 325 | Value := '1'; 326 | 327 | if R.ValueExists(Value) then 328 | Result := R.ReadString(Value); 329 | finally 330 | R.Free; 331 | end; 332 | end; 333 | {$ENDIF} 334 | 335 | end. -------------------------------------------------------------------------------- /Dependencies/Cod.VarHelpers.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Codruts Variabile Helpers } 3 | { } 4 | { version 0.2 } 5 | { ALPHA } 6 | { } 7 | { } 8 | { } 9 | { } 10 | { } 11 | { -- WORK IN PROGRESS -- } 12 | {***********************************************************} 13 | 14 | {$SCOPEDENUMS ON} 15 | 16 | unit Cod.VarHelpers; 17 | 18 | interface 19 | uses 20 | System.SysUtils, System.Classes, IdHTTP, System.IniFiles, 21 | {$IFDEF MSWINDOWS} 22 | Winapi.Windows, 23 | {$ENDIF} 24 | VCL.Graphics, Winapi.ActiveX, Winapi.URLMon, IOUtils, System.Generics.Collections, 25 | Cod.ColorUtils, System.Generics.Defaults, Vcl.Imaging.pngimage, 26 | WinApi.GdipObj, WinApi.GdipApi, Win.Registry, Cod.GDI, Cod.Types, 27 | DateUtils, Cod.Registry, UITypes, Vcl.Menus, Types, Vcl.Forms, Vcl.Controls; 28 | 29 | type 30 | // Color Helper 31 | TColorHelper = record helper for TColor 32 | public 33 | function ToString: string; overload; inline; 34 | function ToInteger: integer; overload; inline; 35 | function ToRGB: CRGB; overload; inline; 36 | end; 37 | 38 | // TRect Helper 39 | TRectHelper = record helper for TRect 40 | public 41 | function GetBottomLeft: TPoint; inline; 42 | function GetTopRight: TPoint; inline; 43 | function Normalised: boolean; inline; 44 | end; 45 | 46 | // TPoint Helper 47 | TPointHelper = record helper for TPoint 48 | public 49 | function ToString: string; 50 | constructor FromString(S: string); 51 | end; 52 | 53 | // Popup Menu Helper 54 | TPopupMenuHelper = class helper for TPopupMenu 55 | public 56 | procedure Popup(P: TPoint); overload; inline; 57 | procedure PopupAtMouseCursor; overload; inline; 58 | end; 59 | 60 | // TDateTime Helper 61 | TDateTimeHelper = record helper for TDateTime 62 | public 63 | function ToString: string; overload; inline; 64 | function ToInteger: integer; overload; inline; 65 | 66 | function Day: integer; 67 | function Month: integer; 68 | function Year: integer; 69 | 70 | function Hour: integer; 71 | function Minute: integer; 72 | function Second: integer; 73 | function Millisecond: integer; 74 | end; 75 | 76 | // TFont 77 | TAdvFont = type string; 78 | 79 | TAdvFontHelper = record helper for TAdvFont 80 | function ToString: string; 81 | procedure FromString(AString: string); 82 | end; 83 | 84 | // Canvas 85 | TCanvasHelper = class helper for TCanvas 86 | procedure DrawHighQuality(ARect: TRect; Bitmap: TBitmap; Opacity: Byte = 255; HighQuality: Boolean = False); overload; 87 | procedure DrawHighQuality(ARect: TRect; Graphic: TGraphic; Opacity: Byte = 255; HighQuality: Boolean = False); overload; 88 | 89 | procedure StretchDraw(DestRect, SrcRect: TRect; Bitmap: TBitmap; Opacity: Byte); overload; 90 | procedure StretchDraw(Rect: TRect; Graphic: TGraphic; AOpacity: Byte); overload; 91 | 92 | procedure MoveTo(P: TPoint); overload; 93 | procedure LineTo(P: TPoint); overload; 94 | 95 | procedure Line(P1, P2: TPoint); 96 | 97 | procedure CopyRect(const Dest: TRect; Canvas: TCanvas; const Source: TRect; Opacity: Byte); overload; 98 | 99 | procedure GDIText(Text: string; Rectangle: TRect; AlignH: TLayout = TLayout.Beginning; AlignV: TLayout = TLayout.Beginning; Angle: integer = 0); 100 | procedure GDITint(Rectangle: TRect; Color: TColor; Opacity: byte = 75); 101 | procedure GDIRectangle(Rectangle: TRect; Brush: TGDIBrush; Pen: TGDIPen); 102 | procedure GDIRoundRect(RoundRect: TRoundRect; Brush: TGDIBrush; Pen: TGDIPen); 103 | procedure GDICircle(Rectangle: TRect; Brush: TGDIBrush; Pen: TGDIPen); 104 | procedure GDIPolygon(Points: TArray; Brush: TGDIBrush; Pen: TGDIPen); 105 | procedure GDILine(Line: TLine; Pen: TGDIPen); 106 | procedure GDIRoundedLine(Line: TLine; Pen: TGDIPen); 107 | procedure GDIRoundedCornerLine(Points: TPointsF; Pen: TGDIPen; Radius: single); overload; 108 | procedure GDIGraphic(Graphic: TGraphic; Rect: TRect); overload; 109 | procedure GDIGraphic(Graphic: TGraphic; Rect: TRect; Angle: integer); overload; 110 | procedure GDIGraphicRound(Graphic: TGraphic; Rect: TRect; Round: real); 111 | end; 112 | 113 | // TIniFile 114 | TIniFileHelper = class helper for TIniFile 115 | public 116 | function ReadString(const Section, Ident, Default: string; StringSize: integer=2047): string; overload; 117 | end; 118 | 119 | // Registry 120 | TRegHelper = Cod.Registry.TRegHelper; 121 | 122 | implementation 123 | 124 | // Color 125 | function TColorHelper.ToString: string; 126 | begin 127 | Result := colortostring( Self ); 128 | end; 129 | 130 | function TColorHelper.ToInteger: integer; 131 | begin 132 | Result := ColorToRgb( Self ); 133 | end; 134 | 135 | function TColorHelper.ToRGB: CRGB; 136 | begin 137 | Result := GetRGB( Self ); 138 | end; 139 | 140 | // Date Time 141 | function TDateTimeHelper.ToString: string; 142 | begin 143 | Result := DateTimeToStr( Self ); 144 | end; 145 | 146 | function TDateTimeHelper.ToInteger: integer; 147 | begin 148 | Result := DateTimeToUnix(Self); 149 | end; 150 | 151 | function TDateTimeHelper.Day: integer; 152 | begin 153 | Result := DayOf( Self ); 154 | end; 155 | 156 | function TDateTimeHelper.Month: integer; 157 | begin 158 | Result := MonthOf( Self ); 159 | end; 160 | 161 | function TDateTimeHelper.Year: integer; 162 | begin 163 | Result := YearOf( Self ); 164 | end; 165 | 166 | function TDateTimeHelper.Hour: integer; 167 | begin 168 | Result := HourOf( Self ); 169 | end; 170 | 171 | function TDateTimeHelper.Minute: integer; 172 | begin 173 | Result := MinuteOf( Self ); 174 | end; 175 | 176 | function TDateTimeHelper.Second: integer; 177 | begin 178 | Result := SecondOf( Self ); 179 | end; 180 | 181 | function TDateTimeHelper.Millisecond: integer; 182 | begin 183 | Result := MillisecondOf( Self ); 184 | end; 185 | 186 | // TFont 187 | function TAdvFontHelper.ToString: string; 188 | begin 189 | 190 | end; 191 | 192 | procedure TAdvFontHelper.FromString(AString: string); 193 | begin 194 | //TFont(Self). 195 | end; 196 | 197 | { TCanvasHelper } 198 | procedure TCanvasHelper.DrawHighQuality(ARect: TRect; Bitmap: TBitmap; Opacity: Byte = 255; HighQuality: Boolean = False); 199 | begin 200 | DrawGraphicHighQuality(Self, ARect, Bitmap, Opacity, HighQuality); 201 | end; 202 | 203 | procedure TCanvasHelper.DrawHighQuality(ARect: TRect; Graphic: TGraphic; Opacity: Byte = 255; HighQuality: Boolean = False); 204 | begin 205 | DrawGraphicHighQuality(Self, ARect, Graphic, Opacity, HighQuality); 206 | end; 207 | 208 | procedure TCanvasHelper.StretchDraw(DestRect, SrcRect: TRect; Bitmap: TBitmap; Opacity: Byte); 209 | begin 210 | GraphicStretchDraw( Self, DestRect, SrcRect, BitMap, Opacity); 211 | end; 212 | 213 | procedure TCanvasHelper.StretchDraw(Rect: TRect; Graphic: TGraphic; AOpacity: Byte); 214 | begin 215 | GraphicStretchDraw(Self, Rect, Graphic, AOpacity); 216 | end; 217 | 218 | procedure TCanvasHelper.CopyRect(const Dest: TRect; Canvas: TCanvas; const Source: TRect; Opacity: Byte); 219 | var 220 | BlendFunction: TBlendFunction; 221 | begin 222 | // Set up the blending parameters 223 | BlendFunction.BlendOp := AC_SRC_OVER; 224 | BlendFunction.BlendFlags := 0; 225 | BlendFunction.SourceConstantAlpha := Opacity; 226 | BlendFunction.AlphaFormat := AC_SRC_OVER; 227 | 228 | // Perform the alpha blending 229 | AlphaBlend( 230 | Self.Handle, Dest.Left, Dest.Top, Dest.Width, Dest.Height, 231 | Canvas.Handle, Source.Left, Source.Top, Source.Width, Source.Height, 232 | BlendFunction 233 | ); 234 | end; 235 | 236 | procedure TCanvasHelper.GDIText(Text: string; Rectangle: TRect; AlignH, 237 | AlignV: TLayout; Angle: integer); 238 | var 239 | AFont: TGPFont; 240 | AFormat: TGPStringFormat; 241 | FontStyle: integer; 242 | begin 243 | // Font Style 244 | FontStyle := 0; 245 | if fsBold in Font.Style then 246 | FontStyle := FontStyle or FontStyleBold; 247 | if fsItalic in Font.Style then 248 | FontStyle := FontStyle or FontStyleItalic; 249 | if fsUnderline in Font.Style then 250 | FontStyle := FontStyle or FontStyleUnderline; 251 | if fsStrikeOut in Font.Style then 252 | FontStyle := FontStyle or FontStyleStrikeout; 253 | 254 | // Font 255 | AFont := TGPFont.Create(Font.Name, Font.Size, FontStyle, UnitPixel); 256 | AFormat:= TGPStringFormat.Create; 257 | try 258 | AFormat.SetAlignment(StringAlignment(integer(AlignH))); 259 | AFormat.SetLineAlignment(StringAlignment(integer(AlignV))); 260 | 261 | // Draw 262 | DrawText(Self, Text, Rectangle, AFont, AFormat, GetRGB(Font.Color).MakeGDIBrush, Angle); 263 | finally 264 | AFont.Free; 265 | AFormat.Free; 266 | end; 267 | end; 268 | 269 | procedure TCanvasHelper.GDITint(Rectangle: TRect; Color: TColor; Opacity: byte = 75); 270 | begin 271 | TintPicture(Self, Rectangle, Color, Opacity); 272 | end; 273 | 274 | procedure TCanvasHelper.Line(P1, P2: TPoint); 275 | begin 276 | MoveTo(P1); 277 | LineTo(P2); 278 | end; 279 | 280 | procedure TCanvasHelper.LineTo(P: TPoint); 281 | begin 282 | LineTo(P.X, P.Y); 283 | end; 284 | 285 | procedure TCanvasHelper.MoveTo(P: TPoint); 286 | begin 287 | MoveTo(P.X, P.Y); 288 | end; 289 | 290 | procedure TCanvasHelper.GDIRectangle(Rectangle: TRect; Brush: TGDIBrush; 291 | Pen: TGDIPen); 292 | begin 293 | DrawRectangle(Self, Rectangle, Brush, Pen); 294 | end; 295 | 296 | procedure TCanvasHelper.GDIRoundedCornerLine(Points: TPointsF; Pen: TGDIPen; Radius: single); 297 | begin 298 | DrawRoundedCornerLine(Self, Points, Pen, Radius); 299 | end; 300 | 301 | procedure TCanvasHelper.GDIRoundedLine(Line: TLine; Pen: TGDIPen); 302 | begin 303 | DrawRoundedLine(Self, Line, Pen); 304 | end; 305 | 306 | procedure TCanvasHelper.GDIRoundRect(RoundRect: TRoundRect; Brush: TGDIBrush; Pen: TGDIPen); 307 | begin 308 | DrawRoundRect(Self, RoundRect, Brush, Pen); 309 | end; 310 | 311 | procedure TCanvasHelper.GDICircle(Rectangle: TRect; Brush: TGDIBrush; Pen: TGDIPen); 312 | begin 313 | DrawCircle(Self, Rectangle, Brush, Pen); 314 | end; 315 | 316 | procedure TCanvasHelper.GDIPolygon(Points: TArray; Brush: TGDIBrush; Pen: TGDIPen); 317 | begin 318 | DrawPolygon(Self, Points, Brush, Pen); 319 | end; 320 | 321 | procedure TCanvasHelper.GDILine(Line: TLine; Pen: TGDIPen); 322 | begin 323 | DrawLine(Self, Line, Pen); 324 | end; 325 | 326 | procedure TCanvasHelper.GDIGraphic(Graphic: TGraphic; Rect: TRect); 327 | begin 328 | DrawGraphic(Self, Graphic, Rect, 0); 329 | end; 330 | 331 | procedure TCanvasHelper.GDIGraphic(Graphic: TGraphic; Rect: TRect; Angle: integer); 332 | begin 333 | DrawGraphic(Self, Graphic, Rect, Angle); 334 | end; 335 | 336 | procedure TCanvasHelper.GDIGraphicRound(Graphic: TGraphic; Rect: TRect; Round: real); 337 | begin 338 | DrawGraphicRound(Self, Graphic, Rect, Round); 339 | end; 340 | 341 | { TRectHelper } 342 | 343 | function TRectHelper.GetBottomLeft: TPoint; 344 | begin 345 | Result := Point(Left, Bottom); 346 | end; 347 | 348 | function TRectHelper.GetTopRight: TPoint; 349 | begin 350 | Result := Point(Right, Top); 351 | end; 352 | 353 | function TRectHelper.Normalised: boolean; 354 | begin 355 | Result := (Top <= Bottom) and (Left <= Right); 356 | end; 357 | 358 | { TPopupMenuHelper } 359 | 360 | procedure TPopupMenuHelper.Popup(P: TPoint); 361 | begin 362 | Popup(P.X, P.Y); 363 | end; 364 | 365 | procedure TPopupMenuHelper.PopupAtMouseCursor; 366 | begin 367 | Popup( Mouse.CursorPos ); 368 | end; 369 | 370 | { TPointHelper } 371 | 372 | constructor TPointHelper.FromString(S: string); 373 | begin 374 | const I = S.Split([','], 2); 375 | X := I[0].ToInteger; 376 | Y := I[1].ToInteger; 377 | end; 378 | 379 | function TPointHelper.ToString: string; 380 | begin 381 | Result := Format('%D,%D', [X, Y]); 382 | end; 383 | 384 | { TIniFileHelper } 385 | 386 | function TIniFileHelper.ReadString(const Section, Ident, Default: string; 387 | StringSize: integer): string; 388 | var 389 | Buffer: PChar; 390 | BufSize: NativeInt; 391 | begin 392 | BufSize := StringSize * SizeOf(char); 393 | Buffer := AllocMem(BufSize); 394 | try 395 | SetString(Result, Buffer, GetPrivateProfileString(MarshaledString(Section), 396 | MarshaledString(Ident), MarshaledString(Default), Buffer, Length(Buffer), 397 | MarshaledString(FileName))); 398 | finally 399 | FreeMem(Buffer, BufSize); 400 | end; 401 | end; 402 | 403 | end. -------------------------------------------------------------------------------- /Dependencies/Cod.Version.pas: -------------------------------------------------------------------------------- 1 | unit Cod.Version; 2 | 3 | interface 4 | uses 5 | System.SysUtils, System.Classes, IdSNTP, 6 | System.Types, DateUtils, IdHTTP, Math, Cod.Math, 7 | JSON, IdSSLOpenSSL; 8 | 9 | type 10 | TVersion = record 11 | Major, 12 | Minor, 13 | Maintenance, 14 | Build: cardinal; 15 | 16 | APIResponse: TJsonObject; 17 | 18 | // Main 19 | constructor Create(AMajor, AMinor, AMaintenance: cardinal; ABuild: cardinal=0); overload; 20 | constructor Create(AString: string); overload; 21 | procedure Clear; 22 | 23 | // Load 24 | procedure Parse(From: string); 25 | procedure NetworkLoad(URL: string); 26 | procedure HtmlLoad(URL: string); 27 | procedure APILoad(AppName: string; Endpoint: string = 'https://api.codrutsoft.com/'); overload; 28 | procedure APILoad(AppName: string; Current: TVersion; Endpoint: string = 'https://api.codrutsoft.com/'); overload; 29 | 30 | // Utils 31 | function GetDownloadLink(JSONValue: string = 'updateurl'): string; 32 | 33 | // Comparation 34 | function Empty: boolean; 35 | function CompareTo(Version: TVersion): TValueRelationship; 36 | function NewerThan(Version: TVersion): boolean; 37 | function OlderThan(Version: TVersion): boolean; 38 | 39 | // Conversion 40 | function ToString: string; overload; 41 | function ToString(IncludeBuild: boolean): string; overload; 42 | function ToString(Separator: char; IncludeBuild: boolean = false): string; overload; 43 | 44 | // Operators 45 | class operator Equal(A, B: TVersion): Boolean; 46 | class operator NotEqual(A, B: TVersion): Boolean; 47 | end; 48 | 49 | function MakeVersion(Major, Minor, Maintenance: cardinal; Build: cardinal = 0): TVersion; 50 | 51 | const 52 | VERSION_EMPTY: TVersion = (Major:0; Minor:0; Maintenance:0; Build:0); 53 | 54 | implementation 55 | 56 | function MakeVersion(Major, Minor, Maintenance: cardinal; Build: cardinal = 0): TVersion; 57 | begin 58 | Result.Major := Major; 59 | Result.Minor := Minor; 60 | Result.Maintenance := Maintenance; 61 | Result.Build := Build; 62 | end; 63 | 64 | 65 | { TVersion } 66 | 67 | procedure TVersion.NetworkLoad(URL: string); 68 | var 69 | IdHttp: TIdHTTP; 70 | HTML: string; 71 | begin 72 | IdHttp := TIdHTTP.Create(nil); 73 | try 74 | HTML := IdHttp.Get(URL); 75 | 76 | Parse(HTML); 77 | finally 78 | IdHttp.Free; 79 | end; 80 | end; 81 | 82 | 83 | function TVersion.NewerThan(Version: TVersion): boolean; 84 | begin 85 | Result := CompareTo(Version) = GreaterThanValue; 86 | end; 87 | 88 | class operator TVersion.NotEqual(A, B: TVersion): Boolean; 89 | begin 90 | Result := A.CompareTo(B) <> EqualsValue; 91 | end; 92 | 93 | function TVersion.OlderThan(Version: TVersion): boolean; 94 | begin 95 | Result := CompareTo(Version) = LessThanValue; 96 | end; 97 | 98 | procedure TVersion.APILoad(AppName: string; Current: TVersion; Endpoint: string); 99 | var 100 | HTTP: TIdHTTP; 101 | SSLIOHandler: TIdSSLIOHandlerSocketOpenSSL; 102 | Request: TJSONObject; 103 | RequestStream: TStringStream; 104 | Result: string; 105 | begin 106 | // Create HTTP and SSLIOHandler components 107 | HTTP := TIdHTTP.Create(nil); 108 | SSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP); 109 | Request := TJSONObject.Create; 110 | 111 | // Build Request 112 | Request.AddPair('mode', 'getversion'); 113 | Request.AddPair('app', AppName); 114 | if not Current.Empty then 115 | Request.AddPair('client-version', Current.ToString(true)); 116 | 117 | // Request 118 | RequestStream := TStringStream.Create(Request.ToJSON, TEncoding.UTF8); 119 | try 120 | // Set SSL/TLS options 121 | SSLIOHandler.SSLOptions.SSLVersions := [sslvTLSv1_2]; 122 | HTTP.IOHandler := SSLIOHandler; 123 | 124 | // Set headers 125 | HTTP.Request.ContentType := 'application/json'; 126 | 127 | // Send POST 128 | Result := HTTP.Post(Endpoint, RequestStream); 129 | 130 | // Parse 131 | APIResponse := TJSONObject.ParseJSONValue( Result ) as TJSONObject; 132 | 133 | // Parse response 134 | if not APIResponse.GetValue('result') then 135 | raise Exception.Create( APIResponse.GetValue('message') ); 136 | Parse(APIResponse.GetValue('version')); 137 | finally 138 | // Free 139 | HTTP.Free; 140 | Request.Free; 141 | RequestStream.Free; 142 | end; 143 | end; 144 | 145 | procedure TVersion.APILoad(AppName, Endpoint: string); 146 | begin 147 | APILoad(AppName, VERSION_EMPTY, EndPoint); 148 | end; 149 | 150 | procedure TVersion.Clear; 151 | begin 152 | Major := 0; 153 | Minor := 0; 154 | Maintenance := 0; 155 | Build := 0; 156 | end; 157 | 158 | function TVersion.CompareTo(Version: TVersion): TValueRelationship; 159 | begin 160 | Result := GetNumberRelation(Major, Version.Major); 161 | if Result <> EqualsValue then 162 | Exit; 163 | 164 | Result := GetNumberRelation(Minor, Version.Minor); 165 | if Result <> EqualsValue then 166 | Exit; 167 | 168 | Result := GetNumberRelation(Maintenance, Version.Maintenance); 169 | if Result <> EqualsValue then 170 | Exit; 171 | 172 | Result := GetNumberRelation(Build, Version.Build); 173 | end; 174 | 175 | constructor TVersion.Create(AString: string); 176 | begin 177 | Parse( AString ); 178 | end; 179 | 180 | constructor TVersion.Create(AMajor, AMinor, AMaintenance, ABuild: cardinal); 181 | begin 182 | Major := AMajor; 183 | Minor := AMinor; 184 | Maintenance := AMaintenance; 185 | Build := ABuild; 186 | end; 187 | 188 | function TVersion.Empty: boolean; 189 | begin 190 | Result := CompareTo(VERSION_EMPTY) = EqualsValue; 191 | end; 192 | 193 | class operator TVersion.Equal(A, B: TVersion): Boolean; 194 | begin 195 | Result := A.CompareTo(B) = EqualsValue; 196 | end; 197 | 198 | function TVersion.GetDownloadLink(JSONValue: string): string; 199 | begin 200 | if not APIResponse.TryGetValue(JSONValue, Result) then 201 | Result := ''; 202 | end; 203 | 204 | procedure TVersion.HtmlLoad(URL: string); 205 | var 206 | IdHttp: TIdHTTP; 207 | HTML: string; 208 | begin 209 | IdHttp := TIdHTTP.Create(nil); 210 | try 211 | IdHttp.Request.CacheControl := 'no-cache'; 212 | HTML := IdHttp.Get(URL); 213 | 214 | HTML := Trim(HTML).Replace(#13, '').DeQuotedString; 215 | 216 | Parse(HTML); 217 | finally 218 | IdHttp.Free; 219 | end; 220 | end; 221 | 222 | procedure TVersion.Parse(From: string); 223 | var 224 | Separator: char; 225 | Splitted: TArray; 226 | I: Integer; 227 | Value: cardinal; 228 | AVersions: integer; 229 | begin 230 | // Separator 231 | if From.IndexOf('.') <> -1 then 232 | Separator := '.' 233 | else 234 | if From.IndexOf(',') <> -1 then 235 | Separator := ',' 236 | else 237 | if From.IndexOf('-') <> -1 then 238 | Separator := '-' 239 | else 240 | Separator := #0; 241 | 242 | // Values 243 | Splitted := From.Split(Separator); 244 | 245 | AVersions := Length(Splitted); 246 | if AVersions < 0 then 247 | Exit; 248 | 249 | // Write 250 | Clear; 251 | 252 | for I := 0 to AVersions-1 do 253 | begin 254 | Value := Splitted[I].ToInteger; 255 | case I of 256 | 0: Major := Value; 257 | 1: Minor := Value; 258 | 2: Maintenance := Value; 259 | 3: Build := Value; 260 | else Break; 261 | end; 262 | end; 263 | end; 264 | 265 | function TVersion.ToString: string; 266 | begin 267 | Result := ToString(false); 268 | end; 269 | 270 | function TVersion.ToString(IncludeBuild: boolean): string; 271 | begin 272 | Result := ToString('.', IncludeBuild); 273 | end; 274 | 275 | function TVersion.ToString(Separator: char; IncludeBuild: boolean): string; 276 | begin 277 | Result := Major.ToString + Separator + Minor.ToString + Separator + Maintenance.ToString; 278 | 279 | if IncludeBuild then 280 | Result := Result + Separator + Build.ToString; 281 | end; 282 | 283 | end. -------------------------------------------------------------------------------- /Dependencies/Cod.Windows.ThemeApi.pas: -------------------------------------------------------------------------------- 1 | {***********************************************************} 2 | { Cod Utils - Dark Mode Api } 3 | { } 4 | { version 1.0 } 5 | { } 6 | { } 7 | { This library is sourced from the following repos } 8 | { https://github.com/HemulGM/WindowDarkMode } 9 | { https://github.com/chuacw/Delphi-Dark-Mode-demo } 10 | { https://github.com/adzm/win32-custom-menubar-aero-theme } 11 | { } 12 | {***********************************************************} 13 | 14 | unit Cod.Windows.ThemeApi; 15 | {$WARN SYMBOL_PLATFORM OFF} 16 | {$ALIGN ON} 17 | {$MINENUMSIZE 4} 18 | 19 | interface 20 | 21 | uses 22 | Winapi.Windows; 23 | 24 | type 25 | TWinRoundType = (wrtDEFAULT = 0, wrtDONOTROUND = 1, wrtROUND = 2, wrtROUNDSMALL = 3); 26 | 27 | TDwmWindowAttribute = ( 28 | DWMWA_NCRENDERING_ENABLED = 1, // 29 | DWMWA_NCRENDERING_POLICY, // 30 | DWMWA_TRANSITIONS_FORCEDISABLED, // 31 | DWMWA_ALLOW_NCPAINT, // 32 | DWMWA_CAPTION_BUTTON_BOUNDS, // 33 | DWMWA_NONCLIENT_RTL_LAYOUT, // 34 | DWMWA_FORCE_ICONIC_REPRESENTATION, // 35 | DWMWA_FLIP3D_POLICY, // 36 | DWMWA_EXTENDED_FRAME_BOUNDS, // 37 | DWMWA_HAS_ICONIC_BITMAP, // 38 | DWMWA_DISALLOW_PEEK, // 39 | DWMWA_EXCLUDED_FROM_PEEK, // 40 | DWMWA_CLOAK, // 41 | DWMWA_CLOAKED, // 42 | DWMWA_FREEZE_REPRESENTATION, // 43 | DWMWA_PASSIVE_UPDATE_MODE, // 44 | DWMWA_USE_HOSTBACKDROPBRUSH, //17 45 | DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19, // 46 | DWMWA_USE_IMMERSIVE_DARK_MODE = 20, // 47 | DWMWA_WINDOW_CORNER_PREFERENCE = 33, // 48 | DWMWA_BORDER_COLOR, // 49 | DWMWA_CAPTION_COLOR, // 50 | DWMWA_TEXT_COLOR, // 51 | DWMWA_VISIBLE_FRAME_BORDER_THICKNESS, // 52 | DWMWA_SYSTEMBACKDROP_TYPE, // 53 | DWMWA_LAST); 54 | 55 | TDWMWindowCornerPreference = (DWMWCP_DEFAULT = 0, DWMWCP_DONOTROUND = 1, DWMWCP_ROUND = 2, DWMWCP_ROUNDSMALL = 3); 56 | TImmersiveHCCacheMode = (IHCM_USE_CACHED_VALUE, IHCM_REFRESH); 57 | TPreferredAppMode = (DefaultMode, AllowDarkMode, ForceDarkMode, ForceLightMode, ModeMax); 58 | 59 | TWindowCompositionAttribute = (WCA_UNDEFINED = 0, // 60 | WCA_NCRENDERING_ENABLED = 1, // 61 | WCA_NCRENDERING_POLICY = 2, // 62 | WCA_TRANSITIONS_FORCEDISABLED = 3, // 63 | WCA_ALLOW_NCPAINT = 4, // 64 | WCA_CAPTION_BUTTON_BOUNDS = 5, // 65 | WCA_NONCLIENT_RTL_LAYOUT = 6, // 66 | WCA_FORCE_ICONIC_REPRESENTATION = 7, // 67 | WCA_EXTENDED_FRAME_BOUNDS = 8, // 68 | WCA_HAS_ICONIC_BITMAP = 9, // 69 | WCA_THEME_ATTRIBUTES = 10, // 70 | WCA_NCRENDERING_EXILED = 11, // 71 | WCA_NCADORNMENTINFO = 12, // 72 | WCA_EXCLUDED_FROM_LIVEPREVIEW = 13, // 73 | WCA_VIDEO_OVERLAY_ACTIVE = 14, // 74 | WCA_FORCE_ACTIVEWINDOW_APPEARANCE = 15, // 75 | WCA_DISALLOW_PEEK = 16, // 76 | WCA_CLOAK = 17, // 77 | WCA_CLOAKED = 18, // 78 | WCA_ACCENT_POLICY = 19, // 79 | WCA_FREEZE_REPRESENTATION = 20, // 80 | WCA_EVER_UNCLOAKED = 21, // 81 | WCA_VISUAL_OWNER = 22, // 82 | WCA_HOLOGRAPHIC = 23, // 83 | WCA_EXCLUDED_FROM_DDA = 24, // 84 | WCA_PASSIVEUPDATEMODE = 25, // 85 | WCA_USEDARKMODECOLORS = 26, // 86 | WCA_LAST = 27); 87 | 88 | WINDOWCOMPOSITIONATTRIBDATA = record 89 | Attrib: TWindowCompositionAttribute; 90 | pvData: Pointer; 91 | cbData: SIZE_T; 92 | end; 93 | 94 | TWindowCompositionAttribData = WINDOWCOMPOSITIONATTRIBDATA; 95 | PWindowCompositionAttribData = ^TWindowCompositionAttribData; 96 | 97 | // DWM 98 | function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall; overload; 99 | function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: TDwmWindowAttribute; var pvAttribute; cbAttribute: DWORD): HResult; stdcall; overload; 100 | function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: TDwmWindowAttribute; var pvAttribute: TDWMWindowCornerPreference; cbAttribute: DWORD): HResult; stdcall; overload; 101 | 102 | /// 103 | /// Enables dark context menus which change automatically depending on the theme. 104 | /// 105 | procedure AllowDarkModeForApp(allow: BOOL); stdcall; 106 | /// 107 | /// Enables dark mode for window titlebar and border. 108 | /// 109 | function AllowDarkModeForWindow(hWnd: HWND; allow: Boolean): Boolean; stdcall; 110 | 111 | // See https://en.wikipedia.org/wiki/Windows_10_version_history 112 | function CheckBuildNumber(buildNumber: DWORD): Boolean; 113 | function IsWindows10OrGreater(buildNumber: DWORD = 10000): Boolean; 114 | function IsWindows11OrGreater(buildNumber: DWORD = 22000): Boolean; 115 | function IsDarkModeAllowedForWindow(hWnd: HWND): BOOL; stdcall; 116 | procedure RefreshImmersiveColorPolicyState; stdcall; 117 | procedure RefreshTitleBarThemeColor(hWnd: HWND); 118 | function ImmersiveDarkMode: TDwmWindowAttribute; 119 | 120 | // Theme 121 | function ShouldAppsUseDarkMode: BOOL; stdcall; 122 | function ShouldSystemUseDarkMode: BOOL; stdcall; 123 | 124 | const 125 | LOAD_LIBRARY_SEARCH_SYSTEM32 = $00000800; 126 | 127 | implementation 128 | 129 | uses 130 | System.Classes, System.SysUtils, UITypes, System.Win.Registry; 131 | 132 | const 133 | BackColor: TColor = $1E1E1E; 134 | TextColor: TColor = $F0F0F0; 135 | InputBackColor: TColor = $303030; 136 | Dwmapi = 'dwmapi.dll'; 137 | CDarkModeExplorer = 'DarkMode_Explorer'; 138 | CModeExplorer = 'Explorer'; 139 | CDarkModeControlCFD = 'DarkMode_CFD'; 140 | DWM_CLOAKED_APP = $0000001; 141 | DWM_CLOAKED_SHELL = $0000002; 142 | DWM_CLOAKED_INHERITED = $0000004; 143 | ODS_NOACCEL = $0100; 144 | WM_UAHDESTROYWINDOW = $0090; // handled by DefWindowProc 145 | WM_UAHDRAWMENU = $0091; // lParam is UAHMENU 146 | WM_UAHDRAWMENUITEM = $0092; // lParam is UAHDRAWMENUITEM 147 | WM_UAHINITMENU = $0093; // handled by DefWindowProc 148 | WM_UAHMEASUREMENUITEM = $0094; // lParam is UAHMEASUREMENUITEM 149 | WM_UAHNCPAINTMENUPOPUP = $0095; // handled by DefWindowProc 150 | WM_UAHUPDATE = $0096; 151 | 152 | var 153 | _AllowDarkModeForApp: function(allow: BOOL): BOOL; stdcall = nil; 154 | _AllowDarkModeForWindow: function(hWnd: HWND; allow: BOOL): BOOL; stdcall = nil; 155 | _GetIsImmersiveColorUsingHighContrast: function(mode: TImmersiveHCCacheMode): BOOL; stdcall = nil; 156 | _IsDarkModeAllowedForWindow: function(hWnd: HWND): BOOL; stdcall = nil; 157 | _OpenNcThemeData: function(hWnd: HWND; pszClassList: LPCWSTR): THandle; stdcall = nil; 158 | _RefreshImmersiveColorPolicyState: procedure; stdcall = nil; 159 | _SetPreferredAppMode: function(appMode: TPreferredAppMode): TPreferredAppMode; stdcall = nil; 160 | _SetWindowCompositionAttribute: function(hWnd: HWND; pData: PWindowCompositionAttribData): BOOL; stdcall = nil; 161 | _ShouldAppsUseDarkMode: function: BOOL; stdcall; 162 | _ShouldSystemUseDarkMode: function: BOOL; stdcall = nil; 163 | GDarkModeSupported: BOOL = False; // changed type to BOOL 164 | GDarkModeEnabled: BOOL = False; // ? 165 | GUxTheme: HMODULE = 0; 166 | 167 | function DwmSetWindowAttribute(hwnd: hwnd; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HResult; stdcall; overload; external Dwmapi name 'DwmSetWindowAttribute' delayed; 168 | 169 | function DwmSetWindowAttribute(hwnd: hwnd; dwAttribute: TDwmWindowAttribute; var pvAttribute: TDWMWindowCornerPreference; cbAttribute: DWORD): HResult; stdcall; overload; external Dwmapi name 'DwmSetWindowAttribute' delayed; 170 | 171 | function GetThemeRegistryKey(Value: string; out ThemeValue: BOOL): boolean; 172 | begin 173 | Result := false; 174 | ThemeValue := true; // default (light theme) 175 | 176 | // Read from registry 177 | with TRegistry.Create do 178 | try 179 | RootKey := HKEY_CURRENT_USER; 180 | if OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\Themes\Personalize\') 181 | and ValueExists(Value) then begin 182 | Result := true; 183 | ThemeValue := ReadInteger(Value) <> 1; 184 | end; 185 | finally 186 | Free; 187 | end; 188 | end; 189 | 190 | procedure AllowDarkModeForApp(allow: BOOL); 191 | begin 192 | if Assigned(_AllowDarkModeForApp) then 193 | _AllowDarkModeForApp(allow) 194 | else if Assigned(_SetPreferredAppMode) then 195 | begin 196 | if allow then 197 | _SetPreferredAppMode(TPreferredAppMode.AllowDarkMode) 198 | else 199 | _SetPreferredAppMode(TPreferredAppMode.DefaultMode); 200 | end; 201 | end; 202 | 203 | function DwmSetWindowAttribute(hwnd: hwnd; dwAttribute: TDwmWindowAttribute; var pvAttribute; cbAttribute: DWORD): HResult; 204 | begin 205 | Result := DwmSetWindowAttribute(hwnd, Ord(dwAttribute), @pvAttribute, cbAttribute); 206 | end; 207 | 208 | function IsDarkModeAllowedForWindow(hWnd: hWnd): BOOL; 209 | begin 210 | Result := Assigned(_IsDarkModeAllowedForWindow) and _IsDarkModeAllowedForWindow(hWnd); 211 | end; 212 | 213 | function GetIsImmersiveColorUsingHighContrast(mode: TImmersiveHCCacheMode): BOOL; 214 | begin 215 | Result := Assigned(_GetIsImmersiveColorUsingHighContrast) and _GetIsImmersiveColorUsingHighContrast(mode); 216 | end; 217 | 218 | function ImmersiveDarkMode: TDwmWindowAttribute; 219 | begin 220 | if IsWindows10OrGreater(18985) then 221 | Result := DWMWA_USE_IMMERSIVE_DARK_MODE 222 | else 223 | Result := DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1; 224 | end; 225 | 226 | procedure RefreshImmersiveColorPolicyState; 227 | begin 228 | if Assigned(_RefreshImmersiveColorPolicyState) then 229 | _RefreshImmersiveColorPolicyState; 230 | end; 231 | 232 | function ShouldSystemUseDarkMode: BOOL; 233 | begin 234 | {if Assigned(_ShouldSystemUseDarkMode) then 235 | Result := _ShouldSystemUseDarkMode 236 | else} 237 | GetThemeRegistryKey('SystemUsesLightTheme', Result); 238 | end; 239 | function CheckBuildNumber(buildNumber: DWORD): Boolean; 240 | begin 241 | Result := 242 | IsWindows10OrGreater(20348) or 243 | IsWindows10OrGreater(19045) or // 244 | IsWindows10OrGreater(19044) or // 245 | IsWindows10OrGreater(19043) or // 246 | IsWindows10OrGreater(19042) or // 247 | IsWindows10OrGreater(19041) or // 2004 248 | IsWindows10OrGreater(18363) or // 1909 249 | IsWindows10OrGreater(18362) or // 1903 250 | IsWindows10OrGreater(17763); // 1809 251 | end; 252 | 253 | function IsWindows10OrGreater(buildNumber: DWORD): Boolean; 254 | begin 255 | Result := (TOSVersion.Major > 10) or ((TOSVersion.Major = 10) and (TOSVersion.Minor = 0) and (DWORD(TOSVersion.Build) >= buildNumber)); 256 | end; 257 | 258 | function IsWindows11OrGreater(buildNumber: DWORD): Boolean; 259 | begin 260 | Result := IsWindows10OrGreater(22000) or IsWindows10OrGreater(buildNumber); 261 | end; 262 | 263 | function AllowDarkModeForWindow(hWnd: hWnd; allow: Boolean): Boolean; 264 | begin 265 | Result := GDarkModeSupported and _AllowDarkModeForWindow(hWnd, allow); 266 | end; 267 | 268 | function IsHighContrast: Boolean; 269 | var 270 | highContrast: HIGHCONTRASTW; 271 | begin 272 | highContrast.cbSize := SizeOf(highContrast); 273 | if SystemParametersInfo(SPI_GETHIGHCONTRAST, SizeOf(highContrast), @highContrast, Ord(False)) then 274 | Result := highContrast.dwFlags and HCF_HIGHCONTRASTON <> 0 275 | else 276 | Result := False; 277 | end; 278 | 279 | procedure RefreshTitleBarThemeColor(hWnd: hWnd); 280 | var 281 | LUseDark: BOOL; 282 | LData: TWindowCompositionAttribData; 283 | begin 284 | LUseDark := _IsDarkModeAllowedForWindow(hWnd) and _ShouldAppsUseDarkMode and not IsHighContrast; 285 | if TOSVersion.Build < 18362 then 286 | SetProp(hWnd, 'UseImmersiveDarkModeColors', THandle(LUseDark)) 287 | else if Assigned(_SetWindowCompositionAttribute) then 288 | begin 289 | LData.Attrib := WCA_USEDARKMODECOLORS; 290 | LData.pvData := @LUseDark; 291 | LData.cbData := SizeOf(LUseDark); 292 | _SetWindowCompositionAttribute(hWnd, @LData); 293 | end; 294 | end; 295 | 296 | function ShouldAppsUseDarkMode: BOOL; 297 | begin 298 | {if Assigned(_ShouldAppsUseDarkMode) then 299 | Result := _ShouldAppsUseDarkMode 300 | else} 301 | GetThemeRegistryKey('AppsUseLightTheme', Result); 302 | end; 303 | 304 | initialization 305 | if ((TOSVersion.Major <> 10) or (TOSVersion.Minor <> 0) or not CheckBuildNumber(TOSVersion.Build)) then 306 | Exit; 307 | 308 | GUxTheme := LoadLibrary('uxtheme.dll'); 309 | if GUxTheme <> 0 then 310 | begin 311 | @_AllowDarkModeForWindow := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(133)); 312 | @_GetIsImmersiveColorUsingHighContrast := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(106)); 313 | @_IsDarkModeAllowedForWindow := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(137)); 314 | @_RefreshImmersiveColorPolicyState := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(104)); 315 | @_SetWindowCompositionAttribute := GetProcAddress(GetModuleHandle(user32), 'SetWindowCompositionAttribute'); 316 | @_ShouldAppsUseDarkMode := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(132)); 317 | @_ShouldSystemUseDarkMode := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(138)); 318 | 319 | var P := GetProcAddress(GUxTheme, MAKEINTRESOURCEA(135)); 320 | if TOSVersion.Build < 18362 then 321 | @_AllowDarkModeForApp := P 322 | else 323 | @_SetPreferredAppMode := P; 324 | 325 | if Assigned(_RefreshImmersiveColorPolicyState) and 326 | Assigned(_ShouldAppsUseDarkMode) and Assigned(_AllowDarkModeForWindow) and 327 | (Assigned(_AllowDarkModeForApp) or Assigned(_SetPreferredAppMode)) and 328 | Assigned(_IsDarkModeAllowedForWindow) then 329 | begin 330 | GDarkModeSupported := True; 331 | AllowDarkModeForApp(True); 332 | _RefreshImmersiveColorPolicyState; 333 | GDarkModeEnabled := ShouldAppsUseDarkMode and not IsHighContrast; 334 | end; 335 | end; 336 | 337 | finalization 338 | if GUxTheme <> 0 then 339 | FreeLibrary(GUxTheme); 340 | end. 341 | 342 | -------------------------------------------------------------------------------- /Forms/CodeSources.dfm: -------------------------------------------------------------------------------- 1 | object SourceUI: TSourceUI 2 | Left = 0 3 | Top = 0 4 | BorderIcons = [biSystemMenu] 5 | Caption = '3rd Party Acknowledgements' 6 | ClientHeight = 561 7 | ClientWidth = 584 8 | Color = 2886678 9 | CustomTitleBar.Control = TitleBarPanel 10 | CustomTitleBar.ShowIcon = False 11 | Constraints.MaxWidth = 600 12 | Constraints.MinHeight = 300 13 | Constraints.MinWidth = 600 14 | Font.Charset = DEFAULT_CHARSET 15 | Font.Color = clWhite 16 | Font.Height = -19 17 | Font.Name = 'Segoe UI' 18 | Font.Style = [] 19 | Position = poMainFormCenter 20 | OnCreate = FormCreate 21 | DesignSize = ( 22 | 584 23 | 561) 24 | TextHeight = 25 25 | object Label1: TLabel 26 | Left = 96 27 | Top = 48 28 | Width = 359 29 | Height = 37 30 | Caption = '3rd Party Acknowledgements' 31 | Font.Charset = DEFAULT_CHARSET 32 | Font.Color = clWhite 33 | Font.Height = -27 34 | Font.Name = 'Segoe UI Semibold' 35 | Font.Style = [] 36 | ParentFont = False 37 | end 38 | object DataText: TLabel 39 | Left = 96 40 | Top = 91 41 | Width = 368 42 | Height = 61 43 | AutoSize = False 44 | Caption = 45 | 'These are 3rd party libraries and files used in iBroadcast for W' + 46 | 'indows.' 47 | EllipsisPosition = epEndEllipsis 48 | WordWrap = True 49 | end 50 | object Label3: TLabel 51 | Left = 24 52 | Top = 48 53 | Width = 53 54 | Height = 53 55 | Caption = #59715 56 | Font.Charset = DEFAULT_CHARSET 57 | Font.Color = clWhite 58 | Font.Height = -53 59 | Font.Name = 'Segoe Fluent Icons' 60 | Font.Style = [] 61 | ParentFont = False 62 | end 63 | object TitleBarPanel: TTitleBarPanel 64 | Left = 0 65 | Top = 0 66 | Width = 584 67 | Height = 0 68 | CustomButtons = <> 69 | end 70 | object Download_Item: CButton 71 | AlignWithMargins = True 72 | Left = 428 73 | Top = 510 74 | Width = 136 75 | Height = 38 76 | Margins.Left = 5 77 | Margins.Top = 8 78 | Margins.Right = 15 79 | Margins.Bottom = 8 80 | ModalResult = 1 81 | TabOrder = 1 82 | Anchors = [akRight, akBottom] 83 | BSegoeIcon = #57345 84 | ButtonIcon = cicSegoeFluent 85 | UseAccentColor = None 86 | GradientOptions.Enabled = False 87 | GradientOptions.Enter = clFuchsia 88 | GradientOptions.Leave = clRed 89 | GradientOptions.Down = clMaroon 90 | ControlStyle = [] 91 | Font.Charset = DEFAULT_CHARSET 92 | Font.Color = 14123546 93 | Font.Height = -16 94 | Font.Name = 'Segoe UI Semibold' 95 | Font.Style = [] 96 | SubTextFont.Charset = DEFAULT_CHARSET 97 | SubTextFont.Color = 14123546 98 | SubTextFont.Height = -13 99 | SubTextFont.Name = 'Segoe UI' 100 | SubTextFont.Style = [] 101 | FontAutoSize.Enabled = False 102 | FontAutoSize.Max = -1 103 | FontAutoSize.Min = -1 104 | Text = 'Okay' 105 | SubText = 'Hello World!' 106 | AutoExtendImage = False 107 | State = mbsLeave 108 | Colors.Enter = 5771359 109 | Colors.Leave = 4853328 110 | Colors.Down = 3539258 111 | Colors.BLine = 3539258 112 | Preset.Color = clBlue 113 | Preset.Kind = cbprCustom 114 | Preset.PenColorAuto = True 115 | Preset.ApplyOnce = False 116 | Preset.IgnoreGlobalSync = False 117 | UnderLine.Enable = True 118 | UnderLine.UnderLineRound = True 119 | UnderLine.UnderLineThicknes = 6 120 | TextColors.Enter = clWhite 121 | TextColors.Leave = clWhite 122 | TextColors.Down = clWhite 123 | TextColors.BLine = clBlack 124 | Pen.Color = 2886678 125 | Pen.Width = 0 126 | Pen.EnableAlternativeColors = False 127 | Pen.FormSyncedColor = False 128 | Pen.AltHoverColor = clBlack 129 | Pen.AltPressColor = clBlack 130 | Pen.GlobalPresetExcept = False 131 | Animations.PressAnimation = True 132 | Animations.PADelay = 2 133 | Animations.PAShrinkAmount = 4 134 | Animations.PAAnimateEngine = cbneAtDraw 135 | Animations.FadeAnimation = True 136 | Animations.FASpeed = 10 137 | end 138 | object RichEdit1: TRichEdit 139 | Left = 24 140 | Top = 158 141 | Width = 540 142 | Height = 341 143 | Anchors = [akLeft, akTop, akRight, akBottom] 144 | BorderStyle = bsNone 145 | Font.Charset = ANSI_CHARSET 146 | Font.Color = clWhite 147 | Font.Height = -17 148 | Font.Name = 'Segoe UI' 149 | Font.Style = [] 150 | Lines.Strings = ( 151 | 152 | 'This document contains a list of all 3rd party software used by ' + 153 | 'this ' 154 | 'application.' 155 | '' 156 | #8226' Bass Audio Library for Delphi (shareware license)' 157 | 'Copyright (c) 1999-2020 Un4seen Developments Ltd.' 158 | 'https://www.un4seen.com/' 159 | '' 160 | #8226' Delphi-Bass improved' 161 | 'https://github.com/TDDung/Delphi-BASS' 162 | '' 163 | #8226' Codruts Visual Library' 164 | 'https://github.com/Codrax/CodrutsVisualLibrary' 165 | 'https://www.codrutsoft.com/' 166 | 'Copyright (c) 2023 Petculescu Codrut' 167 | '' 168 | #8226' Indy Internet Direct' 169 | 'https://www.indyproject.org/' 170 | 171 | 'Copyright (c) 1993 - 2018 Kudzu (Chad Z. Hower) and the Indy Pit' + 172 | ' ' 173 | 'Crew' 174 | '' 175 | #8226' Spectrum Visualyzation' 176 | 'http://digilander.iol.it/Kappe/audioobject' 177 | 'Copyright (c) Alessandro Cappellozza') 178 | ParentColor = True 179 | ParentFont = False 180 | ReadOnly = True 181 | ScrollBars = ssVertical 182 | TabOrder = 2 183 | end 184 | end 185 | -------------------------------------------------------------------------------- /Forms/CodeSources.pas: -------------------------------------------------------------------------------- 1 | unit CodeSources; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 7 | System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 8 | Cod.Visual.Button, Vcl.TitleBarCtrls, Vcl.StdCtrls, Vcl.ComCtrls, 9 | Cod.SysUtils; 10 | 11 | type 12 | TSourceUI = class(TForm) 13 | Label1: TLabel; 14 | DataText: TLabel; 15 | Label3: TLabel; 16 | TitleBarPanel: TTitleBarPanel; 17 | Download_Item: CButton; 18 | RichEdit1: TRichEdit; 19 | procedure FormCreate(Sender: TObject); 20 | private 21 | { Private declarations } 22 | public 23 | { Public declarations } 24 | end; 25 | 26 | var 27 | SourceUI: TSourceUI; 28 | 29 | implementation 30 | 31 | {$R *.dfm} 32 | 33 | procedure TSourceUI.FormCreate(Sender: TObject); 34 | begin 35 | // UX 36 | Font.Color := clWhite; 37 | with CustomTitleBar do 38 | begin 39 | Enabled := true; 40 | 41 | CaptionAlignment := taCenter; 42 | ShowIcon := false; 43 | 44 | SystemColors := false; 45 | SystemButtons := false; 46 | 47 | Control := TitleBarPanel; 48 | 49 | PrepareCustomTitleBar( TForm(Self), Color, clWhite); 50 | 51 | InactiveBackgroundColor := BackgroundColor; 52 | ButtonInactiveBackgroundColor := BackgroundColor; 53 | end; 54 | end; 55 | 56 | end. 57 | -------------------------------------------------------------------------------- /Forms/CreatePlaylistForm.pas: -------------------------------------------------------------------------------- 1 | unit CreatePlaylistForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.TitleBarCtrls, Vcl.ExtCtrls, 8 | Vcl.StdCtrls, Cod.Visual.Button, Cod.SysUtils, Cod.Visual.CheckBox, 9 | BroadcastAPI, Offline, Vcl.Imaging.pngimage, Cod.Visual.Image, 10 | iBroadcastUtils; 11 | 12 | type 13 | TCreatePlaylist = class(TForm) 14 | TitleBarPanel: TTitleBarPanel; 15 | Panel1: TPanel; 16 | Panel2: TPanel; 17 | Label8: TLabel; 18 | Label16: TLabel; 19 | Download_Item: CButton; 20 | CButton1: CButton; 21 | Panel3: TPanel; 22 | Label1: TLabel; 23 | Type_List: CButton; 24 | Type_Mood: CButton; 25 | Panel5: TPanel; 26 | Panel7: TPanel; 27 | List_Name: TEdit; 28 | Panel6: TPanel; 29 | Label2: TLabel; 30 | List_Description: TMemo; 31 | Label3: TLabel; 32 | Make_Public: CCheckBox; 33 | Select_Mood: TPanel; 34 | Label4: TLabel; 35 | CButton3: CButton; 36 | CButton4: CButton; 37 | CButton5: CButton; 38 | CButton6: CButton; 39 | CButton7: CButton; 40 | CButton8: CButton; 41 | CImage1: CImage; 42 | procedure FormCreate(Sender: TObject); 43 | procedure List_DescriptionChange(Sender: TObject); 44 | procedure Download_ItemClick(Sender: TObject); 45 | procedure CButton3Click(Sender: TObject); 46 | procedure SelectType(Sender: TObject); 47 | private 48 | { Private declarations } 49 | FMoodBased: boolean; 50 | FMood: integer; 51 | procedure SetMoodBased(const Value: boolean); 52 | procedure SetMood(const Value: integer); 53 | public 54 | { Public declarations } 55 | Tracks: TArray; 56 | 57 | property Mood: integer read FMood write SetMood; 58 | property MoodBased: boolean read FMoodBased write SetMoodBased; 59 | end; 60 | 61 | const 62 | MoodTypes: TArray = ['happy', 'party', 'dance', 'relaxed', 'workout', 'chill']; 63 | 64 | var 65 | CreatePlaylist: TCreatePlaylist; 66 | 67 | implementation 68 | 69 | {$R *.dfm} 70 | 71 | procedure TCreatePlaylist.SelectType(Sender: TObject); 72 | begin 73 | MoodBased := CButton(Sender).Tag = 1; 74 | 75 | Type_List.GradientOptions.Enabled := not MoodBased; 76 | Type_Mood.GradientOptions.Enabled := MoodBased; 77 | 78 | Type_List.Invalidate; 79 | Type_Mood.Invalidate; 80 | end; 81 | 82 | procedure TCreatePlaylist.CButton3Click(Sender: TObject); 83 | begin 84 | Mood := CButton(Sender).Tag; 85 | end; 86 | 87 | procedure TCreatePlaylist.Download_ItemClick(Sender: TObject); 88 | begin 89 | if List_Name.Text = '' then 90 | OpenDialog('Playlist need a name', 'The playlist requires a name') 91 | else 92 | try 93 | // Create Playlist 94 | if MoodBased then 95 | CreateNewPlayList(List_Name.Text, List_Description.Text, Make_Public.Checked, MoodTypes[Mood]) 96 | else 97 | CreateNewPlayList(List_Name.Text, List_Description.Text, Make_Public.Checked, Tracks); 98 | except 99 | // Offline 100 | OfflineDialog('The playlist could not be created.'); 101 | end; 102 | end; 103 | 104 | procedure TCreatePlaylist.FormCreate(Sender: TObject); 105 | begin 106 | // UX 107 | Font.Color := clWhite; 108 | with CustomTitleBar do 109 | begin 110 | Enabled := true; 111 | 112 | CaptionAlignment := taCenter; 113 | ShowIcon := false; 114 | 115 | SystemColors := false; 116 | SystemButtons := false; 117 | 118 | Control := TitleBarPanel; 119 | 120 | PrepareCustomTitleBar( TForm(Self), Color, clWhite); 121 | 122 | Self.Height := Self.Height - Height; 123 | 124 | InactiveBackgroundColor := BackgroundColor; 125 | ButtonInactiveBackgroundColor := BackgroundColor; 126 | end; 127 | 128 | // Data 129 | Moodbased := false; 130 | Tracks := []; 131 | Mood := 0; 132 | end; 133 | 134 | procedure TCreatePlaylist.List_DescriptionChange(Sender: TObject); 135 | var 136 | P: integer; 137 | begin 138 | with TMemo(Sender) do 139 | begin 140 | P := SelStart; 141 | Text := string(Text).Replace(#13, ''); 142 | if P > 0 then 143 | SelStart := P; 144 | end; 145 | end; 146 | 147 | procedure TCreatePlaylist.SetMood(const Value: integer); 148 | var 149 | I: integer; 150 | begin 151 | FMood := Value; 152 | 153 | for I := 0 to Select_Mood.ControlCount-1 do 154 | if Select_Mood.Controls[I] is CButton then 155 | with CButton(Select_Mood.Controls[I]) do 156 | begin 157 | GradientOptions.Enabled := Tag = Value; 158 | 159 | Invalidate; 160 | end; 161 | end; 162 | 163 | procedure TCreatePlaylist.SetMoodBased(const Value: boolean); 164 | begin 165 | FMoodBased := Value; 166 | 167 | Select_Mood.Visible := Value; 168 | end; 169 | 170 | end. 171 | -------------------------------------------------------------------------------- /Forms/DebugForm.pas: -------------------------------------------------------------------------------- 1 | unit DebugForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Imaging.pngimage, 8 | Cod.Visual.Image, Cod.Visual.Button, BroadcastAPI, Vcl.Clipbrd, JSON, 9 | Vcl.ExtCtrls, Cod.Types, Bass, Vcl.WinXCtrls, CreatePlaylistForm, 10 | Cod.SysUtils, PickerDialogForm, Cod.Windows; 11 | 12 | type 13 | TDebugUI = class(TForm) 14 | CImage1: CImage; 15 | Label2: TLabel; 16 | Label1: TLabel; 17 | Label3: TLabel; 18 | CButton1: CButton; 19 | CButton2: CButton; 20 | Label4: TLabel; 21 | Label5: TLabel; 22 | Memo2: TMemo; 23 | CButton3: CButton; 24 | CButton4: CButton; 25 | Memo3: TMemo; 26 | CButton5: CButton; 27 | DataSync: TTimer; 28 | Label6: TLabel; 29 | Label7: TLabel; 30 | Label8: TLabel; 31 | CButton6: CButton; 32 | Label9: TLabel; 33 | Label10: TLabel; 34 | SearchBox1: TSearchBox; 35 | Label11: TLabel; 36 | Label12: TLabel; 37 | Memo1: TMemo; 38 | CButton7: CButton; 39 | CButton8: CButton; 40 | Label13: TLabel; 41 | Label14: TLabel; 42 | procedure CButton1Click(Sender: TObject); 43 | procedure CButton2Click(Sender: TObject); 44 | procedure FormCreate(Sender: TObject); 45 | procedure CButton3Click(Sender: TObject); 46 | procedure CButton4Click(Sender: TObject); 47 | procedure CButton5Click(Sender: TObject); 48 | procedure DataSyncTimer(Sender: TObject); 49 | procedure CButton6Click(Sender: TObject); 50 | procedure SearchBox1InvokeSearch(Sender: TObject); 51 | procedure CButton8Click(Sender: TObject); 52 | private 53 | { Private declarations } 54 | public 55 | { Public declarations } 56 | end; 57 | 58 | var 59 | DebugUI: TDebugUI; 60 | 61 | implementation 62 | 63 | uses 64 | MainUI; 65 | 66 | {$R *.dfm} 67 | 68 | procedure TDebugUI.CButton1Click(Sender: TObject); 69 | begin 70 | Clipboard.AsText := TOKEN; 71 | end; 72 | 73 | procedure TDebugUI.CButton2Click(Sender: TObject); 74 | begin 75 | Clipboard.AsText := USER_ID.ToString; 76 | end; 77 | 78 | procedure TDebugUI.CButton3Click(Sender: TObject); 79 | begin 80 | Memo2.Text := SendClientRequest( StringReplace(Memo1.Text, #13, '', [rfReplaceAll]) ).ToJSON; 81 | end; 82 | 83 | procedure TDebugUI.CButton4Click(Sender: TObject); 84 | begin 85 | Clipboard.AsText := STREAMING_ENDPOINT + Tracks[PlayIndex].StreamLocations 86 | end; 87 | 88 | procedure TDebugUI.CButton5Click(Sender: TObject); 89 | var 90 | I: Integer; 91 | begin 92 | Memo3.Clear; 93 | 94 | for I := 0 to PlayQueue.Count - 1 do 95 | Memo3.Lines.Add( PlayQueue[I].ToString ) 96 | end; 97 | 98 | procedure TDebugUI.CButton6Click(Sender: TObject); 99 | begin 100 | UIForm.ReloadArtwork; 101 | end; 102 | 103 | procedure TDebugUI.CButton8Click(Sender: TObject); 104 | begin 105 | UIForm.UpdateDownloads; 106 | end; 107 | 108 | procedure TDebugUI.DataSyncTimer(Sender: TObject); 109 | begin 110 | // Sync 111 | Label6.Caption := 'Hover: ' + MainUI.IndexHover.ToString; 112 | Label7.Caption := 'Hover SH: ' + MainUI.IndexHoverSort.ToString; 113 | Label9.Caption := '10s Shrink:' + MainUI.Press10Stat.ToString; 114 | Label10.Caption := 'Ch Active: ' + BooleanToString( BASS_ChannelIsActive(Player.Stream) = BASS_ACTIVE_PLAYING ); 115 | Label11.Caption := 'Img-Thread: ' + TotalThreads.ToString; 116 | Label12.Caption := 'Downl-Thread: ' + DownloadThreadsE.ToString; 117 | Label14.Caption := 'Page Path: ' + Location; 118 | end; 119 | 120 | procedure TDebugUI.FormCreate(Sender: TObject); 121 | begin 122 | Top := Screen.Height - Height - GetTaskbarHeight; 123 | Left := Screen.Width - Width; 124 | 125 | // Constant 126 | Label13.Caption := 'Version: ' + Version.ToString; 127 | end; 128 | 129 | procedure TDebugUI.SearchBox1InvokeSearch(Sender: TObject); 130 | begin 131 | UIForm.FiltrateSearch( SearchBox1.Text ); 132 | UIForm.RedrawPaintBox; 133 | end; 134 | 135 | end. 136 | -------------------------------------------------------------------------------- /Forms/HelpForm.pas: -------------------------------------------------------------------------------- 1 | unit HelpForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.TitleBarCtrls, Vcl.StdCtrls, 8 | Vcl.ExtCtrls, Vcl.Imaging.pngimage, Cod.Visual.Image, Cod.SysUtils, 9 | Cod.Visual.Button; 10 | 11 | type 12 | THelpUI = class(TForm) 13 | TitleBarPanel: TTitleBarPanel; 14 | HelpCat: TPanel; 15 | CButton25: CButton; 16 | CButton1: CButton; 17 | Panel2: TPanel; 18 | Label8: TLabel; 19 | Topics: TPanel; 20 | Topic_1: TScrollBox; 21 | Label9: TLabel; 22 | Label10: TLabel; 23 | Label11: TLabel; 24 | CImage4: CImage; 25 | Label12: TLabel; 26 | CImage5: CImage; 27 | Label13: TLabel; 28 | Label14: TLabel; 29 | Label15: TLabel; 30 | Panel3: TPanel; 31 | Topic_2: TScrollBox; 32 | Label1: TLabel; 33 | Label2: TLabel; 34 | Label3: TLabel; 35 | CImage1: CImage; 36 | Label4: TLabel; 37 | CImage2: CImage; 38 | Label6: TLabel; 39 | Label7: TLabel; 40 | CImage3: CImage; 41 | Label5: TLabel; 42 | Panel4: TPanel; 43 | Label16: TLabel; 44 | Topic_3: TScrollBox; 45 | Label17: TLabel; 46 | Label18: TLabel; 47 | Label19: TLabel; 48 | Panel1: TPanel; 49 | CButton2: CButton; 50 | Label24: TLabel; 51 | Label20: TLabel; 52 | Label21: TLabel; 53 | Label22: TLabel; 54 | Label23: TLabel; 55 | Label25: TLabel; 56 | Label26: TLabel; 57 | Label27: TLabel; 58 | Label28: TLabel; 59 | Label29: TLabel; 60 | Label30: TLabel; 61 | Label31: TLabel; 62 | Label32: TLabel; 63 | CButton3: CButton; 64 | Topic_4: TScrollBox; 65 | Label33: TLabel; 66 | Label34: TLabel; 67 | Label35: TLabel; 68 | Label46: TLabel; 69 | Panel5: TPanel; 70 | Label36: TLabel; 71 | Label37: TLabel; 72 | Label38: TLabel; 73 | Label39: TLabel; 74 | Label40: TLabel; 75 | Label41: TLabel; 76 | Label42: TLabel; 77 | Label43: TLabel; 78 | Label44: TLabel; 79 | CImage6: CImage; 80 | Label45: TLabel; 81 | Label47: TLabel; 82 | CImage7: CImage; 83 | procedure FormCreate(Sender: TObject); 84 | procedure Topic_2MouseWheel(Sender: TObject; Shift: TShiftState; 85 | WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 86 | procedure HelpTopicSelect(Sender: TObject); 87 | private 88 | { Private declarations } 89 | public 90 | { Public declarations } 91 | end; 92 | 93 | var 94 | HelpUI: THelpUI; 95 | 96 | implementation 97 | 98 | {$R *.dfm} 99 | 100 | procedure THelpUI.HelpTopicSelect(Sender: TObject); 101 | var 102 | I, ID: Integer; 103 | begin 104 | ID := CButton(Sender).Tag; 105 | 106 | for I := 0 to Topics.ControlCount - 1 do 107 | if Topics.Controls[I] is TScrollBox then 108 | with TScrollBox(Topics.Controls[I]) do 109 | Visible := Tag = ID; 110 | end; 111 | 112 | procedure THelpUI.FormCreate(Sender: TObject); 113 | begin 114 | // UX 115 | Font.Color := clWhite; 116 | with CustomTitleBar do 117 | begin 118 | Enabled := true; 119 | 120 | CaptionAlignment := taCenter; 121 | ShowIcon := false; 122 | 123 | SystemColors := false; 124 | SystemButtons := false; 125 | 126 | Control := TitleBarPanel; 127 | 128 | PrepareCustomTitleBar( TForm(Self), Color, clWhite); 129 | 130 | InactiveBackgroundColor := BackgroundColor; 131 | ButtonInactiveBackgroundColor := BackgroundColor; 132 | end; 133 | end; 134 | 135 | procedure THelpUI.Topic_2MouseWheel(Sender: TObject; Shift: TShiftState; 136 | WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 137 | begin 138 | TScrollBox(Sender).VertScrollBar.Position := TScrollBox(Sender).VertScrollBar.Position - WheelDelta div 8; 139 | end; 140 | 141 | end. 142 | -------------------------------------------------------------------------------- /Forms/InfoForm.dfm: -------------------------------------------------------------------------------- 1 | object InfoBox: TInfoBox 2 | Left = 0 3 | Top = 0 4 | BorderIcons = [biSystemMenu] 5 | BorderStyle = bsSingle 6 | Caption = 'Song title here' 7 | ClientHeight = 461 8 | ClientWidth = 784 9 | Color = 2886678 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWhite 12 | Font.Height = -16 13 | Font.Name = 'Segoe UI' 14 | Font.Style = [] 15 | OnCreate = FormCreate 16 | TextHeight = 21 17 | object TitleBarPanel: TTitleBarPanel 18 | Left = 0 19 | Top = 0 20 | Width = 784 21 | Height = 25 22 | CustomButtons = <> 23 | end 24 | object Panel1: TPanel 25 | AlignWithMargins = True 26 | Left = 325 27 | Top = 50 28 | Width = 434 29 | Height = 386 30 | Margins.Left = 25 31 | Margins.Top = 25 32 | Margins.Right = 25 33 | Margins.Bottom = 25 34 | Align = alClient 35 | BevelOuter = bvNone 36 | Caption = 'Panel1' 37 | ParentColor = True 38 | ShowCaption = False 39 | TabOrder = 2 40 | object Panel3: TPanel 41 | AlignWithMargins = True 42 | Left = 25 43 | Top = 5 44 | Width = 384 45 | Height = 41 46 | Margins.Left = 25 47 | Margins.Top = 5 48 | Margins.Right = 25 49 | Margins.Bottom = 5 50 | Align = alTop 51 | BevelOuter = bvNone 52 | Caption = 'Panel3' 53 | ParentColor = True 54 | ShowCaption = False 55 | TabOrder = 0 56 | object Song_Name: TEdit 57 | Left = 0 58 | Top = 0 59 | Width = 316 60 | Height = 41 61 | Align = alClient 62 | AutoSelect = False 63 | BevelInner = bvNone 64 | BevelOuter = bvNone 65 | BorderStyle = bsNone 66 | Font.Charset = DEFAULT_CHARSET 67 | Font.Color = clWhite 68 | Font.Height = -27 69 | Font.Name = 'Segoe UI Semibold' 70 | Font.Style = [] 71 | ParentColor = True 72 | ParentFont = False 73 | TabOrder = 0 74 | Text = 'Item name' 75 | OnChange = Song_NameChange 76 | OnKeyUp = Song_NameKeyUp 77 | end 78 | object Save_Button: CButton 79 | AlignWithMargins = True 80 | Left = 331 81 | Top = 5 82 | Width = 38 83 | Height = 36 84 | Margins.Left = 15 85 | Margins.Top = 5 86 | Margins.Right = 15 87 | Margins.Bottom = 0 88 | OnClick = Save_ButtonClick 89 | TabOrder = 1 90 | Align = alRight 91 | Visible = False 92 | BSegoeIcon = #57605 93 | ButtonIcon = cicSegoeFluent 94 | UseAccentColor = None 95 | GradientOptions.Enabled = False 96 | GradientOptions.Enter = clFuchsia 97 | GradientOptions.Leave = clRed 98 | GradientOptions.Down = clMaroon 99 | ControlStyle = [] 100 | Font.Charset = DEFAULT_CHARSET 101 | Font.Color = 14123546 102 | Font.Height = -16 103 | Font.Name = 'Segoe UI Semibold' 104 | Font.Style = [] 105 | SubTextFont.Charset = DEFAULT_CHARSET 106 | SubTextFont.Color = 14123546 107 | SubTextFont.Height = -13 108 | SubTextFont.Name = 'Segoe UI' 109 | SubTextFont.Style = [] 110 | FontAutoSize.Enabled = False 111 | FontAutoSize.Max = -1 112 | FontAutoSize.Min = -1 113 | Text = '' 114 | SubText = 'Hello World!' 115 | AutoExtendImage = False 116 | State = mbsLeave 117 | Colors.Enter = 5771359 118 | Colors.Leave = 4853328 119 | Colors.Down = 3539258 120 | Colors.BLine = 3539258 121 | Preset.Color = clBlue 122 | Preset.Kind = cbprCustom 123 | Preset.PenColorAuto = True 124 | Preset.ApplyOnce = False 125 | Preset.IgnoreGlobalSync = False 126 | UnderLine.Enable = True 127 | UnderLine.UnderLineRound = True 128 | UnderLine.UnderLineThicknes = 6 129 | TextColors.Enter = clWhite 130 | TextColors.Leave = clWhite 131 | TextColors.Down = clWhite 132 | TextColors.BLine = clBlack 133 | Pen.Color = 2886678 134 | Pen.Width = 0 135 | Pen.EnableAlternativeColors = False 136 | Pen.FormSyncedColor = False 137 | Pen.AltHoverColor = clBlack 138 | Pen.AltPressColor = clBlack 139 | Pen.GlobalPresetExcept = False 140 | Animations.PressAnimation = True 141 | Animations.PADelay = 2 142 | Animations.PAShrinkAmount = 4 143 | Animations.PAAnimateEngine = cbneAtDraw 144 | Animations.FadeAnimation = True 145 | Animations.FASpeed = 10 146 | end 147 | end 148 | object Panel4: TPanel 149 | AlignWithMargins = True 150 | Left = 25 151 | Top = 56 152 | Width = 384 153 | Height = 305 154 | Margins.Left = 25 155 | Margins.Top = 5 156 | Margins.Right = 25 157 | Margins.Bottom = 25 158 | Align = alClient 159 | BevelOuter = bvNone 160 | Caption = 'Panel3' 161 | ParentColor = True 162 | ShowCaption = False 163 | TabOrder = 1 164 | object Song_Info: TMemo 165 | Left = 0 166 | Top = 0 167 | Width = 384 168 | Height = 305 169 | Align = alClient 170 | BevelInner = bvNone 171 | BorderStyle = bsNone 172 | Lines.Strings = ( 173 | 'Description and information') 174 | ParentColor = True 175 | ReadOnly = True 176 | TabOrder = 0 177 | OnKeyUp = Song_InfoKeyUp 178 | end 179 | object Editor_View: TPanel 180 | Left = 0 181 | Top = 0 182 | Width = 384 183 | Height = 305 184 | Align = alClient 185 | BevelOuter = bvNone 186 | Caption = 'Panel5' 187 | ParentColor = True 188 | ShowCaption = False 189 | TabOrder = 1 190 | Visible = False 191 | DesignSize = ( 192 | 384 193 | 305) 194 | object Edit_Desc: TMemo 195 | Left = 0 196 | Top = 0 197 | Width = 384 198 | Height = 305 199 | Align = alClient 200 | BevelInner = bvNone 201 | BorderStyle = bsNone 202 | Lines.Strings = ( 203 | 'Description and information') 204 | ParentColor = True 205 | TabOrder = 0 206 | OnKeyUp = Edit_DescKeyUp 207 | end 208 | object Save_Button2: CButton 209 | AlignWithMargins = True 210 | Left = 330 211 | Top = 265 212 | Width = 40 213 | Height = 40 214 | Margins.Left = 15 215 | Margins.Top = 5 216 | Margins.Right = 15 217 | Margins.Bottom = 0 218 | OnClick = Save_Button2Click 219 | TabOrder = 1 220 | Anchors = [akRight, akBottom] 221 | BSegoeIcon = #57605 222 | ButtonIcon = cicSegoeFluent 223 | UseAccentColor = None 224 | GradientOptions.Enabled = False 225 | GradientOptions.Enter = clFuchsia 226 | GradientOptions.Leave = clRed 227 | GradientOptions.Down = clMaroon 228 | ControlStyle = [] 229 | Font.Charset = DEFAULT_CHARSET 230 | Font.Color = 14123546 231 | Font.Height = -16 232 | Font.Name = 'Segoe UI Semibold' 233 | Font.Style = [] 234 | SubTextFont.Charset = DEFAULT_CHARSET 235 | SubTextFont.Color = 14123546 236 | SubTextFont.Height = -13 237 | SubTextFont.Name = 'Segoe UI' 238 | SubTextFont.Style = [] 239 | FontAutoSize.Enabled = False 240 | FontAutoSize.Max = -1 241 | FontAutoSize.Min = -1 242 | Text = '' 243 | SubText = 'Hello World!' 244 | AutoExtendImage = False 245 | State = mbsLeave 246 | Colors.Enter = 5771359 247 | Colors.Leave = 4853328 248 | Colors.Down = 3539258 249 | Colors.BLine = 3539258 250 | Preset.Color = clBlue 251 | Preset.Kind = cbprCustom 252 | Preset.PenColorAuto = True 253 | Preset.ApplyOnce = False 254 | Preset.IgnoreGlobalSync = False 255 | UnderLine.Enable = True 256 | UnderLine.UnderLineRound = True 257 | UnderLine.UnderLineThicknes = 6 258 | TextColors.Enter = clWhite 259 | TextColors.Leave = clWhite 260 | TextColors.Down = clWhite 261 | TextColors.BLine = clBlack 262 | Pen.Color = 2886678 263 | Pen.Width = 0 264 | Pen.EnableAlternativeColors = False 265 | Pen.FormSyncedColor = False 266 | Pen.AltHoverColor = clBlack 267 | Pen.AltPressColor = clBlack 268 | Pen.GlobalPresetExcept = False 269 | Animations.PressAnimation = True 270 | Animations.PADelay = 2 271 | Animations.PAShrinkAmount = 4 272 | Animations.PAAnimateEngine = cbneAtDraw 273 | Animations.FadeAnimation = True 274 | Animations.FASpeed = 10 275 | end 276 | end 277 | end 278 | end 279 | object Panel2: TPanel 280 | AlignWithMargins = True 281 | Left = 25 282 | Top = 50 283 | Width = 250 284 | Height = 386 285 | Margins.Left = 25 286 | Margins.Top = 25 287 | Margins.Right = 25 288 | Margins.Bottom = 25 289 | Align = alLeft 290 | BevelOuter = bvNone 291 | Caption = 'Panel1' 292 | ParentColor = True 293 | ShowCaption = False 294 | TabOrder = 1 295 | object Song_Cover: CImage 296 | AlignWithMargins = True 297 | Left = 25 298 | Top = 25 299 | Width = 200 300 | Height = 200 301 | Margins.Left = 25 302 | Margins.Top = 25 303 | Margins.Right = 25 304 | Margins.Bottom = 5 305 | Align = alTop 306 | GifSettings.Enable = False 307 | GifSettings.AnimationSpeed = 100 308 | PopupMenu = Popup_Right 309 | ExplicitWidth = 372 310 | end 311 | object Download_Item: CButton 312 | AlignWithMargins = True 313 | Left = 15 314 | Top = 235 315 | Width = 220 316 | Height = 38 317 | Margins.Left = 15 318 | Margins.Top = 5 319 | Margins.Right = 15 320 | Margins.Bottom = 0 321 | OnEnter = Download_ItemEnter 322 | OnClick = Download_ItemClick 323 | TabOrder = 0 324 | Align = alTop 325 | BSegoeIcon = #59542 326 | ButtonIcon = cicSegoeFluent 327 | UseAccentColor = None 328 | GradientOptions.Enabled = False 329 | GradientOptions.Enter = clFuchsia 330 | GradientOptions.Leave = clRed 331 | GradientOptions.Down = clMaroon 332 | ControlStyle = [] 333 | Font.Charset = DEFAULT_CHARSET 334 | Font.Color = 14123546 335 | Font.Height = -16 336 | Font.Name = 'Segoe UI Semibold' 337 | Font.Style = [] 338 | SubTextFont.Charset = DEFAULT_CHARSET 339 | SubTextFont.Color = 14123546 340 | SubTextFont.Height = -13 341 | SubTextFont.Name = 'Segoe UI' 342 | SubTextFont.Style = [] 343 | FontAutoSize.Enabled = False 344 | FontAutoSize.Max = -1 345 | FontAutoSize.Min = -1 346 | Text = 'Download' 347 | SubText = 'Hello World!' 348 | AutoExtendImage = False 349 | State = mbsLeave 350 | Colors.Enter = 5771359 351 | Colors.Leave = 4853328 352 | Colors.Down = 3539258 353 | Colors.BLine = 3539258 354 | Preset.Color = clBlue 355 | Preset.Kind = cbprCustom 356 | Preset.PenColorAuto = True 357 | Preset.ApplyOnce = False 358 | Preset.IgnoreGlobalSync = False 359 | UnderLine.Enable = True 360 | UnderLine.UnderLineRound = True 361 | UnderLine.UnderLineThicknes = 6 362 | TextColors.Enter = clWhite 363 | TextColors.Leave = clWhite 364 | TextColors.Down = clWhite 365 | TextColors.BLine = clBlack 366 | Pen.Color = 2886678 367 | Pen.Width = 0 368 | Pen.EnableAlternativeColors = False 369 | Pen.FormSyncedColor = False 370 | Pen.AltHoverColor = clBlack 371 | Pen.AltPressColor = clBlack 372 | Pen.GlobalPresetExcept = False 373 | Animations.PressAnimation = True 374 | Animations.PADelay = 2 375 | Animations.PAShrinkAmount = 4 376 | Animations.PAAnimateEngine = cbneAtDraw 377 | Animations.FadeAnimation = True 378 | Animations.FASpeed = 10 379 | end 380 | object Song_Rating: CStarRate 381 | AlignWithMargins = True 382 | Left = 15 383 | Top = 288 384 | Width = 220 385 | Height = 40 386 | Margins.Left = 15 387 | Margins.Top = 15 388 | Margins.Right = 15 389 | Margins.Bottom = 0 390 | Align = alTop 391 | ViewOnly = False 392 | Spacing = 5 393 | StarDesign.Color = clYellow 394 | StarDesign.BorderColor = 4500987 395 | StarDesign.InactiveColor = clGray 396 | StarDesign.InactiveBorderColor = clWindowFrame 397 | StarDesign.Border = True 398 | StarDesign.BorderThickness = 10 399 | StarsDrawn = 5 400 | Rating = 0 401 | MaximumRating = 10 402 | MinimumRating = 0 403 | OnSelect = Song_RatingSelect 404 | end 405 | object Save_Button_Star: CButton 406 | AlignWithMargins = True 407 | Left = 190 408 | Top = 333 409 | Width = 45 410 | Height = 40 411 | Margins.Left = 190 412 | Margins.Top = 5 413 | Margins.Right = 15 414 | Margins.Bottom = 0 415 | OnClick = Save_Button_StarClick 416 | TabOrder = 2 417 | Align = alTop 418 | Constraints.MaxWidth = 45 419 | Visible = False 420 | BSegoeIcon = #57605 421 | ButtonIcon = cicSegoeFluent 422 | UseAccentColor = None 423 | GradientOptions.Enabled = False 424 | GradientOptions.Enter = clFuchsia 425 | GradientOptions.Leave = clRed 426 | GradientOptions.Down = clMaroon 427 | ControlStyle = [] 428 | Font.Charset = DEFAULT_CHARSET 429 | Font.Color = 14123546 430 | Font.Height = -16 431 | Font.Name = 'Segoe UI Semibold' 432 | Font.Style = [] 433 | SubTextFont.Charset = DEFAULT_CHARSET 434 | SubTextFont.Color = 14123546 435 | SubTextFont.Height = -13 436 | SubTextFont.Name = 'Segoe UI' 437 | SubTextFont.Style = [] 438 | FontAutoSize.Enabled = False 439 | FontAutoSize.Max = -1 440 | FontAutoSize.Min = -1 441 | Text = '' 442 | SubText = 'Hello World!' 443 | AutoExtendImage = False 444 | State = mbsLeave 445 | Colors.Enter = 5771359 446 | Colors.Leave = 4853328 447 | Colors.Down = 3539258 448 | Colors.BLine = 3539258 449 | Preset.Color = clBlue 450 | Preset.Kind = cbprCustom 451 | Preset.PenColorAuto = True 452 | Preset.ApplyOnce = False 453 | Preset.IgnoreGlobalSync = False 454 | UnderLine.Enable = True 455 | UnderLine.UnderLineRound = True 456 | UnderLine.UnderLineThicknes = 6 457 | TextColors.Enter = clWhite 458 | TextColors.Leave = clWhite 459 | TextColors.Down = clWhite 460 | TextColors.BLine = clBlack 461 | Pen.Color = 2886678 462 | Pen.Width = 0 463 | Pen.EnableAlternativeColors = False 464 | Pen.FormSyncedColor = False 465 | Pen.AltHoverColor = clBlack 466 | Pen.AltPressColor = clBlack 467 | Pen.GlobalPresetExcept = False 468 | Animations.PressAnimation = True 469 | Animations.PADelay = 2 470 | Animations.PAShrinkAmount = 4 471 | Animations.PAAnimateEngine = cbneAtDraw 472 | Animations.FadeAnimation = True 473 | Animations.FASpeed = 10 474 | end 475 | end 476 | object Popup_Right: TPopupMenu 477 | OwnerDraw = True 478 | Left = 421 479 | Top = 294 480 | object Information1: TMenuItem 481 | Caption = 'Save Cover' 482 | Hint = #59675 483 | OnClick = Information1Click 484 | end 485 | object SaveLargeCover1: TMenuItem 486 | Tag = 1 487 | Caption = 'Save Large Cover' 488 | Hint = #59675 489 | OnClick = Information1Click 490 | end 491 | end 492 | object SavePicture: TSavePictureDialog 493 | Filter = 'JPEG Image File (*.jpeg)|*.jpeg' 494 | Left = 341 495 | Top = 298 496 | end 497 | end 498 | -------------------------------------------------------------------------------- /Forms/InfoForm.pas: -------------------------------------------------------------------------------- 1 | unit InfoForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Cod.SysUtils, Vcl.TitleBarCtrls, 8 | Cod.Visual.Image, Vcl.StdCtrls, Vcl.ExtCtrls, Cod.Visual.Button, Cod.Dialogs, 9 | BroadcastAPI, MainUI, Vcl.Menus, Vcl.ExtDlgs, iBroadcastUtils, 10 | Cod.Visual.StarRate, Math, Offline, Cod.ArrayHelpers; 11 | 12 | type 13 | TInfoBox = class(TForm) 14 | TitleBarPanel: TTitleBarPanel; 15 | Panel1: TPanel; 16 | Panel2: TPanel; 17 | Song_Cover: CImage; 18 | Download_Item: CButton; 19 | Popup_Right: TPopupMenu; 20 | Information1: TMenuItem; 21 | SavePicture: TSavePictureDialog; 22 | Panel3: TPanel; 23 | Song_Name: TEdit; 24 | Save_Button: CButton; 25 | Panel4: TPanel; 26 | Song_Info: TMemo; 27 | Editor_View: TPanel; 28 | Edit_Desc: TMemo; 29 | Save_Button2: CButton; 30 | Song_Rating: CStarRate; 31 | Save_Button_Star: CButton; 32 | SaveLargeCover1: TMenuItem; 33 | procedure FormCreate(Sender: TObject); 34 | procedure Download_ItemEnter(Sender: TObject); 35 | procedure Download_ItemClick(Sender: TObject); 36 | procedure Information1Click(Sender: TObject); 37 | procedure Song_NameChange(Sender: TObject); 38 | procedure Save_ButtonClick(Sender: TObject); 39 | procedure Song_NameKeyUp(Sender: TObject; var Key: Word; 40 | Shift: TShiftState); 41 | procedure Song_InfoKeyUp(Sender: TObject; var Key: Word; 42 | Shift: TShiftState); 43 | procedure Edit_DescKeyUp(Sender: TObject; var Key: Word; 44 | Shift: TShiftState); 45 | procedure Save_Button2Click(Sender: TObject); 46 | procedure Save_Button_StarClick(Sender: TObject); 47 | procedure Song_RatingSelect(Sender: TObject); 48 | private 49 | { Private declarations } 50 | procedure EditError; 51 | public 52 | { Public declarations } 53 | procedure Prepare; 54 | procedure FixUI; 55 | end; 56 | 57 | var 58 | InfoBox: TInfoBox; 59 | 60 | InfoBoxIndex: integer; 61 | InfoBoxPointer: ^TDrawableItem; 62 | 63 | implementation 64 | 65 | 66 | {$R *.dfm} 67 | 68 | procedure TInfoBox.Save_Button_StarClick(Sender: TObject); 69 | begin 70 | // Change Name 71 | try 72 | case InfoBoxPointer.Source of 73 | TDataSource.Tracks: with Tracks[InfoBoxPointer.Index] do 74 | if UpdateTrackRating(ID, Song_Rating.Rating, false) then 75 | begin 76 | // Update 77 | Rating := Song_Rating.Rating; 78 | 79 | // Playlist manage 80 | TrackRatingToLikedPlaylist(ID); 81 | 82 | // Update UI 83 | UIForm.UpdateRatingIcon; 84 | end 85 | else 86 | Song_Rating.Rating := Rating; 87 | 88 | TDataSource.Albums: with Albums[InfoBoxPointer.Index] do 89 | if UpdateAlbumRating(ID, Song_Rating.Rating, false) then 90 | // Update 91 | Rating := Song_Rating.Rating 92 | else 93 | Song_Rating.Rating := Rating; 94 | 95 | TDataSource.Artists: with Artists[InfoBoxPointer.Index] do 96 | if UpdateArtistRating(ID, Song_Rating.Rating, false) then 97 | // Update 98 | Rating := Song_Rating.Rating 99 | else 100 | Song_Rating.Rating := Rating; 101 | end; 102 | 103 | InfoBoxPointer.Rating := Song_Rating.Rating; 104 | 105 | // UI 106 | Save_Button_Star.Hide; 107 | except 108 | EditError; 109 | end; 110 | end; 111 | 112 | procedure TInfoBox.Download_ItemClick(Sender: TObject); 113 | var 114 | Output: boolean; 115 | begin 116 | Output := InfoBoxPointer.ToggleDownloaded; 117 | 118 | // Button Update 119 | CButton(Sender).Tag := Output.ToInteger; 120 | CButton(Sender).OnEnter(Sender); 121 | end; 122 | 123 | procedure TInfoBox.Download_ItemEnter(Sender: TObject); 124 | begin 125 | with CButton(Sender) do 126 | if Tag <> 0 then 127 | begin 128 | Text := CAPTION_DOWNLOADED; 129 | BSegoeIcon := ICON_DOWNLOADED; 130 | end 131 | else 132 | begin 133 | Text := CAPTION_DOWNLOAD; 134 | BSegoeIcon := ICON_DOWNLOAD; 135 | end; 136 | end; 137 | 138 | procedure TInfoBox.EditError; 139 | begin 140 | OfflineDialog('We can'#39't edit this item. Are you connected to the internet?'); 141 | end; 142 | 143 | procedure TInfoBox.Edit_DescKeyUp(Sender: TObject; var Key: Word; 144 | Shift: TShiftState); 145 | begin 146 | if Key = 27 then 147 | Editor_View.Hide; 148 | end; 149 | 150 | procedure TInfoBox.FixUI; 151 | var 152 | NewSize, Default, Val1, Val2: integer; 153 | begin 154 | // Fix order 155 | Save_Button_Star.Top := Song_Rating.BoundsRect.Bottom + 1; 156 | 157 | // Min Size 158 | Default := Panel2.Top + Panel2.Margins.Bottom 159 | + (Height-ClientHeight) + TitleBarPanel.Height + Song_Cover.Top + Song_Cover.Height + Song_Cover.Margins.Bottom; 160 | Val1 := 0; 161 | Val2 := 0; 162 | 163 | if Song_Rating.Visible then 164 | Val1 := Save_Button_Star.BoundsRect.Bottom; 165 | 166 | if Download_Item.Visible then 167 | Val2 := Download_Item.BoundsRect.Bottom; 168 | 169 | NewSize := Max(Val1, Val2) + Panel2.Margins.Top + TitleBarPanel.Height + Panel2.Margins.Bottom + (Height-ClientHeight); 170 | NewSize := Max(Default, NewSize); 171 | 172 | // Set 173 | Height := NewSize; 174 | end; 175 | 176 | procedure TInfoBox.FormCreate(Sender: TObject); 177 | var 178 | I, J: integer; 179 | begin 180 | // UX 181 | Font.Color := clWhite; 182 | with CustomTitleBar do 183 | begin 184 | Enabled := true; 185 | 186 | CaptionAlignment := taCenter; 187 | ShowIcon := false; 188 | 189 | SystemColors := false; 190 | SystemButtons := false; 191 | 192 | Control := TitleBarPanel; 193 | 194 | PrepareCustomTitleBar( TForm(Self), Color, clWhite); 195 | 196 | InactiveBackgroundColor := BackgroundColor; 197 | ButtonInactiveBackgroundColor := BackgroundColor; 198 | end; 199 | 200 | // Popup Menus 201 | for I := 0 to ComponentCount-1 do 202 | if Components[I] is TPopupMenu then 203 | with TPopupMenu(Components[I]) do 204 | for J := 0 to Items.Count-1 do 205 | begin 206 | Items[J].OnDrawItem := UIForm.PopupDraw; 207 | Items[J].OnMeasureItem := UIForm.PopupMesure; 208 | end; 209 | end; 210 | 211 | procedure TInfoBox.Information1Click(Sender: TObject); 212 | const 213 | EXT = '.jpeg'; 214 | begin 215 | // Save 216 | if not SavePicture.Execute then 217 | Exit; 218 | 219 | const LargeImage = TMenuItem(Sender).Tag = 1; 220 | 221 | try 222 | if (InfoBoxPointer.Source = TDataSource.Tracks) and LargeImage then 223 | Tracks[InfoBoxPointer.Index].GetArtwork(True).SaveToFile(SavePicture.FileName + EXT) 224 | else 225 | InfoBoxPointer.GetPicture.SaveToFile(SavePicture.FileName + EXT); 226 | except 227 | OfflineDialog('Unfortunately the download has failed. Are you connected to the internet?'); 228 | end; 229 | end; 230 | 231 | procedure TInfoBox.Prepare; 232 | begin 233 | // Starable 234 | Song_Rating.Visible := InfoBoxPointer.Source in [TDataSource.Tracks, TDataSource.Albums, TDataSource.Artists]; 235 | 236 | // Editable 237 | Song_Name.ReadOnly := (InfoBoxPointer.Source <> TDataSource.Playlists) or IsOffline; 238 | Song_Rating.ViewOnly := IsOffline or not Song_Rating.Visible; 239 | 240 | // Edit UI 241 | Save_Button.Visible := false; 242 | Save_Button_Star.Visible := false; 243 | Editor_View.Hide; 244 | 245 | // UI 246 | FixUI; 247 | end; 248 | 249 | procedure TInfoBox.Save_Button2Click(Sender: TObject); 250 | begin 251 | // Change Name 252 | try 253 | case InfoBoxPointer.Source of 254 | TDataSource.Playlists: with Playlists[InfoBoxPointer.Index] do 255 | if UpdatePlayList(InfoBoxPointer.ItemID, Name, Edit_Desc.Lines.Text, false) then 256 | // Update playlist 257 | Description := Edit_Desc.Lines.Text; 258 | end; 259 | 260 | // UI 261 | Editor_View.Hide; 262 | 263 | // New text 264 | InfoBoxPointer.ReloadSource; 265 | Song_Info.Lines.Text := InfoBoxPointer.GetPremadeInfoList; 266 | except 267 | EditError; 268 | end; 269 | end; 270 | 271 | procedure TInfoBox.Save_ButtonClick(Sender: TObject); 272 | begin 273 | // Change Name 274 | try 275 | case InfoBoxPointer.Source of 276 | TDataSource.Playlists: with Playlists[InfoBoxPointer.Index] do 277 | 278 | if UpdatePlayList(InfoBoxPointer.ItemID, Song_Name.Text, Description, false) then 279 | begin 280 | // Update Playlist 281 | Name := Song_Name.Text; 282 | 283 | // Draw 284 | InfoBoxPointer.Title := Name; 285 | end 286 | else 287 | Song_Name.Text := Name; 288 | end; 289 | 290 | // UI 291 | Save_Button.Hide; 292 | except 293 | EditError; 294 | end; 295 | end; 296 | 297 | procedure TInfoBox.Song_InfoKeyUp(Sender: TObject; var Key: Word; 298 | Shift: TShiftState); 299 | begin 300 | if (InfoBoxPointer.Source = TDataSource.Playlists) and not IsOffline then 301 | begin 302 | Editor_View.Show; 303 | Edit_Desc.Lines.Text := Playlists[InfoBoxPointer.Index].Description; 304 | 305 | Edit_Desc.SetFocus; 306 | end; 307 | end; 308 | 309 | procedure TInfoBox.Song_NameChange(Sender: TObject); 310 | begin 311 | Save_Button.Show; 312 | end; 313 | 314 | procedure TInfoBox.Song_NameKeyUp(Sender: TObject; var Key: Word; 315 | Shift: TShiftState); 316 | begin 317 | case Key of 318 | 27: if not Song_Name.ReadOnly then 319 | begin 320 | Song_Name.Text := InfoBoxPointer.Title; 321 | Save_Button.Hide; 322 | end; 323 | end; 324 | end; 325 | 326 | procedure TInfoBox.Song_RatingSelect(Sender: TObject); 327 | begin 328 | Save_Button_Star.Show; 329 | end; 330 | 331 | end. 332 | -------------------------------------------------------------------------------- /Forms/LoggingForm.pas: -------------------------------------------------------------------------------- 1 | unit LoggingForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Imaging.pngimage, 8 | Cod.Visual.Image; 9 | 10 | type 11 | TLogging = class(TForm) 12 | CImage1: CImage; 13 | Label2: TLabel; 14 | Label1: TLabel; 15 | Label3: TLabel; 16 | Log: TMemo; 17 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 18 | private 19 | { Private declarations } 20 | public 21 | { Public declarations } 22 | end; 23 | 24 | var 25 | Logging: TLogging; 26 | 27 | implementation 28 | 29 | {$R *.dfm} 30 | 31 | procedure TLogging.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 32 | begin 33 | FreeAndNil(Self); 34 | end; 35 | 36 | end. 37 | 38 | -------------------------------------------------------------------------------- /Forms/MiniPlay.pas: -------------------------------------------------------------------------------- 1 | unit MiniPlay; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 7 | System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 8 | Cod.SysUtils, Vcl.TitleBarCtrls, Cod.Visual.Image, Vcl.StdCtrls, 9 | Cod.Visual.Button, Vcl.ExtCtrls, Cod.Math, Math, Cod.Visual.Slider, 10 | SpectrumVis3D, UITypes, Cod.Animation.Component; 11 | 12 | type 13 | TMiniPlayer = class(TForm) 14 | MainContain: TPanel; 15 | TitleBarPanel: TTitleBarPanel; 16 | Mini_Song: TLabel; 17 | Mini_Cover: CImage; 18 | Mini_Artist: TLabel; 19 | Mini_Close: CButton; 20 | Button_Prev: CButton; 21 | MiniButton_Play: CButton; 22 | Button_Next: CButton; 23 | Mini_Expand: CButton; 24 | AnimTo: TTimer; 25 | AdditionalOptions: TPanel; 26 | Label3: TLabel; 27 | Mini_Seek: CSlider; 28 | Label4: TLabel; 29 | Mini_NextSong: TLabel; 30 | Mini_Shuffle: CButton; 31 | Mini_Repeat: CButton; 32 | Mini_Transparent: CButton; 33 | SpectrumView: TPanel; 34 | Visualisation_Mini: TPaintBox; 35 | NewAnimation1: TIntAnim; 36 | procedure FormCreate(Sender: TObject); 37 | procedure MoveMoveDown(Sender: TObject; Button: TMouseButton; 38 | Shift: TShiftState; X, Y: Integer); 39 | procedure Mini_ExpandClick(Sender: TObject); 40 | procedure AnimToTimer(Sender: TObject); 41 | procedure Mini_TransparentClick(Sender: TObject); 42 | procedure Mini_RepeatClick(Sender: TObject); 43 | procedure Mini_ShuffleClick(Sender: TObject); 44 | procedure MiniButton_PlayClick(Sender: TObject); 45 | procedure Button_NextClick(Sender: TObject); 46 | procedure Button_PrevClick(Sender: TObject); 47 | procedure Mini_CloseClick(Sender: TObject); 48 | procedure Mini_SeekMouseDown(Sender: TObject; Button: TMouseButton; 49 | Shift: TShiftState; X, Y: Integer); 50 | procedure Mini_SeekMouseUp(Sender: TObject; Button: TMouseButton; 51 | Shift: TShiftState; X, Y: Integer); 52 | procedure Mini_SeekChange(Sender: CSlider; Position, Max, Min: Integer); 53 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 54 | procedure FormShow(Sender: TObject); 55 | procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 56 | procedure Visualisation_MiniPaint(Sender: TObject); 57 | protected 58 | procedure CreateParams(var Params: TCreateParams); override; 59 | private 60 | { Private declarations } 61 | procedure UpdateHeights; 62 | public 63 | { Public declarations } 64 | // Window 65 | procedure RestoreMainForm; 66 | 67 | // Data 68 | procedure PreparePosition; 69 | 70 | procedure MiniSetSeek; 71 | end; 72 | 73 | const 74 | TransparentOptions: TArray = [255, 230, 200, 150, 100, 75]; 75 | 76 | var 77 | MiniPlayer: TMiniPlayer; 78 | 79 | Destination: integer; 80 | 81 | HeightNormal, 82 | HeightExtended: integer; 83 | 84 | AddonDest: integer; 85 | AnDirection: integer; 86 | AnPosition: integer; 87 | 88 | TransparentIndex: integer; 89 | 90 | NoUpdateSeek: boolean; 91 | 92 | // Experiment 93 | ExperimentalTop: boolean; 94 | 95 | implementation 96 | 97 | uses 98 | MainUI; 99 | 100 | {$R *.dfm} 101 | 102 | procedure TMiniPlayer.AnimToTimer(Sender: TObject); 103 | begin 104 | // Pos 105 | Inc(AnPosition, 5); 106 | 107 | ClientHeight := AddonDest + AnDirection * trunc(Power(Destination, AnPosition / 100)); 108 | 109 | // Disble 110 | if AnPosition >= 100 then 111 | begin 112 | ClientHeight := AddonDest + AnDirection * Destination; 113 | 114 | AnimTo.Enabled := false; 115 | end; 116 | end; 117 | 118 | procedure TMiniPlayer.Button_NextClick(Sender: TObject); 119 | begin 120 | UIForm.Action_Next.Execute; 121 | end; 122 | 123 | procedure TMiniPlayer.MiniButton_PlayClick(Sender: TObject); 124 | begin 125 | UIForm.Action_Play.Execute; 126 | end; 127 | 128 | procedure TMiniPlayer.MiniSetSeek; 129 | begin 130 | if NoUpdateSeek then 131 | Exit; 132 | 133 | Mini_Seek.Position := UIForm.Player_Position.Position; 134 | end; 135 | 136 | procedure TMiniPlayer.Button_PrevClick(Sender: TObject); 137 | begin 138 | UIForm.Action_Previous.Execute; 139 | end; 140 | 141 | procedure TMiniPlayer.Mini_CloseClick(Sender: TObject); 142 | begin 143 | RestoreMainForm; 144 | end; 145 | 146 | procedure TMiniPlayer.Mini_ExpandClick(Sender: TObject); 147 | begin 148 | if EqualApprox(ClientHeight, HeightExtended, 50) then 149 | begin 150 | Destination := HeightExtended - HeightNormal; 151 | AddonDest := HeightExtended; 152 | AnDirection := -1; 153 | end 154 | else 155 | begin 156 | Destination := HeightExtended - HeightNormal; 157 | AddonDest := HeightNormal; 158 | AnDirection := 1; 159 | end; 160 | 161 | AnPosition := 1; 162 | AnimTo.Enabled := true; 163 | end; 164 | 165 | procedure TMiniPlayer.Mini_SeekChange(Sender: CSlider; Position, Max, 166 | Min: Integer); 167 | begin 168 | if NoUpdateSeek then 169 | begin 170 | UIForm.Player_Position.Position := Position; 171 | UIForm.Player_PositionChange(Sender, Position, Max, Min); 172 | end; 173 | end; 174 | 175 | procedure TMiniPlayer.Mini_SeekMouseDown(Sender: TObject; Button: TMouseButton; 176 | Shift: TShiftState; X, Y: Integer); 177 | begin 178 | NoUpdateSeek := true; 179 | end; 180 | 181 | procedure TMiniPlayer.Mini_SeekMouseUp(Sender: TObject; Button: TMouseButton; 182 | Shift: TShiftState; X, Y: Integer); 183 | begin 184 | if NoUpdateSeek then 185 | UIForm.Player_PositionMouseUp(Sender, Button, Shift, X, Y); 186 | 187 | NoUpdateSeek := false; 188 | end; 189 | 190 | procedure TMiniPlayer.Mini_ShuffleClick(Sender: TObject); 191 | begin 192 | UIForm.ToggleShuffle( not Shuffled ); 193 | 194 | UIForm.UpdateMiniPlayer; 195 | end; 196 | 197 | procedure TMiniPlayer.Mini_RepeatClick(Sender: TObject); 198 | begin 199 | UIForm.ToggleRepeat; 200 | end; 201 | 202 | procedure TMiniPlayer.Mini_TransparentClick(Sender: TObject); 203 | begin 204 | Inc(TransparentIndex); 205 | 206 | if TransparentIndex > High(TransparentOptions) then 207 | TransparentIndex := 0; 208 | 209 | AlphaBlendValue := TransparentOptions[TransparentIndex]; 210 | end; 211 | 212 | procedure TMiniPlayer.CreateParams(var Params: TCreateParams); 213 | begin 214 | inherited; 215 | Params.ExStyle := Params.ExStyle {or WS_EX_APPWINDOW}; 216 | end; 217 | 218 | procedure TMiniPlayer.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 219 | begin 220 | if Visible then 221 | begin 222 | CanClose := false; 223 | Mini_CloseClick(Mini_Close); 224 | end; 225 | end; 226 | 227 | procedure TMiniPlayer.FormCreate(Sender: TObject); 228 | begin 229 | // UX 230 | Font.Color := clWhite; 231 | with CustomTitleBar do 232 | begin 233 | Enabled := true; 234 | 235 | CaptionAlignment := taCenter; 236 | ShowIcon := false; 237 | ShowCaption := false; 238 | 239 | SystemColors := false; 240 | SystemButtons := false; 241 | SystemHeight := false; 242 | 243 | Self.Height := Self.Height - Height; 244 | 245 | Height := 5; 246 | 247 | Control := TitleBarPanel; 248 | 249 | PrepareCustomTitleBar( TForm(Self), Color, clWhite); 250 | 251 | InactiveBackgroundColor := BackgroundColor; 252 | ButtonInactiveBackgroundColor := BackgroundColor; 253 | end; 254 | 255 | // Visualisation 256 | Spectrum_Mini := TSpectrum.Create(Visualisation_Mini.Width, Visualisation_Mini.Height); 257 | Spectrum_Mini.Height := Visualisation_Mini.Height - 20; 258 | Spectrum_Mini.Peak := TColors.Hotpink; 259 | Spectrum_Mini.BackColor := Color; 260 | 261 | // UI 262 | MainContain.Top := CustomTitlebar.Height; 263 | AdditionalOptions.Top := MainContain.Top + MainContain.Height; 264 | end; 265 | 266 | procedure TMiniPlayer.FormKeyUp(Sender: TObject; var Key: Word; 267 | Shift: TShiftState); 268 | begin 269 | // Alt 270 | if ssAlt in Shift then 271 | begin 272 | case Key of 273 | 76: UIForm.Action_Previous.Execute; 274 | 78: UIForm.Action_Next.Execute; 275 | 79: Mini_Close.OnClick(Mini_Close); 276 | 80: UIForm.Action_Play.Execute; 277 | 82: Mini_Repeat.OnClick(Mini_Repeat); 278 | 83: Mini_Shuffle.OnClick(Mini_Shuffle); 279 | end; 280 | end; 281 | 282 | Key := 0; 283 | end; 284 | 285 | procedure TMiniPlayer.FormShow(Sender: TObject); 286 | begin 287 | // Fix Titlebar 288 | CustomTitleBar.Height := 1; 289 | CustomTitleBar.Height := 0; 290 | end; 291 | 292 | procedure TMiniPlayer.MoveMoveDown(Sender: TObject; Button: TMouseButton; 293 | Shift: TShiftState; X, Y: Integer); 294 | begin 295 | ReleaseCapture; 296 | SendMessage(Self.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0); 297 | end; 298 | 299 | procedure TMiniPlayer.PreparePosition; 300 | begin 301 | Top := 20 + Screen.DesktopTop; 302 | Left := 20 + Screen.DesktopLeft; 303 | 304 | AlphaBlendValue := TransparentOptions[TransparentIndex]; 305 | 306 | // Visualisation 307 | SpectrumView.Visible := EnableVisualisations; 308 | SpectrumView.Top := MainContain.Top; 309 | 310 | // Heights 311 | UpdateHeights; 312 | ClientHeight := HeightNormal; 313 | 314 | // Show 315 | Show; 316 | 317 | // Heights 318 | UpdateHeights; 319 | ClientHeight := HeightNormal; 320 | 321 | // Fix ui 322 | MainContain.Top := -1; 323 | end; 324 | 325 | procedure TMiniPlayer.RestoreMainForm; 326 | begin 327 | Self.Hide; 328 | 329 | if ExperimentalTop then 330 | begin 331 | Self.FormStyle := fsNormal; 332 | ChangeMainForm(UIForm); 333 | end; 334 | Application.MainForm.Show; 335 | end; 336 | 337 | procedure TMiniPlayer.UpdateHeights; 338 | begin 339 | HeightNormal := MainContain.Height; 340 | if SpectrumView.Visible then 341 | Inc(HeightNormal, SpectrumView.Height); 342 | HeightExtended := HeightNormal + AdditionalOptions.Height; 343 | end; 344 | 345 | procedure TMiniPlayer.Visualisation_MiniPaint(Sender: TObject); 346 | var 347 | ARect: TRect; 348 | S: string; 349 | begin 350 | with Visualisation_Mini.Canvas do 351 | begin 352 | ARect := Visualisation_Mini.ClientRect; 353 | Brush.Style := bsClear; 354 | S := 'No visualisations'; 355 | 356 | TextRect(ARect, S, [tfSingleLine, tfCenter, tfVerticalCenter]); 357 | end; 358 | end; 359 | 360 | end. 361 | -------------------------------------------------------------------------------- /Forms/NewVersionForm.pas: -------------------------------------------------------------------------------- 1 | unit NewVersionForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.TitleBarCtrls, Vcl.Imaging.pngimage, 8 | Cod.Visual.Image, Vcl.StdCtrls, Cod.Visual.Button, Cod.SysUtils; 9 | 10 | type 11 | TNewVersion = class(TForm) 12 | TitleBarPanel: TTitleBarPanel; 13 | Label1: TLabel; 14 | CImage1: CImage; 15 | Label2: TLabel; 16 | Label3: TLabel; 17 | Label4: TLabel; 18 | Version_Old: TLabel; 19 | Version_New: TLabel; 20 | CButton1: CButton; 21 | CButton2: CButton; 22 | CButton3: CButton; 23 | procedure FormCreate(Sender: TObject); 24 | procedure CButton3Click(Sender: TObject); 25 | private 26 | { Private declarations } 27 | public 28 | { Public declarations } 29 | end; 30 | 31 | var 32 | NewVersion: TNewVersion; 33 | 34 | implementation 35 | 36 | {$R *.dfm} 37 | 38 | procedure TNewVersion.CButton3Click(Sender: TObject); 39 | begin 40 | ShellRun('https://www.codrutsoft.com/apps/ibroadcast/', true); 41 | end; 42 | 43 | procedure TNewVersion.FormCreate(Sender: TObject); 44 | begin 45 | // UX 46 | Font.Color := clWhite; 47 | with CustomTitleBar do 48 | begin 49 | Enabled := true; 50 | 51 | CaptionAlignment := taCenter; 52 | ShowIcon := false; 53 | 54 | SystemColors := false; 55 | SystemButtons := false; 56 | 57 | Control := TitleBarPanel; 58 | 59 | PrepareCustomTitleBar( TForm(Self), Color, clWhite); 60 | 61 | Self.Height := Self.Height - Height; 62 | 63 | InactiveBackgroundColor := BackgroundColor; 64 | ButtonInactiveBackgroundColor := BackgroundColor; 65 | end; 66 | end; 67 | 68 | end. 69 | -------------------------------------------------------------------------------- /Forms/Offline.dfm: -------------------------------------------------------------------------------- 1 | object OfflineForm: TOfflineForm 2 | Left = 0 3 | Top = 0 4 | BorderStyle = bsDialog 5 | Caption = 'Network Error' 6 | ClientHeight = 241 7 | ClientWidth = 484 8 | Color = 2886678 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWhite 11 | Font.Height = -19 12 | Font.Name = 'Segoe UI' 13 | Font.Style = [] 14 | Position = poMainFormCenter 15 | OnCreate = FormCreate 16 | DesignSize = ( 17 | 484 18 | 241) 19 | TextHeight = 25 20 | object Label1: TLabel 21 | Left = 96 22 | Top = 48 23 | Width = 305 24 | Height = 37 25 | Caption = 'It seems you are offline...' 26 | Font.Charset = DEFAULT_CHARSET 27 | Font.Color = clWhite 28 | Font.Height = -27 29 | Font.Name = 'Segoe UI Semibold' 30 | Font.Style = [] 31 | ParentFont = False 32 | end 33 | object DataText: TLabel 34 | Left = 96 35 | Top = 91 36 | Width = 368 37 | Height = 78 38 | AutoSize = False 39 | Caption = 'Are you connected to the internet?' 40 | EllipsisPosition = epEndEllipsis 41 | WordWrap = True 42 | end 43 | object Label3: TLabel 44 | Left = 24 45 | Top = 48 46 | Width = 53 47 | Height = 53 48 | Caption = #62340 49 | Font.Charset = DEFAULT_CHARSET 50 | Font.Color = clWhite 51 | Font.Height = -53 52 | Font.Name = 'Segoe Fluent Icons' 53 | Font.Style = [] 54 | ParentFont = False 55 | end 56 | object TitleBarPanel: TTitleBarPanel 57 | Left = 0 58 | Top = 0 59 | Width = 484 60 | Height = 31 61 | CustomButtons = <> 62 | end 63 | object Download_Item: CButton 64 | AlignWithMargins = True 65 | Left = 328 66 | Top = 190 67 | Width = 136 68 | Height = 38 69 | Margins.Left = 5 70 | Margins.Top = 8 71 | Margins.Right = 15 72 | Margins.Bottom = 8 73 | ModalResult = 1 74 | TabOrder = 1 75 | Anchors = [akRight, akBottom] 76 | BSegoeIcon = #57345 77 | ButtonIcon = cicSegoeFluent 78 | UseAccentColor = None 79 | GradientOptions.Enabled = False 80 | GradientOptions.Enter = clFuchsia 81 | GradientOptions.Leave = clRed 82 | GradientOptions.Down = clMaroon 83 | ControlStyle = [] 84 | Font.Charset = DEFAULT_CHARSET 85 | Font.Color = 14123546 86 | Font.Height = -16 87 | Font.Name = 'Segoe UI Semibold' 88 | Font.Style = [] 89 | SubTextFont.Charset = DEFAULT_CHARSET 90 | SubTextFont.Color = 14123546 91 | SubTextFont.Height = -13 92 | SubTextFont.Name = 'Segoe UI' 93 | SubTextFont.Style = [] 94 | FontAutoSize.Enabled = False 95 | FontAutoSize.Max = -1 96 | FontAutoSize.Min = -1 97 | Text = 'Okay' 98 | SubText = 'Hello World!' 99 | AutoExtendImage = False 100 | State = mbsLeave 101 | Colors.Enter = 5771359 102 | Colors.Leave = 4853328 103 | Colors.Down = 3539258 104 | Colors.BLine = 3539258 105 | Preset.Color = clBlue 106 | Preset.Kind = cbprCustom 107 | Preset.PenColorAuto = True 108 | Preset.ApplyOnce = False 109 | Preset.IgnoreGlobalSync = False 110 | UnderLine.Enable = True 111 | UnderLine.UnderLineRound = True 112 | UnderLine.UnderLineThicknes = 6 113 | TextColors.Enter = clWhite 114 | TextColors.Leave = clWhite 115 | TextColors.Down = clWhite 116 | TextColors.BLine = clBlack 117 | Pen.Color = 2886678 118 | Pen.Width = 0 119 | Pen.EnableAlternativeColors = False 120 | Pen.FormSyncedColor = False 121 | Pen.AltHoverColor = clBlack 122 | Pen.AltPressColor = clBlack 123 | Pen.GlobalPresetExcept = False 124 | Animations.PressAnimation = True 125 | Animations.PADelay = 2 126 | Animations.PAShrinkAmount = 4 127 | Animations.PAAnimateEngine = cbneAtDraw 128 | Animations.FadeAnimation = True 129 | Animations.FASpeed = 10 130 | end 131 | end 132 | -------------------------------------------------------------------------------- /Forms/Offline.pas: -------------------------------------------------------------------------------- 1 | unit Offline; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.TitleBarCtrls, 8 | Cod.Visual.Button, Cod.SysUtils; 9 | 10 | type 11 | TOfflineForm = class(TForm) 12 | Label1: TLabel; 13 | DataText: TLabel; 14 | Label3: TLabel; 15 | TitleBarPanel: TTitleBarPanel; 16 | Download_Item: CButton; 17 | procedure FormCreate(Sender: TObject); 18 | private 19 | { Private declarations } 20 | public 21 | { Public declarations } 22 | end; 23 | 24 | procedure OfflineDialog(Data: string); 25 | 26 | var 27 | OfflineForm: TOfflineForm; 28 | 29 | implementation 30 | 31 | procedure OfflineDialog(Data: string); 32 | begin 33 | OfflineForm := TOfflineForm.Create(Application); 34 | try 35 | OfflineForm.DataText.Caption := Data; 36 | 37 | OfflineForm.ShowModal; 38 | finally 39 | OfflineForm.Free; 40 | end; 41 | end; 42 | 43 | {$R *.dfm} 44 | 45 | procedure TOfflineForm.FormCreate(Sender: TObject); 46 | begin 47 | // UX 48 | Font.Color := clWhite; 49 | with CustomTitleBar do 50 | begin 51 | Enabled := true; 52 | 53 | CaptionAlignment := taCenter; 54 | ShowIcon := false; 55 | 56 | SystemColors := false; 57 | SystemButtons := false; 58 | 59 | Control := TitleBarPanel; 60 | 61 | PrepareCustomTitleBar( TForm(Self), Color, clWhite); 62 | 63 | Self.Height := Self.Height - Height; 64 | 65 | InactiveBackgroundColor := BackgroundColor; 66 | ButtonInactiveBackgroundColor := BackgroundColor; 67 | end; 68 | end; 69 | 70 | end. 71 | -------------------------------------------------------------------------------- /Forms/Performance.dfm: -------------------------------------------------------------------------------- 1 | object PerfForm: TPerfForm 2 | Left = 0 3 | Top = 0 4 | BorderIcons = [biSystemMenu] 5 | Caption = 'CPU Performance Form' 6 | ClientHeight = 341 7 | ClientWidth = 709 8 | Color = 2886678 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | Position = poMainFormCenter 15 | OnClose = FormClose 16 | OnCloseQuery = FormCloseQuery 17 | OnCreate = FormCreate 18 | TextHeight = 13 19 | object PaintBox1: TPaintBox 20 | Left = 0 21 | Top = 25 22 | Width = 709 23 | Height = 316 24 | Align = alClient 25 | OnPaint = PaintBox1Paint 26 | ExplicitTop = 31 27 | end 28 | object TitleBarPanel: TTitleBarPanel 29 | Left = 0 30 | Top = 0 31 | Width = 709 32 | Height = 25 33 | CustomButtons = <> 34 | end 35 | object AddNew: TTimer 36 | Enabled = False 37 | Interval = 250 38 | OnTimer = AddNewTimer 39 | Left = 32 40 | Top = 24 41 | end 42 | end 43 | -------------------------------------------------------------------------------- /Forms/Performance.pas: -------------------------------------------------------------------------------- 1 | unit Performance; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 7 | System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 8 | Cod.Types, Vcl.TitleBarCtrls, Vcl.ExtCtrls, Cod.SysUtils, Bass, 9 | Cod.Math, Cod.StringUtils; 10 | 11 | type 12 | TPerfForm = class(TForm) 13 | TitleBarPanel: TTitleBarPanel; 14 | PaintBox1: TPaintBox; 15 | AddNew: TTimer; 16 | procedure FormCreate(Sender: TObject); 17 | procedure PaintBox1Paint(Sender: TObject); 18 | procedure AddNewTimer(Sender: TObject); 19 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 20 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 21 | private 22 | { Private declarations } 23 | const 24 | PERF_MAX_VALUES = 300; 25 | PERF_SEGMENT_TEXT = 30; 26 | 27 | var 28 | ValuesList: array[0..PERF_MAX_VALUES-1] of single; 29 | public 30 | { Public declarations } 31 | procedure AddValue; 32 | 33 | function Peak: single; 34 | end; 35 | 36 | var 37 | PerfForm: TPerfForm; 38 | 39 | implementation 40 | 41 | {$R *.dfm} 42 | 43 | procedure TPerfForm.AddNewTimer(Sender: TObject); 44 | begin 45 | AddValue; 46 | 47 | if Self.Visible then 48 | PaintBox1.Repaint; 49 | end; 50 | 51 | procedure TPerfForm.AddValue; 52 | var 53 | I: Integer; 54 | begin 55 | // Move all down 56 | for I := 0 to PERF_MAX_VALUES-2 do 57 | ValuesList[I] := ValuesList[I+1]; 58 | 59 | // Set 60 | ValuesList[PERF_MAX_VALUES-1] := BASS_GetCPU; 61 | end; 62 | 63 | procedure TPerfForm.FormClose(Sender: TObject; var Action: TCloseAction); 64 | begin 65 | FreeAndNil(PerfForm); 66 | end; 67 | 68 | procedure TPerfForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 69 | begin 70 | // Clear data 71 | for var I := 0 to PERF_MAX_VALUES-1 do 72 | ValuesList[I] := 0; 73 | 74 | // Timer 75 | AddNew.Enabled := false; 76 | end; 77 | 78 | procedure TPerfForm.FormCreate(Sender: TObject); 79 | begin 80 | // UX 81 | Font.Color := clWhite; 82 | with CustomTitleBar do 83 | begin 84 | Enabled := true; 85 | 86 | CaptionAlignment := taCenter; 87 | ShowIcon := false; 88 | 89 | SystemColors := false; 90 | SystemButtons := false; 91 | 92 | Control := TitleBarPanel; 93 | 94 | PrepareCustomTitleBar( TForm(Self), Color, clWhite); 95 | 96 | InactiveBackgroundColor := BackgroundColor; 97 | ButtonInactiveBackgroundColor := BackgroundColor; 98 | end; 99 | end; 100 | 101 | procedure TPerfForm.PaintBox1Paint(Sender: TObject); 102 | var 103 | Max, Amplify: single; 104 | I, X, Y, TextH, UsgSize: integer; 105 | DrawRect: TRect; 106 | S: string; 107 | begin 108 | with PaintBox1.Canvas do 109 | begin 110 | // Style 111 | Font.Assign(Self.Font); 112 | Brush.Style := bsClear; 113 | Font.Size := 12; 114 | 115 | // Data 116 | Max := Peak; 117 | 118 | TextH := TextHeight('12345'); 119 | DrawRect := Rect(0, TextH * 2, PaintBox1.Width, PaintBox1.Height - TextH * 2); 120 | 121 | if Max <> 0 then 122 | Amplify := DrawRect.Height / Max 123 | else 124 | Amplify := 1; 125 | 126 | // Info 127 | S := Format('Peak: %G%%', [trunc(Max * 100) / 100]); 128 | TextOut( TextH, 0, S ); 129 | 130 | S := Format('Current: %G%%', [trunc(ValuesList[High(ValuesList)] * 100) / 100]); 131 | TextOut( PaintBox1.Width - TextWidth(S) - TextH, 0, S ); 132 | 133 | // Lines Separate 134 | Pen.Color := clWhite; 135 | Pen.Width := 1; 136 | 137 | MoveTo(0, trunc(TextH * 1.5)); 138 | LineTo(PaintBox1.Width, trunc(TextH * 1.5)); 139 | 140 | // Line Style 141 | Pen.Color := clRed; 142 | Pen.Width := 2; 143 | 144 | // Draw 145 | UsgSize := round(ValuesList[0] * Amplify); 146 | MoveTo(0, TextH + DrawRect.Height + DrawRect.Top - UsgSize); 147 | for I := 1 to High(ValuesList) do 148 | begin 149 | UsgSize := round(ValuesList[I] * Amplify); 150 | 151 | X := round(I / High(ValuesList) * PaintBox1.Width); 152 | Y := TextH + DrawRect.Height + DrawRect.Top - UsgSize; 153 | 154 | LineTo( X, Y ); 155 | 156 | if I mod PERF_SEGMENT_TEXT = 0 then begin 157 | Font.Size := 8; 158 | S := (trunc(ValuesList[I] * 1000)/1000).ToString; 159 | 160 | TextOut( X - TextWidth(S) div 2, DrawRect.Bottom + TextH, S); 161 | end; 162 | 163 | MoveTo( X, Y ); 164 | end; 165 | end; 166 | end; 167 | 168 | function TPerfForm.Peak: single; 169 | var 170 | I: Integer; 171 | begin 172 | Result := 0; 173 | for I := 0 to High(ValuesList) do 174 | if ValuesList[I] > Result then 175 | Result := ValuesList[I]; 176 | end; 177 | 178 | end. 179 | -------------------------------------------------------------------------------- /Forms/PickerDialogForm.dfm: -------------------------------------------------------------------------------- 1 | object PickerDialog: TPickerDialog 2 | Left = 0 3 | Top = 0 4 | BorderIcons = [] 5 | BorderStyle = bsSingle 6 | Caption = 'Pick' 7 | ClientHeight = 441 8 | ClientWidth = 384 9 | Color = 5445417 10 | DoubleBuffered = True 11 | Font.Charset = DEFAULT_CHARSET 12 | Font.Color = clWhite 13 | Font.Height = -12 14 | Font.Name = 'Segoe UI' 15 | Font.Style = [] 16 | Position = poMainFormCenter 17 | OnCreate = FormCreate 18 | OnMouseWheel = FormMouseWheel 19 | TextHeight = 15 20 | object TitleBarPanel: TTitleBarPanel 21 | Left = 0 22 | Top = 0 23 | Width = 384 24 | Height = 25 25 | CustomButtons = <> 26 | end 27 | object Panel1: TPanel 28 | Left = 0 29 | Top = 25 30 | Width = 384 31 | Height = 346 32 | Align = alClient 33 | BevelOuter = bvNone 34 | Caption = 'Panel1' 35 | ParentBackground = False 36 | ParentColor = True 37 | ShowCaption = False 38 | TabOrder = 1 39 | object TItle_Name: TLabel 40 | AlignWithMargins = True 41 | Left = 25 42 | Top = 5 43 | Width = 291 44 | Height = 37 45 | Margins.Left = 25 46 | Margins.Top = 5 47 | Margins.Right = 25 48 | Margins.Bottom = 5 49 | Align = alTop 50 | Caption = 'Pick from the following:' 51 | Font.Charset = DEFAULT_CHARSET 52 | Font.Color = clWhite 53 | Font.Height = -27 54 | Font.Name = 'Segoe UI Semibold' 55 | Font.Style = [] 56 | ParentFont = False 57 | WordWrap = True 58 | end 59 | object Panel3: TPanel 60 | AlignWithMargins = True 61 | Left = 20 62 | Top = 55 63 | Width = 344 64 | Height = 283 65 | Margins.Left = 20 66 | Margins.Top = 8 67 | Margins.Right = 20 68 | Margins.Bottom = 8 69 | Align = alClient 70 | BevelOuter = bvNone 71 | Caption = 'Panel1' 72 | ParentBackground = False 73 | ParentColor = True 74 | ShowCaption = False 75 | TabOrder = 0 76 | DesignSize = ( 77 | 344 78 | 283) 79 | object DrawBox: TPaintBox 80 | Left = 0 81 | Top = 41 82 | Width = 332 83 | Height = 242 84 | Align = alClient 85 | OnClick = DrawBoxClick 86 | OnMouseMove = DrawBoxMouseMove 87 | OnPaint = DrawBoxPaint 88 | ExplicitLeft = -6 89 | end 90 | object ScrollBar1: TScrollBar 91 | Left = 332 92 | Top = 41 93 | Width = 12 94 | Height = 242 95 | Align = alRight 96 | Kind = sbVertical 97 | PageSize = 0 98 | TabOrder = 0 99 | OnChange = ScrollBar1Change 100 | end 101 | object Panel4: TPanel 102 | AlignWithMargins = True 103 | Left = 0 104 | Top = 5 105 | Width = 344 106 | Height = 36 107 | Margins.Left = 0 108 | Margins.Top = 5 109 | Margins.Right = 0 110 | Margins.Bottom = 0 111 | Align = alTop 112 | BevelOuter = bvNone 113 | Caption = 'Panel1' 114 | ParentBackground = False 115 | ParentColor = True 116 | ShowCaption = False 117 | TabOrder = 1 118 | end 119 | object SearchBox1: TSearchBox 120 | Left = 52 121 | Top = 12 122 | Width = 213 123 | Height = 23 124 | Anchors = [akLeft, akTop, akRight] 125 | Font.Charset = DEFAULT_CHARSET 126 | Font.Color = clBlack 127 | Font.Height = -12 128 | Font.Name = 'Segoe UI' 129 | Font.Style = [] 130 | ParentFont = False 131 | TabOrder = 2 132 | TextHint = 'Filter' 133 | OnInvokeSearch = SearchBox1InvokeSearch 134 | end 135 | end 136 | end 137 | object Panel2: TPanel 138 | AlignWithMargins = True 139 | Left = 0 140 | Top = 376 141 | Width = 384 142 | Height = 65 143 | Margins.Left = 0 144 | Margins.Top = 5 145 | Margins.Right = 0 146 | Margins.Bottom = 0 147 | Align = alBottom 148 | BevelOuter = bvNone 149 | Caption = 'Panel1' 150 | Color = 2690068 151 | ParentBackground = False 152 | ShowCaption = False 153 | TabOrder = 2 154 | object CButton1: CButton 155 | AlignWithMargins = True 156 | Left = 15 157 | Top = 8 158 | Width = 170 159 | Height = 49 160 | Margins.Left = 15 161 | Margins.Top = 8 162 | Margins.Right = 5 163 | Margins.Bottom = 8 164 | ModalResult = 2 165 | TabOrder = 0 166 | Align = alLeft 167 | BSegoeIcon = #59153 168 | ButtonIcon = cicSegoeFluent 169 | UseAccentColor = None 170 | GradientOptions.Enabled = False 171 | GradientOptions.Enter = clFuchsia 172 | GradientOptions.Leave = clRed 173 | GradientOptions.Down = clMaroon 174 | ControlStyle = [] 175 | Font.Charset = DEFAULT_CHARSET 176 | Font.Color = 14123546 177 | Font.Height = -16 178 | Font.Name = 'Segoe UI Semibold' 179 | Font.Style = [] 180 | SubTextFont.Charset = DEFAULT_CHARSET 181 | SubTextFont.Color = 14123546 182 | SubTextFont.Height = -13 183 | SubTextFont.Name = 'Segoe UI' 184 | SubTextFont.Style = [] 185 | FontAutoSize.Enabled = False 186 | FontAutoSize.Max = -1 187 | FontAutoSize.Min = -1 188 | Text = 'Cancel' 189 | SubText = 'Hello World!' 190 | AutoExtendImage = False 191 | State = mbsLeave 192 | Colors.Enter = 7807034 193 | Colors.Leave = 4395553 194 | Colors.Down = 4723491 195 | Colors.BLine = 4723491 196 | Preset.Color = clBlue 197 | Preset.Kind = cbprCustom 198 | Preset.PenColorAuto = True 199 | Preset.ApplyOnce = False 200 | Preset.IgnoreGlobalSync = False 201 | UnderLine.Enable = True 202 | UnderLine.UnderLineRound = True 203 | UnderLine.UnderLineThicknes = 6 204 | TextColors.Enter = clWhite 205 | TextColors.Leave = clWhite 206 | TextColors.Down = clWhite 207 | TextColors.BLine = clBlack 208 | Pen.Color = 2690068 209 | Pen.Width = 0 210 | Pen.EnableAlternativeColors = False 211 | Pen.FormSyncedColor = False 212 | Pen.AltHoverColor = clBlack 213 | Pen.AltPressColor = clBlack 214 | Pen.GlobalPresetExcept = False 215 | Animations.PressAnimation = True 216 | Animations.PADelay = 2 217 | Animations.PAShrinkAmount = 4 218 | Animations.PAAnimateEngine = cbneAtDraw 219 | Animations.FadeAnimation = True 220 | Animations.FASpeed = 10 221 | end 222 | object Download_Item: CButton 223 | AlignWithMargins = True 224 | Left = 199 225 | Top = 8 226 | Width = 170 227 | Height = 49 228 | Margins.Left = 5 229 | Margins.Top = 8 230 | Margins.Right = 15 231 | Margins.Bottom = 8 232 | ModalResult = 1 233 | TabOrder = 1 234 | Align = alRight 235 | BSegoeIcon = #57345 236 | ButtonIcon = cicSegoeFluent 237 | UseAccentColor = None 238 | GradientOptions.Enabled = False 239 | GradientOptions.Enter = clFuchsia 240 | GradientOptions.Leave = clRed 241 | GradientOptions.Down = clMaroon 242 | ControlStyle = [] 243 | Font.Charset = DEFAULT_CHARSET 244 | Font.Color = 14123546 245 | Font.Height = -16 246 | Font.Name = 'Segoe UI Semibold' 247 | Font.Style = [] 248 | SubTextFont.Charset = DEFAULT_CHARSET 249 | SubTextFont.Color = 14123546 250 | SubTextFont.Height = -13 251 | SubTextFont.Name = 'Segoe UI' 252 | SubTextFont.Style = [] 253 | FontAutoSize.Enabled = False 254 | FontAutoSize.Max = -1 255 | FontAutoSize.Min = -1 256 | Text = 'Select' 257 | SubText = 'Hello World!' 258 | AutoExtendImage = False 259 | State = mbsLeave 260 | Colors.Enter = 5771359 261 | Colors.Leave = 4853328 262 | Colors.Down = 3539258 263 | Colors.BLine = 3539258 264 | Preset.Color = clBlue 265 | Preset.Kind = cbprCustom 266 | Preset.PenColorAuto = True 267 | Preset.ApplyOnce = False 268 | Preset.IgnoreGlobalSync = False 269 | UnderLine.Enable = True 270 | UnderLine.UnderLineRound = True 271 | UnderLine.UnderLineThicknes = 6 272 | TextColors.Enter = clWhite 273 | TextColors.Leave = clWhite 274 | TextColors.Down = clWhite 275 | TextColors.BLine = clBlack 276 | Pen.Color = 2690068 277 | Pen.Width = 0 278 | Pen.EnableAlternativeColors = False 279 | Pen.FormSyncedColor = False 280 | Pen.AltHoverColor = clBlack 281 | Pen.AltPressColor = clBlack 282 | Pen.GlobalPresetExcept = False 283 | Animations.PressAnimation = True 284 | Animations.PADelay = 2 285 | Animations.PAShrinkAmount = 4 286 | Animations.PAAnimateEngine = cbneAtDraw 287 | Animations.FadeAnimation = True 288 | Animations.FASpeed = 10 289 | end 290 | end 291 | end 292 | -------------------------------------------------------------------------------- /Forms/PickerDialogForm.pas: -------------------------------------------------------------------------------- 1 | unit PickerDialogForm; 2 | 3 | {$SCOPEDENUMS ON} 4 | 5 | interface 6 | 7 | uses 8 | Winapi.Windows, Winapi.Messages, System.SysUtils, Vcl.Forms, System.Variants, 9 | System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Dialogs, Vcl.TitleBarCtrls, Cod.SysUtils, 10 | Vcl.StdCtrls, Vcl.ExtCtrls, BroadcastAPI, Cod.Visual.Button, Cod.VarHelpers, 11 | Cod.Types, Cod.ColorUtils, Math, Imaging.jpeg, Vcl.WinXCtrls, Types, 12 | iBroadcastUtils, Cod.ArrayHelpers; 13 | 14 | type 15 | TPickType = (Song, Album, Artist, Playlist); 16 | 17 | TDrawItem = record 18 | Index: integer; 19 | ID: string; 20 | 21 | Name: string; 22 | ImagePointer: TJpegImage; // pointer to image 23 | 24 | Checked: boolean; 25 | Hidden: boolean; 26 | 27 | ARect: TRect; 28 | 29 | function Image: TJpegImage; 30 | end; 31 | 32 | TPickerDialog = class(TForm) 33 | TitleBarPanel: TTitleBarPanel; 34 | Panel1: TPanel; 35 | TItle_Name: TLabel; 36 | Panel2: TPanel; 37 | CButton1: CButton; 38 | Download_Item: CButton; 39 | Panel3: TPanel; 40 | DrawBox: TPaintBox; 41 | ScrollBar1: TScrollBar; 42 | Panel4: TPanel; 43 | SearchBox1: TSearchBox; 44 | procedure FormCreate(Sender: TObject); 45 | procedure DrawBoxPaint(Sender: TObject); 46 | procedure ScrollBar1Change(Sender: TObject); 47 | procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; 48 | WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 49 | procedure DrawBoxMouseMove(Sender: TObject; Shift: TShiftState; X, 50 | Y: Integer); 51 | procedure DrawBoxClick(Sender: TObject); 52 | procedure SearchBox1InvokeSearch(Sender: TObject); 53 | private 54 | const 55 | ITEM_HEIGHT = 50; 56 | ITEM_MARGIN = 3; 57 | ITEM_ROUND = 20; 58 | 59 | var 60 | { Private declarations } 61 | FKind: TPickType; 62 | FMultiSelect: boolean; 63 | FAlwaysHidden: TArray; 64 | 65 | ScrollPosition: integer; 66 | PageFit: integer; 67 | 68 | Items: TArray; 69 | HoveredItem: integer; 70 | 71 | procedure UpdateRects; 72 | procedure UpdateScroll; 73 | procedure UpdateList; 74 | function GetTotalItems: integer; 75 | 76 | procedure ApplyFilter(Value: string); 77 | 78 | // Setters 79 | procedure SetKind(const Value: TPickType); 80 | public 81 | { Public declarations } 82 | // List 83 | procedure RedrawList; 84 | 85 | function Selected: TArray; 86 | procedure SetSelected(IDs: TArray); 87 | procedure SetHidden(IDs: TArray); 88 | 89 | // Properties 90 | property Kind: TPickType read FKind write SetKind; 91 | property MultiSelect: boolean read FMultiSelect write FMultiSelect; 92 | end; 93 | 94 | function PickItems(var AItems: TArray; ItemsKind: TPickType; 95 | AMultiSelect: boolean = true; AlreadySelected: TArray = []; 96 | Hidden: TArray = []): boolean; 97 | 98 | var 99 | PickerDialog: TPickerDialog; 100 | 101 | implementation 102 | 103 | function PickItems(var AItems: TArray; ItemsKind: TPickType; 104 | AMultiSelect: boolean; AlreadySelected, Hidden: TArray): boolean; 105 | begin 106 | // Create 107 | PickerDialog := TPickerDialog.Create(Application); 108 | with PickerDialog do 109 | try 110 | // Settings 111 | Kind := ItemsKind; 112 | MultiSelect := AMultiSelect; 113 | 114 | // Selection 115 | SetHidden(Hidden); 116 | SetSelected(AlreadySelected); 117 | 118 | // Result 119 | Result := ShowModal = mrOk; 120 | if Result then 121 | AItems := Selected; 122 | finally 123 | // Free 124 | Free; 125 | end; 126 | end; 127 | 128 | {$R *.dfm} 129 | 130 | procedure TPickerDialog.ApplyFilter(Value: string); 131 | var 132 | I: Integer; 133 | begin 134 | Value := MashString(Value); 135 | 136 | // Filter 137 | if Value = '' then 138 | for I := 0 to High(Items) do 139 | Items[I].Hidden := FAlwaysHidden.Find(Items[I].ID) <> -1 140 | else 141 | for I := 0 to High(Items) do 142 | Items[I].Hidden := (Pos(Value, MashString(Items[I].Name)) = 0) or (FAlwaysHidden.Find(Items[I].ID) <> -1); 143 | 144 | // Rects 145 | UpdateRects; 146 | UpdateScroll; 147 | end; 148 | 149 | procedure TPickerDialog.DrawBoxClick(Sender: TObject); 150 | begin 151 | // Select 152 | if HoveredItem <> -1 then 153 | Items[HoveredItem].Checked := not Items[HoveredItem].Checked; 154 | 155 | RedrawList; 156 | end; 157 | 158 | procedure TPickerDialog.DrawBoxMouseMove(Sender: TObject; Shift: TShiftState; X, 159 | Y: Integer); 160 | var 161 | I: Integer; 162 | PrevItem: integer; 163 | APoint: TPoint; 164 | begin 165 | // Hover 166 | PrevItem := HoveredItem; 167 | HoveredItem := -1; 168 | APoint := Point(X, Y+ScrollPosition); 169 | for I := 0 to High(Items) do 170 | if not Items[I].Hidden then 171 | if Items[I].ARect.Contains(APoint) then 172 | begin 173 | HoveredItem := I; 174 | Break; 175 | end; 176 | 177 | // Changed 178 | if PrevItem <> HoveredItem then 179 | RedrawList; 180 | end; 181 | 182 | procedure TPickerDialog.DrawBoxPaint(Sender: TObject); 183 | var 184 | I: integer; 185 | ARect, BRect: TRect; 186 | AColor: TColor; 187 | IsSelected: boolean; 188 | AText: string; 189 | begin 190 | with DrawBox.Canvas do 191 | begin 192 | for I := 0 to High(Items) do 193 | begin 194 | ARect := Items[I].ARect; 195 | ARect.Offset(0, -ScrollPosition); 196 | 197 | if not Items[I].Hidden and ClipRect.IntersectsWith(ARect) then 198 | begin 199 | // Color 200 | if I = HoveredItem then 201 | AColor := ChangeColorSat(Color, 40) 202 | else 203 | AColor := ChangeColorSat(Color, 20); 204 | 205 | // Rect 206 | GDIRoundRect(MakeRoundRect(ARect, ITEM_ROUND), 207 | GetRGB(AColor).MakeGDIBrush, nil); 208 | 209 | // Selection 210 | IsSelected := Items[I].Checked; 211 | 212 | BRect := ARect; 213 | BRect.Width := ARect.Height; 214 | BRect.Inflate(-(ARect.Height div 4 + ITEM_MARGIN), -(ARect.Height div 4 + ITEM_MARGIN)); 215 | 216 | if IsSelected then 217 | AColor := clHighlight 218 | else 219 | AColor := clGray; 220 | 221 | GDIRoundRect(MakeRoundRect(BRect, 5), 222 | GetRGB(AColor).MakeGDIBrush, nil); 223 | 224 | if IsSelected then 225 | begin 226 | BRect.Inflate(-5, -5); 227 | 228 | GDIRoundRect(MakeRoundRect(BRect, 2), 229 | GetRGB(clWhite).MakeGDIBrush, nil); 230 | end; 231 | 232 | // Image 233 | BRect := ARect; 234 | BRect.Left := BRect.Left + ARect.Height; 235 | BRect.Width := ARect.Height; 236 | BRect.Inflate(-ITEM_MARGIN, -ITEM_MARGIN); 237 | GDIGraphicRound(Items[I].Image, BRect, ITEM_ROUND); 238 | 239 | // Text 240 | BRect := ARect; 241 | BRect.Left := BRect.Left + ARect.Height * 2; 242 | BRect.Left := BRect.Left + ITEM_MARGIN; 243 | 244 | Font.Assign(Self.Font); 245 | Font.Size := 14; 246 | Brush.Style := bsClear; 247 | AText := Items[I].Name; 248 | 249 | TextRect(BRect, AText, [tfSingleLine, tfVerticalCenter, tfEndEllipsis]); 250 | end; 251 | end; 252 | end; 253 | end; 254 | 255 | procedure TPickerDialog.FormCreate(Sender: TObject); 256 | begin 257 | // UX 258 | Font.Color := clWhite; 259 | with CustomTitleBar do 260 | begin 261 | Enabled := true; 262 | 263 | CaptionAlignment := taCenter; 264 | ShowIcon := false; 265 | 266 | SystemColors := false; 267 | SystemButtons := false; 268 | 269 | Control := TitleBarPanel; 270 | 271 | PrepareCustomTitleBar( TForm(Self), Color, clWhite); 272 | 273 | InactiveBackgroundColor := BackgroundColor; 274 | ButtonInactiveBackgroundColor := BackgroundColor; 275 | end; 276 | 277 | CustomTitleBar.ShowCaption := false; 278 | 279 | // Values 280 | HoveredItem := -1; 281 | end; 282 | 283 | procedure TPickerDialog.FormMouseWheel(Sender: TObject; Shift: TShiftState; 284 | WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 285 | const 286 | ScrollFactor = -6; 287 | begin 288 | WheelDelta := WheelDelta div ScrollFactor; 289 | 290 | ScrollBar1.Position := ScrollBar1.Position + WheelDelta; 291 | end; 292 | 293 | procedure TPickerDialog.RedrawList; 294 | begin 295 | // Repaint 296 | DrawBox.Repaint; 297 | end; 298 | 299 | procedure TPickerDialog.ScrollBar1Change(Sender: TObject); 300 | begin 301 | ScrollPosition := ScrollBar1.Position; 302 | RedrawList; 303 | end; 304 | 305 | procedure TPickerDialog.SearchBox1InvokeSearch(Sender: TObject); 306 | begin 307 | ApplyFilter(SearchBox1.Text); 308 | RedrawList; 309 | end; 310 | 311 | function TPickerDialog.Selected: TArray; 312 | var 313 | I: Integer; 314 | begin 315 | Result := []; 316 | for I := 0 to High(Items) do 317 | if Items[I].Checked then 318 | Result.AddValue(Items[I].ID); 319 | end; 320 | 321 | procedure TPickerDialog.SetHidden(IDs: TArray); 322 | begin 323 | FAlwaysHidden := IDs; 324 | 325 | UpdateList; 326 | end; 327 | 328 | procedure TPickerDialog.SetKind(const Value: TPickType); 329 | begin 330 | FKind := Value; 331 | 332 | UpdateList; 333 | end; 334 | 335 | procedure TPickerDialog.SetSelected(IDs: TArray); 336 | var 337 | I: Integer; 338 | begin 339 | for I := 0 to High(Items) do 340 | Items[I].Checked := IDs.Find(Items[I].ID) <> -1; 341 | end; 342 | 343 | procedure TPickerDialog.UpdateList; 344 | var 345 | TotalItems: integer; 346 | I: Integer; 347 | begin 348 | // Items 349 | TotalItems := GetTotalItems; 350 | 351 | SetLength(Items, TotalItems); 352 | for I := 0 to High(Items) do 353 | with Items[I] do 354 | begin 355 | case Kind of 356 | TPickType.Song: begin 357 | ID := Tracks[I].ID; 358 | Name := Tracks[I].Title; 359 | end; 360 | 361 | TPickType.Album: begin 362 | ID := Albums[I].ID; 363 | Name := Albums[I].AlbumName; 364 | end; 365 | 366 | TPickType.Artist: begin 367 | ID := Artists[I].ID; 368 | Name := Artists[I].ArtistName; 369 | end; 370 | 371 | TPickType.Playlist: begin 372 | ID := Playlists[I].ID; 373 | Name := Playlists[I].Name; 374 | end; 375 | end; 376 | 377 | Index := I; 378 | Checked := false; 379 | Hidden := false; 380 | end; 381 | 382 | // Values 383 | PageFit := DrawBox.Height div (ITEM_HEIGHT + ITEM_MARGIN); 384 | 385 | // Update 386 | SearchBox1.Text := ''; 387 | ApplyFilter(''); 388 | UpdateScroll; 389 | RedrawList; 390 | end; 391 | 392 | procedure TPickerDialog.UpdateRects; 393 | var 394 | I, Y: Integer; 395 | begin 396 | Y := 0; 397 | for I := 0 to High(Items) do 398 | begin 399 | if not Items[I].Hidden then 400 | begin 401 | with Items[I].ARect do 402 | begin 403 | Top := Y; 404 | Height := ITEM_HEIGHT; 405 | 406 | Left := 0; 407 | Right := DrawBox.Width; 408 | end; 409 | 410 | Y := Y + ITEM_HEIGHT + ITEM_MARGIN; 411 | end 412 | else 413 | Items[I].ARect := TRect.Empty; 414 | end; 415 | end; 416 | 417 | procedure TPickerDialog.UpdateScroll; 418 | var 419 | I: Integer; 420 | MaxScroll: integer; 421 | begin 422 | MaxScroll := 0; 423 | for I := 0 to High(Items) do 424 | if not Items[I].Hidden then 425 | if Items[I].ARect.Bottom > MaxScroll then 426 | MaxScroll := Items[I].ARect.Bottom; 427 | 428 | 429 | MaxScroll := MaxScroll - (ITEM_HEIGHT+ITEM_MARGIN * PageFit); 430 | if MaxScroll < 0 then 431 | MaxScroll := 0; 432 | 433 | if ScrollPosition > MaxScroll then 434 | ScrollPosition := MaxScroll; 435 | 436 | ScrollBar1.Max := MaxScroll; 437 | end; 438 | 439 | function TPickerDialog.GetTotalItems: integer; 440 | begin 441 | case Kind of 442 | TPickType.Song: Result := Length(Tracks); 443 | TPickType.Album: Result := Length(Albums); 444 | TPickType.Artist: Result := Length(Artists); 445 | TPickType.Playlist: Result := Length(Playlists); 446 | else Result := 0; 447 | end; 448 | end; 449 | 450 | { TDrawItem } 451 | 452 | function TDrawItem.Image: TJpegImage; 453 | begin 454 | if ImagePointer = nil then 455 | case PickerDialog.Kind of 456 | TPickType.Song: ImagePointer := Tracks[Index].GetArtwork(); 457 | TPickType.Album: ImagePointer := Albums[Index].GetArtwork; 458 | TPickType.Artist: ImagePointer := Artists[Index].GetArtwork; 459 | TPickType.Playlist: ImagePointer := Playlists[Index].GetArtwork; 460 | else 461 | ImagePointer := DefaultPicture; 462 | end; 463 | 464 | Result := ImagePointer; 465 | end; 466 | 467 | end. 468 | -------------------------------------------------------------------------------- /Forms/RatingPopup.pas: -------------------------------------------------------------------------------- 1 | unit RatingPopup; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Cod.Visual.Button; 8 | 9 | type 10 | TRatingPopupForm = class(TForm) 11 | Rate_Like: CButton; 12 | Rate_Close: CButton; 13 | Rate_Dislike: CButton; 14 | Rate_1: CButton; 15 | Rate_2: CButton; 16 | Rate_3: CButton; 17 | Rate_4: CButton; 18 | Rate_5: CButton; 19 | Rate_6: CButton; 20 | Rate_7: CButton; 21 | Rate_8: CButton; 22 | Rate_9: CButton; 23 | Rate_10: CButton; 24 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 25 | procedure FormDeactivate(Sender: TObject); 26 | procedure Rate_CloseClick(Sender: TObject); 27 | procedure SetRate(Sender: TObject); 28 | procedure FormPaint(Sender: TObject); 29 | private 30 | { Private declarations } 31 | public 32 | { Public declarations } 33 | procedure PrepButtons(RatingMode: boolean); 34 | end; 35 | 36 | var 37 | RatingPopupForm: TRatingPopupForm; 38 | 39 | implementation 40 | 41 | uses 42 | MainUI; 43 | 44 | {$R *.dfm} 45 | 46 | procedure TRatingPopupForm.Rate_CloseClick(Sender: TObject); 47 | begin 48 | Close; 49 | end; 50 | 51 | procedure TRatingPopupForm.SetRate(Sender: TObject); 52 | begin 53 | UIForm.SetCurrentSongRating( CButton(Sender).Tag ); 54 | 55 | Close; 56 | end; 57 | 58 | procedure TRatingPopupForm.FormClose(Sender: TObject; var Action: TCloseAction); 59 | begin 60 | Action := caFree; 61 | end; 62 | 63 | procedure TRatingPopupForm.FormDeactivate(Sender: TObject); 64 | begin 65 | Close; 66 | end; 67 | 68 | procedure TRatingPopupForm.FormPaint(Sender: TObject); 69 | begin 70 | with Canvas do 71 | begin 72 | Pen.Style := psClear; 73 | Brush.Color := $004A1047; 74 | 75 | RoundRect(ClipRect, 20, 20); 76 | end; 77 | end; 78 | 79 | procedure TRatingPopupForm.PrepButtons(RatingMode: boolean); 80 | var 81 | I: Integer; 82 | begin 83 | Rate_Like.Visible := not RatingMode; 84 | Rate_Dislike.Visible := not RatingMode; 85 | 86 | Rate_10.Visible := RatingMode; 87 | Rate_9.Visible := RatingMode; 88 | Rate_8.Visible := RatingMode; 89 | Rate_7.Visible := RatingMode; 90 | Rate_6.Visible := RatingMode; 91 | Rate_5.Visible := RatingMode; 92 | Rate_4.Visible := RatingMode; 93 | Rate_3.Visible := RatingMode; 94 | Rate_2.Visible := RatingMode; 95 | Rate_1.Visible := RatingMode; 96 | 97 | // Order 98 | for I := 0 to ControlCount-1 do 99 | if Controls[I] is CButton then 100 | Controls[I].Left := 1+ Controls[I].Tag * (Width + Controls[I].Margins.Left + Controls[I].Margins.Right); 101 | 102 | // UI 103 | if RatingMode then 104 | Rate_Close.Left := 9999 105 | else 106 | Rate_Close.Left := Rate_Dislike.Left; 107 | end; 108 | 109 | end. 110 | -------------------------------------------------------------------------------- /Forms/VolumePopup.pas: -------------------------------------------------------------------------------- 1 | unit VolumePopup; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Cod.Visual.Slider, Vcl.StdCtrls, BASS, 8 | Cod.WindowsRT.MasterVolume, Vcl.ExtCtrls, ActiveX, MMDeviceApi, Math, MMSystem, 9 | Cod.Visual.Button; 10 | 11 | type 12 | TVolumePop = class(TForm) 13 | Panel1: TPanel; 14 | Label6: TLabel; 15 | CButton18: CButton; 16 | Panel8: TPanel; 17 | Label15: TLabel; 18 | Panel9: TPanel; 19 | Label5: TLabel; 20 | Speed_Value: TLabel; 21 | Slider_Speed: CSlider; 22 | Panel10: TPanel; 23 | Label10: TLabel; 24 | Panel11: TPanel; 25 | Label11: TLabel; 26 | Bass_Value: TLabel; 27 | Slider_Bass: CSlider; 28 | Panel12: TPanel; 29 | Label14: TLabel; 30 | Panel13: TPanel; 31 | Panel2: TPanel; 32 | Label1: TLabel; 33 | System_Value: TLabel; 34 | Slider_System: CSlider; 35 | Panel3: TPanel; 36 | System_Background: TLabel; 37 | System_Volume: TLabel; 38 | Panel4: TPanel; 39 | Label2: TLabel; 40 | App_Value: TLabel; 41 | Slider_App: CSlider; 42 | Panel5: TPanel; 43 | App_Background: TLabel; 44 | App_Volume: TLabel; 45 | Panel6: TPanel; 46 | Label3: TLabel; 47 | Out_Device: TLabel; 48 | Panel7: TPanel; 49 | Label7: TLabel; 50 | Label4: TLabel; 51 | procedure Slider_SystemChange(Sender: CSlider; Position, Max, Min: Integer); 52 | procedure FormDeactivate(Sender: TObject); 53 | procedure Speaker_PickChange(Sender: TObject); 54 | procedure Speaker_PickDrawItem(Control: TWinControl; Index: Integer; 55 | Rect: TRect; State: TOwnerDrawState); 56 | procedure System_VolumeClick(Sender: TObject); 57 | procedure Slider_SystemMouseUp(Sender: TObject; Button: TMouseButton; 58 | Shift: TShiftState; X, Y: Integer); 59 | procedure Slider_AppChange(Sender: CSlider; Position, Max, Min: Integer); 60 | procedure Slider_AppMouseUp(Sender: TObject; Button: TMouseButton; 61 | Shift: TShiftState; X, Y: Integer); 62 | procedure App_VolumeClick(Sender: TObject); 63 | procedure Slider_BassChange(Sender: CSlider; Position, Max, Min: Integer); 64 | procedure CButton18Click(Sender: TObject); 65 | procedure Slider_SpeedChange(Sender: CSlider; Position, Max, Min: Integer); 66 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 67 | private 68 | { Private declarations } 69 | ShowAdvVolume: boolean; 70 | 71 | procedure UpdateIconStatus; 72 | 73 | procedure UpdateMainForm; 74 | public 75 | { Public declarations } 76 | procedure FullUpdate; 77 | 78 | procedure UpdateTheSize; 79 | 80 | procedure LoadVolume; 81 | procedure LoadSelectedDevice; 82 | end; 83 | 84 | var 85 | VolumePop: TVolumePop; 86 | 87 | implementation 88 | 89 | uses 90 | MainUI; 91 | 92 | {$R *.dfm} 93 | 94 | procedure TVolumePop.Slider_AppChange(Sender: CSlider; Position, Max, 95 | Min: Integer); 96 | var 97 | AMute: boolean; 98 | begin 99 | // Set 100 | try 101 | App_Value.Caption := (Position div 10).ToString; 102 | 103 | VolumeApplication.Volume := Position / 1000; 104 | 105 | // Muting 106 | AMute := VolumeApplication.Mute; 107 | if AMute and (Position > 0) then 108 | VolumeApplication.Mute := false; 109 | 110 | if not AMute and (Position = 0) then 111 | VolumeApplication.Mute := true; 112 | except 113 | //BASS_SetVolume( Position / 1000 ); 114 | end; 115 | 116 | // Icon 117 | UpdateIconStatus; 118 | 119 | // Form Status 120 | UpdateMainForm; 121 | end; 122 | 123 | procedure TVolumePop.Slider_AppMouseUp(Sender: TObject; Button: TMouseButton; 124 | Shift: TShiftState; X, Y: Integer); 125 | begin 126 | PlaySound('SYSTEMEXCLAMATION', 0, SND_ASYNC); 127 | end; 128 | 129 | procedure TVolumePop.Slider_BassChange(Sender: CSlider; Position, Max, 130 | Min: Integer); 131 | begin 132 | try 133 | Bass_Value.Caption := (Position div 10).ToString; 134 | 135 | UIForm.AudioVolume := Position / 1000; 136 | except 137 | end; 138 | 139 | // Update icons for coloring 140 | UpdateIconStatus; 141 | end; 142 | 143 | procedure TVolumePop.Slider_SpeedChange(Sender: CSlider; Position, Max, 144 | Min: Integer); 145 | begin 146 | try 147 | Speed_Value.Caption := (Position / 10).ToString; 148 | 149 | UIForm.AudioSpeed := Position / 10; 150 | except 151 | end; 152 | end; 153 | 154 | procedure TVolumePop.Slider_SystemChange(Sender: CSlider; Position, Max, Min: Integer); 155 | var 156 | AMute: boolean; 157 | begin 158 | // Set 159 | try 160 | System_Value.Caption := (Position div 10).ToString; 161 | 162 | VolumeSystem.Volume := Position / 1000; 163 | 164 | // Muting 165 | AMute := VolumeSystem.Mute; 166 | if AMute and (Position > 0) then 167 | VolumeSystem.Mute := false; 168 | 169 | if not AMute and (Position = 0) then 170 | VolumeSystem.Mute := true; 171 | except 172 | //BASS_SetVolume( Position / 1000 ); 173 | end; 174 | 175 | // Icon 176 | UpdateIconStatus; 177 | end; 178 | 179 | procedure TVolumePop.Slider_SystemMouseUp(Sender: TObject; Button: TMouseButton; 180 | Shift: TShiftState; X, Y: Integer); 181 | begin 182 | PlaySound('SYSTEMEXCLAMATION', 0, SND_ASYNC or SND_SYSTEM); 183 | end; 184 | 185 | procedure TVolumePop.CButton18Click(Sender: TObject); 186 | begin 187 | ShowAdvVolume := not Panel8.Visible; 188 | 189 | // UI 190 | if ShowAdvVolume then 191 | CButton(Sender).BSegoeIcon := #$E010 192 | else 193 | CButton(Sender).BSegoeIcon := #$E011; 194 | 195 | // Update 196 | UpdateTheSize; 197 | end; 198 | 199 | procedure TVolumePop.FormClose(Sender: TObject; var Action: TCloseAction); 200 | begin 201 | FreeAndNil( VolumePop ); 202 | end; 203 | 204 | procedure TVolumePop.FormDeactivate(Sender: TObject); 205 | begin 206 | Hide; 207 | end; 208 | 209 | procedure TVolumePop.FullUpdate; 210 | begin 211 | LoadVolume; 212 | 213 | // Selected 214 | LoadSelectedDevice; 215 | end; 216 | 217 | procedure TVolumePop.System_VolumeClick(Sender: TObject); 218 | begin 219 | VolumeSystem.Mute := not VolumeSystem.Mute; 220 | UpdateIconStatus; 221 | 222 | UpdateMainForm; 223 | end; 224 | 225 | procedure TVolumePop.App_VolumeClick(Sender: TObject); 226 | begin 227 | VolumeApplication.Mute := not VolumeApplication.Mute; 228 | UpdateIconStatus; 229 | 230 | UpdateMainForm; 231 | end; 232 | 233 | procedure TVolumePop.LoadSelectedDevice; 234 | var 235 | deviceInfo: BASS_DEVICEINFO; 236 | begin 237 | if BASS_GetDeviceInfo(GetCurrentAudioDeviceIndex+2, deviceInfo) then 238 | Out_Device.Caption := String(deviceInfo.name) 239 | else 240 | Out_Device.Caption := 'Unknown device'; 241 | 242 | Out_Device.Hint := Out_Device.Caption; 243 | end; 244 | 245 | procedure TVolumePop.LoadVolume; 246 | begin 247 | // Volume 248 | try 249 | Slider_App.Position := trunc(VolumeApplication.Volume * 1000); 250 | Slider_System.Position := trunc(VolumeSystem.Volume * 1000); 251 | Slider_Bass.Position := trunc(UIForm.AudioVolume * 1000); 252 | except 253 | Slider_System.Position := trunc(Player.SystemVolume * 1000); 254 | end; 255 | System_Value.Caption := (Slider_System.Position div 10).ToString; 256 | App_Value.Caption := (Slider_App.Position div 10).ToString; 257 | Bass_Value.Caption := (Slider_Bass.Position div 10).ToString; 258 | 259 | // Speed 260 | try 261 | Slider_Speed.Position := trunc(UIForm.AudioSpeed * 10); 262 | except 263 | end; 264 | Speed_Value.Caption := (Slider_Speed.Position / 10).ToString; 265 | 266 | // Icon 267 | UpdateIconStatus; 268 | end; 269 | 270 | procedure TVolumePop.Speaker_PickChange(Sender: TObject); 271 | begin 272 | LoadSelectedDevice; 273 | end; 274 | 275 | procedure TVolumePop.Speaker_PickDrawItem(Control: TWinControl; Index: Integer; 276 | Rect: TRect; State: TOwnerDrawState); 277 | var 278 | AText: string; 279 | ARect: TRect; 280 | begin 281 | with TComboBox(Control).Canvas do 282 | begin 283 | // Fill 284 | ARect := Rect; 285 | ARect.Inflate(2, 2); 286 | 287 | Pen.Style := psClear; 288 | Brush.Style := bsSolid; 289 | 290 | if odSelected in State then 291 | Brush.Color := clHighlight 292 | else 293 | Brush.Color := TComboBox(Control).Color; 294 | 295 | FillRect(ARect); 296 | 297 | 298 | // Rects 299 | ARect := Rect; 300 | ARect.Width := ARect.Height; 301 | Rect.Left := Rect.Left + ARect.Width + 3; 302 | 303 | // Prepare 304 | Brush.Style := bsClear; 305 | 306 | // Text 307 | Font.Assign( TComboBox(Control).Font ); 308 | AText := TComboBox(Control).Items[Index]; 309 | 310 | TextRect( Rect, AText, [tfSingleLine, tfVerticalCenter] ); 311 | 312 | // Icon 313 | Font.Name := 'Segoe Fluent Icons'; 314 | Font.Size := 20; 315 | AText := #$E7F5; 316 | TextRect( ARect, AText, [tfSingleLine, tfVerticalCenter] ); 317 | end; 318 | end; 319 | 320 | procedure TVolumePop.UpdateIconStatus; 321 | var 322 | AMute: boolean; 323 | begin 324 | // App 325 | case ceil(VolumeApplication.Volume * 4) of 326 | 0: App_Volume.Caption := #$E992; 327 | 1: App_Volume.Caption := #$E993; 328 | 2: App_Volume.Caption := #$E994; 329 | else App_Volume.Caption := #$E995; 330 | end; 331 | 332 | AMute := VolumeApplication.Mute; 333 | if AMute then 334 | App_Volume.Caption := #$E74F; 335 | 336 | App_Background.Visible := not AMute; 337 | 338 | // System 339 | case ceil(VolumeSystem.Volume * 4) of 340 | 0: System_Volume.Caption := #$E992; 341 | 1: System_Volume.Caption := #$E993; 342 | 2: System_Volume.Caption := #$E994; 343 | else System_Volume.Caption := #$E995; 344 | end; 345 | 346 | AMute := VolumeSystem.Mute; 347 | if AMute then 348 | System_Volume.Caption := #$E74F; 349 | 350 | System_Background.Visible := not AMute; 351 | 352 | // Danger 353 | if Slider_Bass.Position > 1000 then 354 | begin 355 | Bass_Value.Font.Color := clRed; 356 | end 357 | else 358 | begin 359 | Bass_Value.Font.Color := Self.Font.Color; 360 | end; 361 | end; 362 | 363 | procedure TVolumePop.UpdateMainForm; 364 | begin 365 | UIForm.UpdateVolumeIcon; 366 | end; 367 | 368 | procedure TVolumePop.UpdateTheSize; 369 | var 370 | PrevHeight: integer; 371 | begin 372 | // Calc 373 | PrevHeight := Height; 374 | 375 | // UI 376 | Panel8.Visible := ShowAdvVolume; 377 | 378 | // Resize 379 | Self.Height := 10; 380 | 381 | // Add 382 | Top := Top + PrevHeight - Height; 383 | end; 384 | 385 | end. 386 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 Petculescu Codrut 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | ## Please describe the changed made in this pull request. 2 | A clear and concise description of what the code changes are. Ex. Fixed UI flickering bug 3 | 4 | ## Version changed and IDE 5 | **Note the version of Delphi used to update the code** 6 | A small string telling the version of Delphi used, if any. Ex: Delphi Community Edition 11.3 7 | 8 | 9 | **The version of iBroadcast for Windows that this pull request is based upon** 10 | The version of iBroadcast that the changed were applied on. If the latest, type "latest". 11 | 12 | 13 | ## Additional information 14 | Add any other context or screenshots about the feature request here. 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # iBroadcast-For-Windows 2 | A unofficial iBroadcast client for Windows 3 | 4 | ### Description 5 | This is a native Windows client for the [iBroadcast](https://ibroadcast.com) music uploading platform. The application is made with Embarcadero Delphi 12. This app connects to your account with an official app integration on the iBroadcast website. 6 | 7 | ### Also try [iBroadcast for Linux](https://github.com/Codrax/iBroadcast-For-Linux)! 8 | 9 | ## To obtain the login token: 10 | Go to media.ibroadcast.com -> Account -> Apps, and create a token for Cod's iBroadcast Player. 11 | 12 | iBroadcast Apps Page 13 | ![Screenshot_1](https://user-images.githubusercontent.com/68193064/235357872-fc1900b2-bb1c-410d-b47f-14a574c27b31.png) 14 | 15 | ## Main Features 16 | - Browse library songs, albums, artists, playlists 17 | - Play music, add to queue 18 | - Download songs locally to listen without a internet connection 19 | - Local Queue support, with adding to queue, changing the order, seeking 20 | - Awesome Music Visualisation 21 | - View account information 22 | - Search library for anything, by type and by filters 23 | - Mini player view 24 | - Shuffle all your songs 25 | - Rate your favorite songs albums and artists 26 | - Add songs to play history 27 | - View artwork and Track, Album, Artist or Playlist (Ctrl+Click) 28 | - Sorting any view 29 | - View library as list or as grid 30 | - Home page with recent albums, favorites, history 31 | - Create & Edit playlists 32 | - Volume Mixer for App and System 33 | - Performance graph 34 | 35 | ### Dependencies 36 | - Codrut Visual Library - https://github.com/Codrax/CodrutsVisualLibrary/ 37 | - Codrut Fluent Design System - https://github.com/Codrax/CodrutFluentDesignSystem 38 | - Codrut Windows Runtime - https://github.com/Codrax/Cod-Windows-Runtime 39 | - Delphi BASS Audio Library - https://github.com/TDDung/Delphi-BASS 40 | - Units in the Dependencies folder 41 | 42 | ### Parameters 43 | | Parameter | Description | 44 | | ------------- | ------------- | 45 | | -offline | Forces offline mode | 46 | | -tray | Start hidden in system tray | 47 | | -logging | Output application log of tasks and errors on user desktop | 48 | | -logtoken | Output login token in log | 49 | | -exportpost | Output all recieved POST requests to desktop | 50 | | -debug | Enable application debugging features | 51 | | -log32 | Enable visual logger | 52 | 53 | ## Screenshots 54 | 55 | ![Screenshot 2023-07-21 182800](https://github.com/Codrax/iBroadcast-For-Windows/assets/68193064/5014b71c-9bb5-4064-8c9a-614a0a716576) 56 | ![Recording 2023-11-02 105054](https://github.com/Codrax/iBroadcast-For-Windows/assets/68193064/7f99843c-5c7b-4380-bfc0-41000dceb8ec) 57 | ![Screenshot 2023-07-21 183347](https://github.com/Codrax/iBroadcast-For-Windows/assets/68193064/36207884-8a64-49e3-8e26-49fa163465ad) 58 | ![Screenshot 2023-07-21 182840](https://github.com/Codrax/iBroadcast-For-Windows/assets/68193064/dea277a4-6f51-4b3c-9ae9-74514361cd09) 59 | ![Screenshot 2023-07-21 183212](https://github.com/Codrax/iBroadcast-For-Windows/assets/68193064/0c2cdf4f-bf08-4582-a698-1f88ddf13bc2) 60 | ![Screenshot 2023-07-21 183110](https://github.com/Codrax/iBroadcast-For-Windows/assets/68193064/2b051092-c774-4c95-bd94-e5ec15c541e9) 61 | ![Screenshot 2023-07-21 183010](https://github.com/Codrax/iBroadcast-For-Windows/assets/68193064/ebf4daf6-99e8-4e53-a107-f28eb0e1f3f7) 62 | ![Screenshot 2023-05-01 175457](https://user-images.githubusercontent.com/68193064/235471988-934b9a74-c282-4fcb-bd56-ae6bbc862550.png) 63 | ![Screenshot 2023-05-01 175508](https://user-images.githubusercontent.com/68193064/235472002-9db00583-0c24-4eb7-920c-ef9042e8b06f.png) 64 | ![Screenshot 2023-04-29 164326](https://user-images.githubusercontent.com/68193064/235306816-f513b165-f72b-46db-ab0a-1faaa44e7092.png) 65 | ![Screenshot 2023-04-29 164338](https://user-images.githubusercontent.com/68193064/235306826-371cd980-6631-4943-ae6c-f6c970b126fb.png) 66 | -------------------------------------------------------------------------------- /Utils/SpectrumVis3D.pas: -------------------------------------------------------------------------------- 1 | unit SpectrumVis3D; 2 | { Spectrum Visualyzation by Alessandro Cappellozza 3 | version 0.8 05/2002 4 | http://digilander.iol.it/Kappe/audioobject 5 | } 6 | 7 | interface 8 | uses Windows, Dialogs, Graphics, SysUtils, CommonTypes, Classes; 9 | 10 | type 11 | TWaveData = array [0..2048] of DWORD; 12 | TFFTData = array [0..512] of Single; 13 | 14 | TSpectrum = Class(TObject) 15 | private 16 | VisBuff : TBitmap; 17 | BackBmp : TBitmap; 18 | 19 | BkgColor : TColor; 20 | SpecHeight : Integer; 21 | PenColor : TColor; 22 | PeakColor: TColor; 23 | DrawType : Integer; 24 | DrawRes : Integer; 25 | FrmClear : Boolean; 26 | UseBkg : Boolean; 27 | PeakFall : Integer; 28 | LineFall : Integer; 29 | ColWidth : Integer; 30 | ShowPeak : Boolean; 31 | 32 | FFTPeacks : array [0..128] of Integer; 33 | FFTFallOff : array [0..128] of Integer; 34 | 35 | public 36 | Constructor Create (Width, Height : Integer); 37 | procedure Draw(HWND : THandle; FFTData : TFFTData; X, Y : Integer); 38 | procedure SetBackGround (Active : Boolean; BkgCanvas : TGraphic); 39 | 40 | property BackColor : TColor read BkgColor write BkgColor; 41 | property Height : Integer read SpecHeight write SpecHeight; 42 | property Width : Integer read ColWidth write ColWidth; 43 | property Pen : TColor read PenColor write PenColor; 44 | property Peak : TColor read PeakColor write PeakColor; 45 | property Mode : Integer read DrawType write DrawType; 46 | property Res : Integer read DrawRes write DrawRes; 47 | property FrameClear : Boolean read FrmClear write FrmClear; 48 | property PeakFallOff: Integer read PeakFall write PeakFall; 49 | property LineFallOff: Integer read LineFall write LineFall; 50 | property DrawPeak : Boolean read ShowPeak write ShowPeak; 51 | end; 52 | 53 | //var Spectrum : TSpectrum; 54 | 55 | implementation 56 | 57 | Constructor TSpectrum.Create(Width, Height : Integer); 58 | begin 59 | VisBuff := TBitmap.Create; 60 | BackBmp := TBitmap.Create; 61 | 62 | VisBuff.Width := Width; 63 | VisBuff.Height := Height; 64 | BackBmp.Width := Width; 65 | BackBmp.Height := Height; 66 | 67 | BkgColor := clBlack; 68 | SpecHeight := 100; 69 | PenColor := clWhite; 70 | PeakColor := clYellow; 71 | DrawType := 1; 72 | DrawRes := 1; 73 | FrmClear := True; 74 | UseBkg := False; 75 | PeakFall := 1; 76 | LineFall := 3; 77 | ColWidth := 5; 78 | ShowPeak := True; 79 | end; 80 | 81 | procedure TSpectrum.SetBackGround (Active : Boolean; BkgCanvas : TGraphic); 82 | begin 83 | UseBkg := Active; 84 | BackBmp.Canvas.Draw(0, 0, BkgCanvas); 85 | end; 86 | 87 | procedure TSpectrum.Draw(HWND : THandle; FFTData : TFFTData; X, Y : Integer); 88 | var i, YPos : LongInt; YVal : Single; 89 | begin 90 | 91 | if FrmClear then begin 92 | VisBuff.Canvas.Pen.Color := BkgColor; 93 | VisBuff.Canvas.Brush.Color := BkgColor; 94 | VisBuff.Canvas.Rectangle(0, 0, VisBuff.Width, VisBuff.Height); 95 | if UseBkg then VisBuff.Canvas.CopyRect(Rect(0, 0, BackBmp.Width, BackBmp.Height), BackBmp.Canvas, Rect(0, 0, BackBmp.Width, BackBmp.Height)); 96 | end; 97 | 98 | VisBuff.Canvas.Pen.Color := PenColor; 99 | for i := 0 to 128 do begin 100 | YVal := Abs(FFTData[(i * DrawRes) + 5]); 101 | YPos := Trunc((YVal) * 500); 102 | if YPos > Height then YPos := SpecHeight; 103 | 104 | if YPos >= FFTPeacks[i] then FFTPeacks[i] := YPos 105 | else FFTPeacks[i] := FFTPeacks[i] - PeakFall; 106 | 107 | if YPos >= FFTFallOff[i] then FFTFallOff[i] := YPos 108 | else FFTFallOff[i] := FFTFallOff[i] - LineFall; 109 | 110 | if (VisBuff.Height - FFTPeacks[i]) > VisBuff.Height then FFTPeacks[i] := 0; 111 | if (VisBuff.Height - FFTFallOff[i]) > VisBuff.Height then FFTFallOff[i] := 0; 112 | 113 | case DrawType of 114 | 0 : begin 115 | VisBuff.Canvas.MoveTo(X + i, Y + VisBuff.Height); 116 | VisBuff.Canvas.LineTo(X + i, Y + VisBuff.Height - FFTFallOff[i]); 117 | if ShowPeak then VisBuff.Canvas.Pixels[X + i, Y + VisBuff.Height - FFTPeacks[i]] := Pen; 118 | end; 119 | 120 | 1 : begin 121 | if ShowPeak then VisBuff.Canvas.Pen.Color := PeakColor; 122 | if ShowPeak then VisBuff.Canvas.MoveTo(X + i * (ColWidth + 1), Y + VisBuff.Height - FFTPeacks[i]); 123 | if ShowPeak then VisBuff.Canvas.LineTo(X + i * (ColWidth + 1) + ColWidth, Y + VisBuff.Height - FFTPeacks[i]); 124 | 125 | VisBuff.Canvas.Pen.Color := PenColor; 126 | VisBuff.Canvas.Brush.Color := PenColor; 127 | VisBuff.Canvas.Rectangle(X + i * (ColWidth + 1), Y + VisBuff.Height - FFTFallOff[i], 128 | X + i * (ColWidth + 1) + ColWidth, Y + VisBuff.Height); 129 | end; 130 | end; 131 | end; 132 | 133 | BitBlt(HWND, 0, 0, VisBuff.Width, VisBuff.Height, VisBuff.Canvas.Handle, 0, 0, srccopy) 134 | end; 135 | end. 136 | 137 | -------------------------------------------------------------------------------- /Utils/iBroadcastUtils.pas: -------------------------------------------------------------------------------- 1 | unit iBroadcastUtils; 2 | 3 | interface 4 | uses 5 | Types, SysUtils, Cod.Dialogs, Windows, Vcl.Dialogs, Classes, Variants, 6 | Graphics; 7 | 8 | // Dialogs 9 | function OpenDialog(Title, Text: string; AType: CMessageType = ctInformation; Buttons: TMsgDlgButtons = [mbOk]): integer; 10 | function OpenQuery(Title, Text: string; var AText: string): boolean; 11 | 12 | // String 13 | function MashString(AString: string): string; 14 | procedure RidOfSimbols(var DataStr: string); 15 | 16 | const 17 | BG_COLOR = $002C0C11; 18 | FN_COLOR = clWhite; 19 | 20 | var 21 | // App Config 22 | AllowDebug: boolean; 23 | 24 | // Application Settings 25 | IsOffline: boolean; 26 | SmallSize: integer; 27 | OverrideOffline: boolean = false; 28 | HiddenToTray: boolean; 29 | 30 | implementation 31 | 32 | function OpenDialog(Title, Text: string; AType: CMessageType = ctInformation; Buttons: TMsgDlgButtons = [mbOk]): integer; 33 | var 34 | Dialog: CDialog; 35 | begin 36 | Dialog := CDialog.Create; 37 | 38 | // Text 39 | Dialog.Title := Title; 40 | Dialog.Text := Text; 41 | 42 | // Colors & Design 43 | Dialog.EnableFooter := false; 44 | Dialog.GlobalSyncTogle := false; 45 | 46 | Dialog.FormColor := BG_COLOR; 47 | Dialog.TextFont.Color := FN_COLOR; 48 | 49 | Dialog.ButtonDesign.FlatButton := true; 50 | Dialog.ButtonDesign.FlatComplete := true; 51 | 52 | // Dialog 53 | Dialog.Buttons := Buttons; 54 | Dialog.Kind := AType; 55 | 56 | // Execute 57 | Result := Dialog.Execute; 58 | 59 | Dialog.Free; 60 | end; 61 | 62 | function OpenQuery(Title, Text: string; var AText: string): boolean; 63 | var 64 | Dialog: CInputBox; 65 | SVal: string; 66 | begin 67 | Dialog := CInputBox.Create; 68 | 69 | // Text 70 | Dialog.Title := Title; 71 | Dialog.Text := Text; 72 | 73 | Dialog.Value := AText; 74 | 75 | // Colors & Design 76 | Dialog.EnableFooter := false; 77 | Dialog.GlobalSyncTogle := false; 78 | 79 | Dialog.FormColor := BG_COLOR; 80 | Dialog.TextFont.Color := FN_COLOR; 81 | 82 | Dialog.ButtonDesign.FlatButton := true; 83 | Dialog.ButtonDesign.FlatComplete := true; 84 | 85 | // Execute 86 | SVal := Dialog.Execute; 87 | 88 | Result := Dialog.DialogResult = cidrOk; 89 | if Result then 90 | AText := SVal; 91 | 92 | Dialog.Free; 93 | end; 94 | 95 | function MashString(AString: string): string; 96 | begin 97 | Result := AString; 98 | Result := AnsiLowerCase(Result); 99 | RidOfSimbols(Result); 100 | end; 101 | 102 | procedure RidOfSimbols(var DataStr: string); 103 | var 104 | RPFlag: TReplaceFlags; 105 | begin 106 | RPFlag := [rfReplaceAll, rfIgnoreCase]; 107 | 108 | DataStr := StringReplace(DataStr, ' ', '', RPFlag); 109 | DataStr := StringReplace(DataStr, ',', '', RPFlag); 110 | DataStr := StringReplace(DataStr, '.', '', RPFlag); 111 | DataStr := StringReplace(DataStr, '#', '', RPFlag); 112 | DataStr := StringReplace(DataStr, '&', '', RPFlag); 113 | DataStr := StringReplace(DataStr, '%', '', RPFlag); 114 | DataStr := StringReplace(DataStr, '!', '', RPFlag); 115 | DataStr := StringReplace(DataStr, '@', '', RPFlag); 116 | DataStr := StringReplace(DataStr, #39, '', RPFlag); 117 | DataStr := StringReplace(DataStr, '*', '', RPFlag); 118 | DataStr := StringReplace(DataStr, '"', '', RPFlag); 119 | DataStr := StringReplace(DataStr, '`', '', RPFlag); 120 | DataStr := StringReplace(DataStr, '~', '', RPFlag); 121 | DataStr := StringReplace(DataStr, '-', '', RPFlag); 122 | DataStr := StringReplace(DataStr, '(', '', RPFlag); 123 | DataStr := StringReplace(DataStr, ')', '', RPFlag); 124 | DataStr := StringReplace(DataStr, '[', '', RPFlag); 125 | DataStr := StringReplace(DataStr, ']', '', RPFlag); 126 | end; 127 | 128 | end. 129 | -------------------------------------------------------------------------------- /iBroadcast.dpr: -------------------------------------------------------------------------------- 1 | program iBroadcast; 2 | 3 | {$R *.dres} 4 | 5 | uses 6 | Vcl.Forms, 7 | Cod.Instances, 8 | Cod.SysUtils, 9 | Cod.Dialogs, 10 | MainUI in 'MainUI.pas' {UIForm}, 11 | BroadcastAPI in 'BroadcastAPI.pas', 12 | 13 | SpectrumVis3D in 'Utils\SpectrumVis3D.pas', 14 | iBroadcastUtils in 'Utils\iBroadcastUtils.pas', 15 | 16 | DebugForm in 'Forms\DebugForm.pas' {DebugUI}, 17 | VolumePopup in 'Forms\VolumePopup.pas' {VolumePop}, 18 | Performance in 'Forms\Performance.pas' {PerfForm}, 19 | MiniPlay in 'Forms\MiniPlay.pas' {MiniPlayer}, 20 | InfoForm in 'Forms\InfoForm.pas' {InfoBox}, 21 | HelpForm in 'Forms\HelpForm.pas' {HelpUI}, 22 | NewVersionForm in 'Forms\NewVersionForm.pas' {NewVersion}, 23 | CreatePlaylistForm in 'Forms\CreatePlaylistForm.pas' {CreatePlaylist}, 24 | Offline in 'Forms\Offline.pas' {OfflineForm}, 25 | PickerDialogForm in 'Forms\PickerDialogForm.pas' {PickerDialog}, 26 | RatingPopup in 'Forms\RatingPopup.pas' {RatingPopupForm}, 27 | CodeSources in 'Forms\CodeSources.pas' {SourceUI}, 28 | LoggingForm in 'Forms\LoggingForm.pas' {Logging}; 29 | 30 | {$R *.res} 31 | 32 | var 33 | I: integer; 34 | Param: string; 35 | begin 36 | Application.Initialize; 37 | 38 | // Close if Other instance 39 | SetSemaphore(APP_USERMODELID); // use application app user model ID 40 | InitializeInstance(true, false); 41 | 42 | if HasOtherInstance then begin 43 | SendOtherWindowMessageAuto(WM_RESTOREMAINWINDOW, 0, 0); 44 | BringOtherWindowToTopAuto; 45 | 46 | Halt( 1 ); 47 | end; 48 | 49 | {Application.CreateForm(TCreatePlaylist, CreatePlaylist); 50 | Application.Run; } 51 | 52 | // Initiate Default 53 | AllowDebug := false; 54 | EnableLogging := false; 55 | 56 | // Parameter String 57 | for I := 1 to ParamCount do 58 | begin 59 | Param := GetParameter(I); 60 | if Param = '-debug' then 61 | AllowDebug := true; 62 | 63 | if Param = '-offline' then 64 | begin 65 | OverrideOffline := true; 66 | end; 67 | 68 | if Param = '-tray' then 69 | begin 70 | Application.ShowMainForm := false; 71 | HiddenToTray := true; 72 | end; 73 | 74 | if Param = '-logging' then 75 | EnableLogging := true; 76 | 77 | if Param = '-logtoken' then 78 | PrivacyEnabled := false; 79 | 80 | if Param = '-exportpost' then 81 | ExportPost := true; 82 | 83 | if Param = '-log32' then 84 | EnableLog32 := true; 85 | end; 86 | 87 | AddToLog('======================'); 88 | AddToLog('Started iBroadcast version ' + VERSION.ToString); 89 | AddToLog('Started creating forms'); 90 | 91 | Application.MainFormOnTaskbar := True; 92 | Application.CreateForm(TUIForm, UIForm); 93 | Application.CreateForm(TMiniPlayer, MiniPlayer); 94 | Application.CreateForm(TInfoBox, InfoBox); 95 | 96 | // Write instance data (use try, just to be on the safe side) 97 | try 98 | PutAppInfo( Application.MainForm.Handle ); 99 | except 100 | end; 101 | 102 | // Log 103 | if EnableLog32 then 104 | begin 105 | Application.CreateForm(TLogging, Logging); 106 | Logging.Show; 107 | AddToLog('Created log form'); 108 | end; 109 | 110 | // Debug 111 | AddToLog('Checking debug mode'); 112 | if AllowDebug then 113 | begin 114 | // Debug form 115 | DebugUI := TDebugUI.Create(Application); 116 | 117 | DebugUI.Show; 118 | DebugUi.DataSync.Enabled := true; 119 | 120 | // UI 121 | with UIForm do 122 | begin 123 | CopyID1.Visible := true; 124 | CopyID2.Visible := true; 125 | CopyID3.Visible := true; 126 | CopyID4.Visible := true; 127 | end; 128 | end; 129 | 130 | AddToLog('Executing Application'); 131 | Application.Run; 132 | end. 133 | -------------------------------------------------------------------------------- /iBroadcast.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | -------------------------------------------------------------------------------- /iBroadcast.dres: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/iBroadcast.dres -------------------------------------------------------------------------------- /iBroadcast.identcache: -------------------------------------------------------------------------------- 1 | KF:\Development\Repositories\iBroadcast-For-Windows\Forms\NewVersionForm.pasEF:\Development\Repositories\iBroadcast-For-Windows\Forms\HelpForm.pasOF:\Development\Repositories\iBroadcast-For-Windows\Forms\CreatePlaylistForm.pasHF:\Development\Repositories\iBroadcast-For-Windows\Forms\VolumePopup.pasHF:\Development\Repositories\iBroadcast-For-Windows\Forms\Performance.pasDF:\Development\Repositories\iBroadcast-For-Windows\Forms\Offline.pasEF:\Development\Repositories\iBroadcast-For-Windows\Forms\InfoForm.pasHF:\Development\Repositories\iBroadcast-For-Windows\Forms\RatingPopup.pasJF:\Development\Repositories\iBroadcast-For-Windows\Utils\SpectrumVis3D.pasEF:\Development\Repositories\iBroadcast-For-Windows\Forms\MiniPlay.pas=F:\Development\Repositories\iBroadcast-For-Windows\MainUI.pasLF:\Development\Repositories\iBroadcast-For-Windows\Utils\iBroadcastUtils.pasHF:\Development\Repositories\iBroadcast-For-Windows\Forms\LoggingForm.pasMF:\Development\Repositories\iBroadcast-For-Windows\Forms\PickerDialogForm.pasFF:\Development\Repositories\iBroadcast-For-Windows\Forms\DebugForm.pasHF:\Development\Repositories\iBroadcast-For-Windows\Forms\CodeSources.pasCF:\Development\Repositories\iBroadcast-For-Windows\BroadcastAPI.pasAF:\Development\Repositories\iBroadcast-For-Windows\iBroadcast.dpr -------------------------------------------------------------------------------- /iBroadcast.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/iBroadcast.res -------------------------------------------------------------------------------- /iBroadcastResource.rc: -------------------------------------------------------------------------------- 1 | Artwork1 RCDATA "Artwork\\Box.jpg" 2 | Artwork2 RCDATA "Artwork\\Broadcast.jpg" 3 | Artwork3 RCDATA "Artwork\\SongArt.jpg" 4 | Artwork4 RCDATA "Artwork\\Speaker.jpg" 5 | -------------------------------------------------------------------------------- /iBroadcast_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Codrax/iBroadcast-For-Windows/1080f54f3c1b4f6a68ec0be139f135ddbebf41d6/iBroadcast_Icon.ico --------------------------------------------------------------------------------